/-
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

! This file was ported from Lean 3 source module analysis.calculus.fderiv_measurable
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.Deriv
import Mathbin.MeasureTheory.Constructions.BorelSpace
import Mathbin.MeasureTheory.Function.StronglyMeasurable.Basic
import Mathbin.Tactic.RingExp

/-!
# 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 section

open Set Metric Asymptotics Filter ContinuousLinearMap

open TopologicalSpace (SecondCountableTopology)

open MeasureTheory

open Topology

namespace ContinuousLinearMap

variable {𝕜 E F : Type _} [NontriviallyNormedField 𝕜] [NormedAddCommGroup E] [NormedSpace 𝕜 E]
  [NormedAddCommGroup F] [NormedSpace 𝕜 F]

theorem measurable_apply₂ [MeasurableSpace E] [OpensMeasurableSpace E] [SecondCountableTopology E]
    [SecondCountableTopology (E →L[𝕜] F)] [MeasurableSpace F] [BorelSpace F] :
    Measurable fun p : (E →L[𝕜] F) × E => p.1 p.2 :=
  isBoundedBilinearMapApply.Continuous.Measurable
#align continuous_linear_map.measurable_apply₂ ContinuousLinearMap.measurable_apply₂

end ContinuousLinearMap

section fderiv

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜]

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace 𝕜 E]

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F]

variable {f : E → F} (K : Set (E →L[𝕜] F))

namespace FderivMeasurableAux

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (y z «expr ∈ » ball[metric.ball] x r') -/
/-- 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) (_ : y ∈ ball x r') (z) (_ : z ∈ ball x r'), ‖f z - f y - L (z - y)‖ ≤ ε * r }
#align fderiv_measurable_aux.A FderivMeasurableAux.a

/-- 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 ε
#align fderiv_measurable_aux.B FderivMeasurableAux.b

/-- 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)
#align fderiv_measurable_aux.D FderivMeasurableAux.d

theorem isOpen_a (L : E →L[𝕜] F) (r ε : ℝ) : IsOpen (a f L r ε) :=
  by
  rw [Metric.isOpen_iff]
  rintro 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, fun x' hx' => ⟨s, this, _⟩⟩
  have B : ball x' s ⊆ ball x r' := ball_subset (le_of_lt hx')
  intro y hy z hz
  exact hr' y (B hy) z (B hz)
#align fderiv_measurable_aux.is_open_A FderivMeasurableAux.isOpen_a

theorem isOpen_b {K : Set (E →L[𝕜] F)} {r s ε : ℝ} : IsOpen (b f K r s ε) := by
  simp [B, isOpen_unionᵢ, IsOpen.inter, is_open_A]
#align fderiv_measurable_aux.is_open_B FderivMeasurableAux.isOpen_b

theorem a_mono (L : E →L[𝕜] F) (r : ℝ) {ε δ : ℝ} (h : ε ≤ δ) : a f L r ε ⊆ a f L r δ :=
  by
  rintro x ⟨r', r'r, hr'⟩
  refine' ⟨r', r'r, fun 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]
#align fderiv_measurable_aux.A_mono FderivMeasurableAux.a_mono

theorem le_of_mem_a {r ε : ℝ} {L : E →L[𝕜] F} {x : E} (hx : x ∈ a f L r ε) {y z : E}
    (hy : y ∈ closedBall x (r / 2)) (hz : z ∈ closedBall x (r / 2)) :
    ‖f z - f y - L (z - y)‖ ≤ ε * r :=
  by
  rcases hx with ⟨r', r'mem, hr'⟩
  exact hr' _ ((mem_closed_ball.1 hy).trans_lt r'mem.1) _ ((mem_closed_ball.1 hz).trans_lt r'mem.1)
#align fderiv_measurable_aux.le_of_mem_A FderivMeasurableAux.le_of_mem_a

theorem mem_a_of_differentiable {ε : ℝ} (hε : 0 < ε) {x : E} (hx : DifferentiableAt 𝕜 f x) :
    ∃ R > 0, ∀ r ∈ Ioo (0 : ℝ) R, x ∈ a f (fderiv 𝕜 f x) r ε :=
  by
  have := hx.has_fderiv_at
  simp only [HasFderivAt, HasFderivAtFilter, is_o_iff] at this
  rcases eventually_nhds_iff_ball.1 (this (half_pos hε)) with ⟨R, R_pos, hR⟩
  refine' ⟨R, R_pos, fun r hr => _⟩
  have : r ∈ Ioc (r / 2) r := ⟨half_lt_self hr.1, le_rfl⟩
  refine' ⟨r, this, fun 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 [ContinuousLinearMap.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

#align fderiv_measurable_aux.mem_A_of_differentiable FderivMeasurableAux.mem_a_of_differentiable

theorem 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‖ * ε :=
  by
  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 _
  intro 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 := by
      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]
    _ = 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

#align fderiv_measurable_aux.norm_sub_le_of_mem_A FderivMeasurableAux.norm_sub_le_of_mem_a

/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/
theorem differentiable_set_subset_d : { x | DifferentiableAt 𝕜 f x ∧ fderiv 𝕜 f x ∈ K } ⊆ d f K :=
  by
  intro x hx
  rw [D, mem_Inter]
  intro 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, fun 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)
#align fderiv_measurable_aux.differentiable_set_subset_D FderivMeasurableAux.differentiable_set_subset_d

/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/
theorem d_subset_differentiable_set {K : Set (E →L[𝕜] F)} (hK : IsComplete K) :
    d f K ⊆ { x | DifferentiableAt 𝕜 f x ∧ fderiv 𝕜 f x ∈ K } :=
  by
  have P : ∀ {n : ℕ}, (0 : ℝ) < (1 / 2) ^ n := pow_pos (by norm_num)
  rcases NormedField.exists_one_lt_norm 𝕜 with ⟨c, hc⟩
  have cpos : 0 < ‖c‖ := lt_trans zero_lt_one hc
  intro 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) :=
    by
    intro e
    have := mem_Inter.1 hx e
    rcases mem_Union.1 this with ⟨n, hn⟩
    refine' ⟨n, fun 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 :=
    by
    intro 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 :=
      by
      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 :=
      by
      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 :=
      by
      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 := fun e => L e (n e) (n e)
  have : CauchySeq L0 := by
    rw [Metric.cauchySeq_iff']
    intro ε ε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, fun 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') :=
    cauchySeq_tendsto_of_isComplete hK (fun 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 :=
    by
    intro e p hp
    apply le_of_tendsto (tendsto_const_nhds.sub hf').norm
    rw [eventually_at_top]
    exact ⟨e, fun e' he' => M _ _ _ _ _ _ le_rfl hp le_rfl le_rfl he'⟩
  -- Let us show that `f` has derivative `f'` at `x`.
  have : HasFderivAt f f' x :=
    by
    simp only [hasFderivAt_iff_isOCat_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)`. -/
    intro ε ε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, fun 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 :=
      by
      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 :=
      by
      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
        _ ≤ 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⟩
#align fderiv_measurable_aux.D_subset_differentiable_set FderivMeasurableAux.d_subset_differentiable_set

theorem differentiable_set_eq_d (hK : IsComplete K) :
    { x | DifferentiableAt 𝕜 f x ∧ fderiv 𝕜 f x ∈ K } = d f K :=
  Subset.antisymm (differentiable_set_subset_d _) (d_subset_differentiable_set hK)
#align fderiv_measurable_aux.differentiable_set_eq_D FderivMeasurableAux.differentiable_set_eq_d

end FderivMeasurableAux

open FderivMeasurableAux

variable [MeasurableSpace E] [OpensMeasurableSpace E]

variable (𝕜 f)

/-- The set of differentiability points of a function, with derivative in a given complete set,
is Borel-measurable. -/
theorem measurableSet_of_differentiableAt_of_isComplete {K : Set (E →L[𝕜] F)} (hK : IsComplete K) :
    MeasurableSet { x | DifferentiableAt 𝕜 f x ∧ fderiv 𝕜 f x ∈ K } := by
  simp [differentiable_set_eq_D K hK, D, is_open_B.measurable_set, MeasurableSet.interᵢ,
    MeasurableSet.unionᵢ]
#align measurable_set_of_differentiable_at_of_is_complete measurableSet_of_differentiableAt_of_isComplete

variable [CompleteSpace F]

/-- The set of differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurableSet_of_differentiableAt : MeasurableSet { x | DifferentiableAt 𝕜 f x } :=
  by
  have : IsComplete (univ : Set (E →L[𝕜] F)) := complete_univ
  convert measurableSet_of_differentiableAt_of_isComplete 𝕜 f this
  simp
#align measurable_set_of_differentiable_at measurableSet_of_differentiableAt

@[measurability]
theorem measurable_fderiv : Measurable (fderiv 𝕜 f) :=
  by
  refine' measurable_of_isClosed fun s hs => _
  have :
    fderiv 𝕜 f ⁻¹' s =
      { x | DifferentiableAt 𝕜 f x ∧ fderiv 𝕜 f x ∈ s } ∪
        { x | ¬DifferentiableAt 𝕜 f x } ∩ { x | (0 : E →L[𝕜] F) ∈ s } :=
    Set.ext fun x => mem_preimage.trans fderiv_mem_iff
  rw [this]
  exact
    (measurableSet_of_differentiableAt_of_isComplete _ _ hs.is_complete).union
      ((measurableSet_of_differentiableAt _ _).compl.inter (MeasurableSet.const _))
#align measurable_fderiv measurable_fderiv

@[measurability]
theorem measurable_fderiv_apply_const [MeasurableSpace F] [BorelSpace F] (y : E) :
    Measurable fun x => fderiv 𝕜 f x y :=
  (ContinuousLinearMap.measurable_apply y).comp (measurable_fderiv 𝕜 f)
#align measurable_fderiv_apply_const measurable_fderiv_apply_const

variable {𝕜}

@[measurability]
theorem measurable_deriv [MeasurableSpace 𝕜] [OpensMeasurableSpace 𝕜] [MeasurableSpace F]
    [BorelSpace F] (f : 𝕜 → F) : Measurable (deriv f) := by
  simpa only [fderiv_deriv] using measurable_fderiv_apply_const 𝕜 f 1
#align measurable_deriv measurable_deriv

theorem stronglyMeasurable_deriv [MeasurableSpace 𝕜] [OpensMeasurableSpace 𝕜]
    [SecondCountableTopology F] (f : 𝕜 → F) : StronglyMeasurable (deriv f) :=
  by
  borelize F
  exact (measurable_deriv f).StronglyMeasurable
#align strongly_measurable_deriv stronglyMeasurable_deriv

theorem aeMeasurableDeriv [MeasurableSpace 𝕜] [OpensMeasurableSpace 𝕜] [MeasurableSpace F]
    [BorelSpace F] (f : 𝕜 → F) (μ : Measure 𝕜) : AeMeasurable (deriv f) μ :=
  (measurable_deriv f).AeMeasurable
#align ae_measurable_deriv aeMeasurableDeriv

theorem aeStronglyMeasurableDeriv [MeasurableSpace 𝕜] [OpensMeasurableSpace 𝕜]
    [SecondCountableTopology F] (f : 𝕜 → F) (μ : Measure 𝕜) : AeStronglyMeasurable (deriv f) μ :=
  (stronglyMeasurable_deriv f).AeStronglyMeasurable
#align ae_strongly_measurable_deriv aeStronglyMeasurableDeriv

end fderiv

section RightDeriv

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace ℝ F]

variable {f : ℝ → F} (K : Set F)

namespace RightDerivMeasurableAux

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (y z «expr ∈ » Icc[set.Icc] x «expr + »(x, r')) -/
/-- 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) (_ : y ∈ Icc x (x + r')) (z) (_ : z ∈ Icc x (x + r')),
        ‖f z - f y - (z - y) • L‖ ≤ ε * r }
#align right_deriv_measurable_aux.A RightDerivMeasurableAux.a

/-- 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 ε
#align right_deriv_measurable_aux.B RightDerivMeasurableAux.b

/-- 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)
#align right_deriv_measurable_aux.D RightDerivMeasurableAux.d

theorem a_mem_nhdsWithin_Ioi {L : F} {r ε x : ℝ} (hx : x ∈ a f L r ε) : a f L r ε ∈ 𝓝[>] x :=
  by
  rcases hx with ⟨r', rr', hr'⟩
  rw [mem_nhdsWithin_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, fun x' hx' => ⟨s, this, _⟩⟩
  have A : Icc x' (x' + s) ⊆ Icc x (x + r') :=
    by
    apply Icc_subset_Icc hx'.1.le
    linarith [hx'.2]
  intro y hy z hz
  exact hr' y (A hy) z (A hz)
#align right_deriv_measurable_aux.A_mem_nhds_within_Ioi RightDerivMeasurableAux.a_mem_nhdsWithin_Ioi

theorem b_mem_nhdsWithin_Ioi {K : Set F} {r s ε x : ℝ} (hx : x ∈ b f K r s ε) :
    b f K r s ε ∈ 𝓝[>] x :=
  by
  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₂⟩
#align right_deriv_measurable_aux.B_mem_nhds_within_Ioi RightDerivMeasurableAux.b_mem_nhdsWithin_Ioi

theorem measurableSet_b {K : Set F} {r s ε : ℝ} : MeasurableSet (b f K r s ε) :=
  measurableSet_of_mem_nhdsWithin_Ioi fun x hx => b_mem_nhdsWithin_Ioi hx
#align right_deriv_measurable_aux.measurable_set_B RightDerivMeasurableAux.measurableSet_b

theorem a_mono (L : F) (r : ℝ) {ε δ : ℝ} (h : ε ≤ δ) : a f L r ε ⊆ a f L r δ :=
  by
  rintro x ⟨r', r'r, hr'⟩
  refine' ⟨r', r'r, fun 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]
#align right_deriv_measurable_aux.A_mono RightDerivMeasurableAux.a_mono

theorem 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 :=
  by
  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)
#align right_deriv_measurable_aux.le_of_mem_A RightDerivMeasurableAux.le_of_mem_a

theorem mem_a_of_differentiable {ε : ℝ} (hε : 0 < ε) {x : ℝ}
    (hx : DifferentiableWithinAt ℝ f (Ici x) x) :
    ∃ R > 0, ∀ r ∈ Ioo (0 : ℝ) R, x ∈ a f (derivWithin f (Ici x) x) r ε :=
  by
  have := hx.has_deriv_within_at
  simp_rw [hasDerivWithinAt_iff_isOCat, is_o_iff] at this
  rcases mem_nhdsWithin_Ici_iff_exists_Ico_subset.1 (this (half_pos hε)) with ⟨m, xm, hm⟩
  refine' ⟨m - x, by linarith [show x < m from xm], fun r hr => _⟩
  have : r ∈ Ioc (r / 2) r := ⟨half_lt_self hr.1, le_rfl⟩
  refine' ⟨r, this, fun y hy z hz => _⟩
  calc
    ‖f z - f y - (z - y) • derivWithin f (Ici x) x‖ =
        ‖f z - f x - (z - x) • derivWithin f (Ici x) x -
            (f y - f x - (y - x) • derivWithin f (Ici x) x)‖ :=
      by
      congr 1
      simp only [sub_smul]
      abel
    _ ≤
        ‖f z - f x - (z - x) • derivWithin f (Ici x) x‖ +
          ‖f y - f x - (y - x) • derivWithin 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 := by
      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]
    _ = ε * r := by ring

#align right_deriv_measurable_aux.mem_A_of_differentiable RightDerivMeasurableAux.mem_a_of_differentiable

theorem 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 * ε :=
  by
  suffices H : ‖(r / 2) • (L₁ - L₂)‖ ≤ r / 2 * (4 * ε)
  · 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 := by
      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]
    _ = r / 2 * (4 * ε) := by ring

#align right_deriv_measurable_aux.norm_sub_le_of_mem_A RightDerivMeasurableAux.norm_sub_le_of_mem_a

/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/
theorem differentiable_set_subset_d :
    { x | DifferentiableWithinAt ℝ f (Ici x) x ∧ derivWithin f (Ici x) x ∈ K } ⊆ d f K :=
  by
  intro x hx
  rw [D, mem_Inter]
  intro 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, fun p hp q hq => ⟨derivWithin 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)
#align right_deriv_measurable_aux.differentiable_set_subset_D RightDerivMeasurableAux.differentiable_set_subset_d

/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/
theorem d_subset_differentiable_set {K : Set F} (hK : IsComplete K) :
    d f K ⊆ { x | DifferentiableWithinAt ℝ f (Ici x) x ∧ derivWithin f (Ici x) x ∈ K } :=
  by
  have P : ∀ {n : ℕ}, (0 : ℝ) < (1 / 2) ^ n := pow_pos (by norm_num)
  intro 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) :=
    by
    intro e
    have := mem_Inter.1 hx e
    rcases mem_Union.1 this with ⟨n, hn⟩
    refine' ⟨n, fun 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 :=
    by
    intro 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 :=
      by
      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 :=
      by
      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 :=
      by
      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 := fun e => L e (n e) (n e)
  have : CauchySeq L0 := by
    rw [Metric.cauchySeq_iff']
    intro ε ε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, fun 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') :=
    cauchySeq_tendsto_of_isComplete hK (fun 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 :=
    by
    intro e p hp
    apply le_of_tendsto (tendsto_const_nhds.sub hf').norm
    rw [eventually_at_top]
    exact ⟨e, fun e' he' => M _ _ _ _ _ _ le_rfl hp le_rfl le_rfl he'⟩
  -- Let us show that `f` has right derivative `f'` at `x`.
  have : HasDerivWithinAt f f' (Ici x) x :=
    by
    simp only [hasDerivWithinAt_iff_isOCat, 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)`. -/
    intro ε ε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_nhdsWithin_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, MulZeroClass.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 :=
      by
      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 :=
          by
          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_iff, one_div, pow_one] using h'k
        _ = 4 * (1 / 2) ^ e * (1 / 2) ^ (m + 2) :=
          by
          field_simp
          ring
        _ ≤ 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 (uniqueDiffOn_Ici x x le_rfl)] at f'K
  exact ⟨this.differentiable_within_at, f'K⟩
#align right_deriv_measurable_aux.D_subset_differentiable_set RightDerivMeasurableAux.d_subset_differentiable_set

theorem differentiable_set_eq_d (hK : IsComplete K) :
    { x | DifferentiableWithinAt ℝ f (Ici x) x ∧ derivWithin f (Ici x) x ∈ K } = d f K :=
  Subset.antisymm (differentiable_set_subset_d _) (d_subset_differentiable_set hK)
#align right_deriv_measurable_aux.differentiable_set_eq_D RightDerivMeasurableAux.differentiable_set_eq_d

end RightDerivMeasurableAux

open RightDerivMeasurableAux

variable (f)

/-- The set of right differentiability points of a function, with derivative in a given complete
set, is Borel-measurable. -/
theorem measurableSet_of_differentiableWithinAt_Ici_of_isComplete {K : Set F} (hK : IsComplete K) :
    MeasurableSet { x | DifferentiableWithinAt ℝ f (Ici x) x ∧ derivWithin f (Ici x) x ∈ K } := by
  simp [differentiable_set_eq_D K hK, D, measurable_set_B, MeasurableSet.interᵢ,
    MeasurableSet.unionᵢ]
#align measurable_set_of_differentiable_within_at_Ici_of_is_complete measurableSet_of_differentiableWithinAt_Ici_of_isComplete

variable [CompleteSpace F]

/-- The set of right differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurableSet_of_differentiableWithinAt_Ici :
    MeasurableSet { x | DifferentiableWithinAt ℝ f (Ici x) x } :=
  by
  have : IsComplete (univ : Set F) := complete_univ
  convert measurableSet_of_differentiableWithinAt_Ici_of_isComplete f this
  simp
#align measurable_set_of_differentiable_within_at_Ici measurableSet_of_differentiableWithinAt_Ici

@[measurability]
theorem measurable_derivWithin_Ici [MeasurableSpace F] [BorelSpace F] :
    Measurable fun x => derivWithin f (Ici x) x :=
  by
  refine' measurable_of_isClosed fun s hs => _
  have :
    (fun x => derivWithin f (Ici x) x) ⁻¹' s =
      { x | DifferentiableWithinAt ℝ f (Ici x) x ∧ derivWithin f (Ici x) x ∈ s } ∪
        { x | ¬DifferentiableWithinAt ℝ f (Ici x) x } ∩ { x | (0 : F) ∈ s } :=
    Set.ext fun x => mem_preimage.trans derivWithin_mem_iff
  rw [this]
  exact
    (measurableSet_of_differentiableWithinAt_Ici_of_isComplete _ hs.is_complete).union
      ((measurableSet_of_differentiableWithinAt_Ici _).compl.inter (MeasurableSet.const _))
#align measurable_deriv_within_Ici measurable_derivWithin_Ici

theorem stronglyMeasurable_derivWithin_Ici [SecondCountableTopology F] :
    StronglyMeasurable fun x => derivWithin f (Ici x) x :=
  by
  borelize F
  exact (measurable_derivWithin_Ici f).StronglyMeasurable
#align strongly_measurable_deriv_within_Ici stronglyMeasurable_derivWithin_Ici

theorem aeMeasurableDerivWithinIci [MeasurableSpace F] [BorelSpace F] (μ : Measure ℝ) :
    AeMeasurable (fun x => derivWithin f (Ici x) x) μ :=
  (measurable_derivWithin_Ici f).AeMeasurable
#align ae_measurable_deriv_within_Ici aeMeasurableDerivWithinIci

theorem aeStronglyMeasurableDerivWithinIci [SecondCountableTopology F] (μ : Measure ℝ) :
    AeStronglyMeasurable (fun x => derivWithin f (Ici x) x) μ :=
  (stronglyMeasurable_derivWithin_Ici f).AeStronglyMeasurable
#align ae_strongly_measurable_deriv_within_Ici aeStronglyMeasurableDerivWithinIci

/-- The set of right differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurableSet_of_differentiableWithinAt_Ioi :
    MeasurableSet { x | DifferentiableWithinAt ℝ f (Ioi x) x } := by
  simpa [differentiableWithinAt_Ioi_iff_Ici] using measurableSet_of_differentiableWithinAt_Ici f
#align measurable_set_of_differentiable_within_at_Ioi measurableSet_of_differentiableWithinAt_Ioi

@[measurability]
theorem measurable_derivWithin_Ioi [MeasurableSpace F] [BorelSpace F] :
    Measurable fun x => derivWithin f (Ioi x) x := by
  simpa [derivWithin_Ioi_eq_Ici] using measurable_derivWithin_Ici f
#align measurable_deriv_within_Ioi measurable_derivWithin_Ioi

theorem stronglyMeasurable_derivWithin_Ioi [SecondCountableTopology F] :
    StronglyMeasurable fun x => derivWithin f (Ioi x) x :=
  by
  borelize F
  exact (measurable_derivWithin_Ioi f).StronglyMeasurable
#align strongly_measurable_deriv_within_Ioi stronglyMeasurable_derivWithin_Ioi

theorem aeMeasurableDerivWithinIoi [MeasurableSpace F] [BorelSpace F] (μ : Measure ℝ) :
    AeMeasurable (fun x => derivWithin f (Ioi x) x) μ :=
  (measurable_derivWithin_Ioi f).AeMeasurable
#align ae_measurable_deriv_within_Ioi aeMeasurableDerivWithinIoi

theorem aeStronglyMeasurableDerivWithinIoi [SecondCountableTopology F] (μ : Measure ℝ) :
    AeStronglyMeasurable (fun x => derivWithin f (Ioi x) x) μ :=
  (stronglyMeasurable_derivWithin_Ioi f).AeStronglyMeasurable
#align ae_strongly_measurable_deriv_within_Ioi aeStronglyMeasurableDerivWithinIoi

end RightDeriv


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic

/-

# Finite types

As well as finite subsets of a (possibly infinite type), Lean has a theory
of finite types. Just like finite subsets, there is a `Prop`-valued version
(the true-false statement "this type is finite") and a `Type`-valued version
("here is an explicit list of all the finitely many terms of this type").
If you want to work constructively, then use the `Type` version, and if
you just care about theorems you can use the `Prop` version.

## The Prop-valued version

If `(X : Type)` then `finite X` is the true-false statement saying
that `X` is finite. It's a class, which means it goes in square brackets.

-/

section prop_version

-- Let X be a finite type
variables (X : Type) [finite X]

-- The typeclass inference system now knows that various other types are finite:

variables (Y : Type) [finite Y]

example : finite (X × Y) := infer_instance
example : finite (X → Y) := infer_instance

-- The type `fin n` is a structure. To make a term of this structure
-- you need to give a natural `a`, and a proof that `a < n`.

example : fin 37 := ⟨3, by linarith⟩

-- The typeclass inference system also knows that these are finite

example : finite (fin 37) := infer_instance

end prop_version

/-

## The Type-valued version

This is `[fintype X]`. It's (in my opinion) harder to use, but finite sums work
for it, and they don't appear to work for `finite`.

-/

-- Let X be a constructively finite type
variables (X : Type) [fintype X]

example : X = X :=
begin
  -- _inst_1 : fintype X
  unfreezingI {cases _inst_1 }, -- it's a finset under the hood, plus a proof
  -- that everything is in it!
  refl,
end

-- Lean knows that `fin n` is constructively finite
example (n : ℕ) : fintype (fin n) := infer_instance

open_locale big_operators

-- the advantage of constructive finiteness is that the elements are internally stored
-- as a list, so you can prove this with `refl`
example : ∑ x : fin 10, x = 45 :=
begin
  refl,
end

-- Actually I just tricked you. Can you explain this?
example : ∑ x : fin 10, x = 25 :=
begin
  refl,
end

-- Here's a better proof
example : ∑ x : fin 10, x.val = 45 :=
begin
  refl
end
-- Take a look at the types of the 45 in those proof. Do you know how to? Do you know
-- what's going on? Hint: ℤ/10ℤ.


import tutorial_world.level11_cases2_or --hide
open set IncidencePlane --hide

variables {Ω : Type} [IncidencePlane Ω] --hide

/-
# Tutorial World

## Level 12: the `cases` tactic (III) (boss level).

Suppose now that your hypothesis says there is some element `x` satisfying a certain
property `P`. That is, you have `h : ∃ x, P x`. Then `cases h with z hz` will
replace `h` with `z : x` and `hz : P z`. That is, from the fact that you assume that
some `z` exists (`z : x`), it will give you another hypothesis in which `z` satisfies the
property `P` (`hz : P z`).

Let's try to understand this with a real life example! Say that we have the hypothesis
`h: ∃ GALAXY, SOLAR_SYSTEM GALAXY`. That is, **there exists a GALAXY such that "SOLAR_SYSTEM" is an element of "GALAXY"**.
Then, `cases h with MILKY_WAY hMILKY_WAY` will break `h` into two goals:
`MILKY_WAY : GALAXY`, which is read as **the "MILKY_WAY" is a term of the type "GALAXY"**, and
`hMILKY_WAY : SOLAR_SYSTEM MILKY_WAY, which is read as **the hypothesis hMILKY_WAY assumes that "SOLAR_SYSTEM"
is an element of the "MILKY_WAY"**. Is it better for you now? [**Tip:** Whenever you don't
understand an abstract concept, try to apply a real life example to it.]

Now, let's try to solve this level! From now on, it will be better if we start by reading the lemma
as many times as we need to understand it. Then, do a drawing of the situation. In this way, we can
think of a clearer path to close the goal. Once you feel ready, delete the `sorry` and take a look
to the hypothesis h1 and h2. As you may be thinking, we can apply the `cases` tactic to them. Following
the guiding thread of the real life example, we need to think about a specific line for each of them.
In geometry, lines are usually represented by the letters `r` and `s`. Then, type `cases h1 with r hr,`,
click on enter, and write `cases h2 with s hs,`. If you look at the local context, you'll see that we've
assumed that `r` and `s`are lines in the plane Ω.

Right after, it comes the genius idea. After reading the lemmma and trying to do a draw that represents
the situation, you should be wondering if we could create a hypothesis to state that the lines we've just
added to the local context are the same (`r = s`). Do you remember how we could add a hypothesis? Exactly,
the `have` tactic will do it for us! Now, type `have H : r = s,` (don't forget the comma).

Subsequently, we will have to prove two goals. First, try to look for a theorem statement that might help us
to close the `⊢ r = s` goal. Can you see that `equal_lines_of_contain_two_points` ends with exactly the `r = s`
statement? Then, try to look if we have all the previous implications of this statement in the local context of
this level. If so, why don't we use the `exact` tactic? [**Pro tip:** Whenever we have a hypothesis of the form
`h : P ∧ Q ∧ R`, we write `h.1` to refer to `P` and we type `h.2` to refer to `Q ∧ R`. If we want to refer to just
`Q`, we need to write `h.2.1`. Analogously, if we want to refer to just `R`, then we type `h.2.2`. With that being said,
you can solve the first goal!

When it comes to the second goal, you should remember what tactic comes handy for solving goals of the form
`⊢ ∃ x, P x`. Once you have it mind, try to use it with the hypotheses `r` or `s`. From there, some `split`'s, `exact`'s
and a `rewrite` will close the goal.

-/

/- Hint : Click here for a hint, in case you get stuck.
The tactic that comes handy for solving goals of the form `⊢ ∃ x, P x` is the `use` tactic. Type `use r,` and note how the goal
changes. Now, `split` will break the proof into different goals. Try to close with the `exact` tactic. You may need to use `rw` before
writing the last `exact` that will take you home. Bewildered? Click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

/- Lemma : no-side-bar
Given 4 distinct points that pass through a line, then that line passes through two different subsets of three points.
-/
lemma exists_line_example (P Q R S : Ω) (h : Q ≠ R) (h1 : ∃ ℓ : Line Ω, P ∈ ℓ ∧ Q ∈ ℓ ∧ R ∈ ℓ)
(h2 : ∃ ℓ : Line Ω, Q ∈ ℓ ∧ R ∈ ℓ ∧ S ∈ ℓ) :
∃ ℓ : Line Ω, P ∈ ℓ ∧ Q ∈ ℓ ∧ R ∈ ℓ ∧ S ∈ ℓ :=
begin

  cases h1 with r hr,
  cases h2 with s hs,
  have H : r = s,
  {
    exact equal_lines_of_contain_two_points h hr.2.1 hs.1 hr.2.2 hs.2.1,
  },
  use r,
  split,
  exact hr.1,
  split,
  exact hr.2.1,
  split,
  exact hr.2.2,
  rw H,
  exact hs.2.2,

end


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

! This file was ported from Lean 3 source module data.mv_polynomial.supported
! leanprover-community/mathlib commit a26d17fcd679e43d380d0583b33c9eca5359d41e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.MvPolynomial.Variables

/-!
# Polynomials supported by a set of variables

This file contains the definition and lemmas about `MvPolynomial.supported`.

## Main definitions

* `MvPolynomial.supported` : Given a set `s : Set σ`, `supported R s` is the subalgebra of
  `MvPolynomial σ R` consisting of polynomials whose set of variables is contained in `s`.
  This subalgebra is isomorphic to `MvPolynomial s R`.

## Tags
variables, polynomial, vars
-/

universe u v w

namespace MvPolynomial

variable {σ τ : Type _} {R : Type u} {S : Type v} {r : R} {e : ℕ} {n m : σ}

section CommSemiring

variable [CommSemiring R] {p q : MvPolynomial σ R}

variable (R)

/-- The set of polynomials whose variables are contained in `s` as a `Subalgebra` over `R`. -/
noncomputable def supported (s : Set σ) : Subalgebra R (MvPolynomial σ R) :=
  Algebra.adjoin R (X '' s)
#align mv_polynomial.supported MvPolynomial.supported

variable {R}

open Classical

open Algebra

theorem supported_eq_range_rename (s : Set σ) : supported R s = (rename ((↑) : s → σ)).range := by
  rw [supported, Set.image_eq_range, adjoin_range_eq_range_aeval, rename]
  congr
#align mv_polynomial.supported_eq_range_rename MvPolynomial.supported_eq_range_rename

/-- The isomorphism between the subalgebra of polynomials supported by `s` and `MvPolynomial s R`.-/
noncomputable def supportedEquivMvPolynomial (s : Set σ) : supported R s ≃ₐ[R] MvPolynomial s R :=
  (Subalgebra.equivOfEq _ _ (supported_eq_range_rename s)).trans
    (AlgEquiv.ofInjective (rename ((↑) : s → σ)) (rename_injective _ Subtype.val_injective)).symm
#align mv_polynomial.supported_equiv_mv_polynomial MvPolynomial.supportedEquivMvPolynomial

@[simp]
theorem supportedEquivMvPolynomial_symm_C (s : Set σ) (x : R) :
    (supportedEquivMvPolynomial s).symm (C x) = algebraMap R (supported R s) x := by
  ext1
  simp [supportedEquivMvPolynomial, MvPolynomial.algebraMap_eq]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.supported_equiv_mv_polynomial_symm_C MvPolynomial.supportedEquivMvPolynomial_symm_C

@[simp]
theorem supportedEquivMvPolynomial_symm_X (s : Set σ) (i : s) :
    (↑((supportedEquivMvPolynomial s).symm (X i : MvPolynomial s R)) : MvPolynomial σ R) = X ↑i :=
  by simp [supportedEquivMvPolynomial]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.supported_equiv_mv_polynomial_symm_X MvPolynomial.supportedEquivMvPolynomial_symm_X

variable {s t : Set σ}

theorem mem_supported : p ∈ supported R s ↔ ↑p.vars ⊆ s := by
  rw [supported_eq_range_rename, AlgHom.mem_range]
  constructor
  · rintro ⟨p, rfl⟩
    refine' _root_.trans (Finset.coe_subset.2 (vars_rename _ _)) _
    simp
  · intro hs
    exact exists_rename_eq_of_vars_subset_range p ((↑) : s → σ) Subtype.val_injective (by simpa)
#align mv_polynomial.mem_supported MvPolynomial.mem_supported

theorem supported_eq_vars_subset : (supported R s : Set (MvPolynomial σ R)) = { p | ↑p.vars ⊆ s } :=
  Set.ext fun _ ↦ mem_supported
#align mv_polynomial.supported_eq_vars_subset MvPolynomial.supported_eq_vars_subset

@[simp]
theorem mem_supported_vars (p : MvPolynomial σ R) : p ∈ supported R (↑p.vars : Set σ) := by
  rw [mem_supported]
#align mv_polynomial.mem_supported_vars MvPolynomial.mem_supported_vars

variable (s)

theorem supported_eq_adjoin_X : supported R s = Algebra.adjoin R (X '' s) := rfl
set_option linter.uppercaseLean3 false in
#align mv_polynomial.supported_eq_adjoin_X MvPolynomial.supported_eq_adjoin_X

@[simp]
theorem supported_univ : supported R (Set.univ : Set σ) = ⊤ := by
  simp [Algebra.eq_top_iff, mem_supported]
#align mv_polynomial.supported_univ MvPolynomial.supported_univ

@[simp]
theorem supported_empty : supported R (∅ : Set σ) = ⊥ := by simp [supported_eq_adjoin_X]
#align mv_polynomial.supported_empty MvPolynomial.supported_empty

variable {s}

theorem supported_mono (st : s ⊆ t) : supported R s ≤ supported R t :=
  Algebra.adjoin_mono (Set.image_subset _ st)
#align mv_polynomial.supported_mono MvPolynomial.supported_mono

@[simp]
theorem X_mem_supported [Nontrivial R] {i : σ} : X i ∈ supported R s ↔ i ∈ s := by
  simp [mem_supported]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.X_mem_supported MvPolynomial.X_mem_supported

@[simp]
theorem supported_le_supported_iff [Nontrivial R] : supported R s ≤ supported R t ↔ s ⊆ t := by
  constructor
  · intro h i
    simpa using @h (X i)
  · exact supported_mono
#align mv_polynomial.supported_le_supported_iff MvPolynomial.supported_le_supported_iff

theorem supported_strictMono [Nontrivial R] :
    StrictMono (supported R : Set σ → Subalgebra R (MvPolynomial σ R)) :=
  strictMono_of_le_iff_le fun _ _ ↦ supported_le_supported_iff.symm
#align mv_polynomial.supported_strict_mono MvPolynomial.supported_strictMono

theorem exists_restrict_to_vars (R : Type _) [CommRing R] {F : MvPolynomial σ ℤ}
    (hF : ↑F.vars ⊆ s) : ∃ f : (s → R) → R, ∀ x : σ → R, f (x ∘ (↑) : s → R) = aeval x F := by
  rw [← mem_supported, supported_eq_range_rename, AlgHom.mem_range] at hF
  cases' hF with F' hF'
  use fun z ↦ aeval z F'
  intro x
  simp only [← hF', aeval_rename]
#align mv_polynomial.exists_restrict_to_vars MvPolynomial.exists_restrict_to_vars

end CommSemiring

end MvPolynomial


import data.complex.basic
import data.fintype.basic
import data.matrix.basic
import linear_algebra.finite_dimensional
import .complex_transpose
import analysis.normed_space.basic
import tactic

noncomputable theory
open_locale big_operators
open_locale matrix

universes u v
variables {n m : Type u} [fintype n] [fintype m]

local notation `Euc` := (n → ℂ)

namespace vector
/-- Complex conjugate of a vector.-/
@[simp]
def conj (v : Euc) : Euc :=
λ i, complex.conj (v i)

@[simp]
lemma conj_val (v : Euc) (i : n) : conj v i = complex.conj (v i) := rfl

@[simp]
lemma smul_conj (x : ℂ) (v : Euc) :
  conj (x • v) = x.conj • conj(v) :=
by ext; simp

@[simp]
def complex_dot_product (v : Euc) (w : Euc) : ℂ :=
-- ∑ i, complex.conj (v i) * w i
matrix.dot_product v (conj w)

@[simp]
lemma complex_dot_product_zero {v : Euc} : complex_dot_product v (0 : Euc) = 0 :=
by {ext; simp}

lemma complex_dot_product_symm {v w : Euc} :
  (complex_dot_product v w) = (complex_dot_product w v).conj :=
sorry

@[simp]
lemma zero_complex_dot_product {v : Euc} : complex_dot_product (0 : Euc) v = 0 :=
by {ext;simp}

@[simp]
lemma add_complex_dot_product {v w u : Euc} :
  complex_dot_product (v + w) u = complex_dot_product v u + complex_dot_product w u :=
by {ext;simp}

@[simp]
lemma complex_dot_product_add {v w u : Euc} :
  complex_dot_product v (w + u) = complex_dot_product v w + complex_dot_product v u :=
by {rw [complex_dot_product_symm, @complex_dot_product_symm _ _ v w, @complex_dot_product_symm _ _ v u],
  simp only [conj, ring_hom.map_add, eq_self_iff_true, add_complex_dot_product]}

@[simp]
lemma complex_dot_product_sub {v w u : Euc} :
  complex_dot_product (v - w) u = complex_dot_product v u - complex_dot_product w u :=
begin
suffices : complex_dot_product v u = complex_dot_product (v - w) u +  complex_dot_product w u,
by exact eq_sub_of_add_eq (eq.symm this),
set u' := v - w with hu,
have : v = u' + w, by {exact eq_add_of_sub_eq rfl},
rw this, apply add_complex_dot_product,
end

@[simp]
lemma diagonal_complex_dot_product [decidable_eq n] (v w : Euc) (i : n) :
  complex_dot_product (matrix.diagonal v i) w = v i * w i :=
have ∀ j ≠ i, matrix.diagonal v i j * w j = 0 := λ j hij,
  by simp [matrix.diagonal_val_ne' hij],
  by convert finset.sum_eq_single i (λ j _, this j) _; sorry

@[simp]
lemma complex_dot_product_diagonal [decidable_eq n] (v w : Euc) (i : n) :
  complex_dot_product v (matrix.diagonal w i) = v i * w i :=
have ∀ j ≠ i, v j * matrix.diagonal w i j = 0 := λ j hij, by simp [matrix.diagonal_val_ne' hij],
by convert finset.sum_eq_single i (λ j _, this j) _; sorry

@[simp] lemma complex_dot_product_diagonal' [decidable_eq n] (v w : Euc) (i : n) :
  complex_dot_product v (λ j, matrix.diagonal w j i) = v i * w i :=
have ∀ j ≠ i, v j * matrix.diagonal w j i = 0 := λ j hij, by simp [matrix.diagonal_val_ne hij],
by convert finset.sum_eq_single i (λ j _, this j) _; sorry

@[simp] lemma neg_complex_dot_product (v w : Euc) :
  complex_dot_product (-v) w = - complex_dot_product v w :=
by simp [matrix.dot_product]

@[simp] lemma complex_dot_product_neg (v w : Euc) : complex_dot_product v (-w) = - complex_dot_product v w :=
by simp only [matrix.dot_product, conj, pi.neg_apply, mul_neg_eq_neg_mul_symm, ring_hom.map_neg, finset.sum_neg_distrib,
 complex_dot_product]

@[simp] lemma smul_complex_dot_product (x : ℂ) (v w : Euc) :
  complex_dot_product (x • v) w = x * complex_dot_product v w :=
by simp only [complex_dot_product, matrix.smul_dot_product]

@[simp] lemma complex_dot_product_smul (x : ℂ) (v w : Euc) :
  complex_dot_product v (x • w) = x.conj * complex_dot_product v w :=
by simp only [complex_dot_product, smul_conj, matrix.dot_product_smul]

@[simp]
def orthogonal (v : Euc) (w : Euc) : Prop :=
(complex_dot_product v w = 0)

def complex_norm (v : Euc) := complex_dot_product v v

end vector

section subspace
def is_orthogonal (S : set Euc) : subspace ℂ Euc → Prop :=
  λ W, ∀ w ∈ W, ∀ v ∈ S, (vector.complex_dot_product v w = 0)

def orthogonal_complement (S : set Euc) : subspace ℂ Euc :=
Inf {W | is_orthogonal S W}

end subspace


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import number_theory.liouville.basic
import topology.metric_space.baire
import topology.instances.irrational

/-!
# Density of Liouville numbers

In this file we prove that the set of Liouville numbers form a dense `Gδ` set. We also prove a
similar statement about irrational numbers.
-/

open_locale filter
open filter set metric

lemma set_of_liouville_eq_Inter_Union :
  {x | liouville x} =
    ⋂ n : ℕ, ⋃ (a b : ℤ) (hb : 1 < b), ball (a / b) (1 / b ^ n) \ {a / b} :=
begin
  ext x,
  simp only [mem_Inter, mem_Union, liouville, mem_set_of_eq, exists_prop, mem_diff,
    mem_singleton_iff, mem_ball, real.dist_eq, and_comm]
end

lemma is_Gδ_set_of_liouville : is_Gδ {x | liouville x} :=
begin
  rw set_of_liouville_eq_Inter_Union,
  refine is_Gδ_Inter (λ n, is_open.is_Gδ _),
  refine is_open_Union (λ a, is_open_Union $ λ b, is_open_Union $ λ hb, _),
  exact is_open_ball.inter is_closed_singleton.is_open_compl
end

lemma set_of_liouville_eq_irrational_inter_Inter_Union :
  {x | liouville x} =
    {x | irrational x} ∩ ⋂ n : ℕ, ⋃ (a b : ℤ) (hb : 1 < b), ball (a / b) (1 / b ^ n) :=
begin
  refine subset.antisymm _ _,
  { refine subset_inter (λ x hx, hx.irrational) _,
    rw set_of_liouville_eq_Inter_Union,
    exact Inter_mono (λ n, Union₂_mono $ λ a b, Union_mono $ λ hb, diff_subset _ _) },
  { simp only [inter_Inter, inter_Union, set_of_liouville_eq_Inter_Union],
    refine Inter_mono (λ n, Union₂_mono $ λ a b, Union_mono $ λ hb, _),
    rw [inter_comm],
    refine diff_subset_diff subset.rfl (singleton_subset_iff.2 ⟨a / b, _⟩),
    norm_cast }
end

/-- The set of Liouville numbers is a residual set. -/
lemma eventually_residual_liouville : ∀ᶠ x in residual ℝ, liouville x :=
begin
  rw [filter.eventually, set_of_liouville_eq_irrational_inter_Inter_Union],
  refine eventually_residual_irrational.and _,
  refine eventually_residual.2 ⟨_, _, rat.dense_embedding_coe_real.dense.mono _, subset.rfl⟩,
  { exact is_Gδ_Inter (λ n, is_open.is_Gδ $ is_open_Union $ λ a, is_open_Union $
      λ b, is_open_Union $ λ hb, is_open_ball) },
  { rintro _ ⟨r, rfl⟩,
    simp only [mem_Inter, mem_Union],
    refine λ n, ⟨r.num * 2, r.denom * 2, _, _⟩,
    { have := int.coe_nat_le.2 r.pos, rw int.coe_nat_one at this, linarith },
    { convert mem_ball_self _ using 2,
      { push_cast, norm_cast, norm_num },
      { refine one_div_pos.2 (pow_pos (int.cast_pos.2 _) _),
        exact mul_pos (int.coe_nat_pos.2 r.pos) zero_lt_two } } }
end

/-- The set of Liouville numbers in dense. -/
lemma dense_liouville : dense {x | liouville x} :=
dense_of_mem_residual eventually_residual_liouville


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import group_theory.quotient_group -- import Lean's quotient groups

/-

# Quotient groups

mathlib has quotient groups. Here's how they work.

-/

-- let G be a group and let N be a normal subgroup
variables (G : Type) [group G] (N : subgroup G) [subgroup.normal N]

-- The underlying type (or set) of the quotient group. Note that `⧸` is `\quot`, not the slash
-- character `/` in your keyboard.

example : Type := G ⧸ N

-- Let's check that the typeclass inference system can find the group structure on the quotient
example : group (G ⧸ N) := infer_instance

-- The group homomorphism from `G` to `G ⧸ N`

example : G →* G ⧸ N := quotient_group.mk' N

-- Remarks:
-- (1) Why `quotient_group.mk'` and not `quotient_group.mk`? Because the version without the `'`
-- is just the function, the version with the `'` is the group homomorphism.
-- (2) Why does `quotient_group.mk' N` want to have `N` as an input but not `G`? It's because
-- the type of `N` is `subgroup G` so Lean can figure out `G` from `N`: if you like, `N` "knows
-- which group it's a subgroup of".

-- Here is the basic API you need for quotient groups.

-- the map G → G ⧸ N is surjective
example : function.surjective (quotient_group.mk' N) := quotient_group.mk'_surjective N

-- Two elements of G have the same image in `G ⧸ N` iff they differ by an element of `N`
example (x y : G) : quotient_group.mk' N x = quotient_group.mk' N y ↔ ∃ n ∈ N, x * n = y :=
quotient_group.mk'_eq_mk' N

-- There is of course much more API, but if you want to get some practice you can
-- just develop some of it yourself from these two functions.

example : (quotient_group.mk' N).ker = N :=
begin
  sorry,
end

-- The "universal property" of quotients says that if you have a group homomorphism `φ : G →* H`
-- whose kernel contains `N` then it "extends" to a group homomorphism `ψ : G ⧸ N →* H`
-- such that the composite map `ψ ∘ (quotient_group.mk' N)` equals `φ`. Given `φ`, the `ψ` with
-- this property is called `quotient_group.lift N φ h`, where `h` is a proof of `∀ x, x ∈ N → φ x = 1`.

variables (H : Type) [group H] (φ : G →* H) (h : ∀ x, x ∈ N → φ x = 1)

example : G ⧸ N →* H := quotient_group.lift N φ h

-- The proof that if `x : G` then `(quotient_group.lift N φ h) ((quotient_group.mk' N) x) = φ x`
-- is, amazingly, `refl`.

example (x : G) : (quotient_group.lift N φ h) ((quotient_group.mk' N) x) = φ x :=
begin
  refl,
end

-- Technical remark: this would not be the case if quotient groups were *defined* to
-- be cosets. In Lean quotient groups are an *opaque definition*. What do I mean by this?
-- You probably learnt in algebra that if G is a group and H is a normal subgroup then the
-- quotient G⧸H has elements which are *equal* to cosets of H. In Lean this is not true.
-- A term of the quotient type G⧸H cannot be taken apart with `cases` because it is not *equal* to
-- a coset. But the universal property `quotient_group.lift` is all we need; we don't
-- need to worry about the underlying definition of the quotient.

-- Example. Let's use `quotient_group.lift` to define the following map. Say `φ : G →* H` is a
-- group hom and we have normal subgroups `N : subgroup G` and `P : subgroup H` such that `φ N ≤ P`.
-- Then the induced map `G →* H ⧸ P` has `N` in the kernel, so it "lifts" to a group hom
-- `ρ : G ⧸ N →* H ⧸ P` with the property that for all `x : G`,
-- `ρ (quotient_group.mk' N x) = quotient_group.mk' P (φ x)`. Let's define `ρ` and prove
-- this equality.

variables {G H φ N} {P : subgroup H}
variable [P.normal]

def ρ (h : N.map φ ≤ P) : G ⧸ N →* H ⧸ P :=
quotient_group.lift N ((quotient_group.mk' P).comp φ)
begin
  -- we are using `quotient_group.lift` so we need to supply the proof that `(mk' P).comp φ` kills `N`
  sorry,
end

-- Now let's prove that `ρ ∘ mk' N = mk' P ∘ φ`

/-
    G ----φ----> H
    |            |
    |            |
   mk'           mk'
    |            |
    \/           \/
  G ⧸ N --ρ--> H ⧸ P

-/
open quotient_group -- no idea why I didn't do this earlier

example (h : N.map φ ≤ P) (x : G) : ρ h (mk' N x) = mk' P (φ x) :=
begin
  -- this proof does my head in
  refl,
end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-

# Figuring out how to use the reals

## The `library_search` tactic

We saw in the previous sheet that we couldn't even prove something
as simple as "if `aₙ → L` then `-aₙ → -L`" because when you write down
the proof carefully, it relies on the fact that `|x - y| = |y - x|`
or, equivalently, that `|(-x)| = |x|`. I say "equivalently" because
`ring` will prove that `-(x - y) = y - x`.

You don't want to be proving stuff like `|x - y| = |y - x|` from first
principles. Someone else has already done all the hard work for you.
All you need to do is to learn how to find out the names of the lemmas.
The `library_search` tactic tells you the names of all these lemmas.
See where it says "try this" -- click there and Lean will replace
`library_search` with the actual name of the lemma. Once you've done
that, hover over the lemma name to see in what generality it holds.

## The `linarith` tactic

Some of the results below are bare inequalities which are too complex
to be in the library. The library contains "natural" or "standard"
results, but it doesn't contain a random inequality fact just because
it happens to be true -- the library just contains "beautiful" facts.

The `linarith` tactic is a tactic which can solve some equalities and inequalities
in ordered structures like the naturals or reals. Unlike `ring`, `linarith`
does look at hypotheses in the tactic state. For example if you have
hypotheses `h1 : a < b` and `h2 : b ≤ c` then `linarith` would prove
a goal of `⊢ a < c`.

However `linarith` doesn't know about anything other than `=`, `≠`,
`<` and `≤`, so don't expect it to prove any results about `|x|` or
`max A B`.

Experiment with the `library_search` and `linarith` tactics below.
Try and learn something about the naming convention which Lean uses;
see if you can start beginning to guess what various lemmas should be called.

-/

example (x : ℝ) : |(-x)| = |x| :=
begin
  sorry
end

example (x y : ℝ) : |x - y| = |y - x| :=
begin
  sorry
end

example (A B C : ℕ) : max A B ≤ C ↔ A ≤ C ∧ B ≤ C :=
begin
  sorry
end

example (x y : ℝ) : |x| < y ↔ -y < x ∧ x < y :=
begin
  sorry
end

example (ε : ℝ) (hε : 0 < ε) : 0 < ε / 2 :=
begin
  sorry,
end

example (a b x y : ℝ) (h1 : a < x) (h2 : b < y) : a + b < x + y :=
begin
  sorry,
end

example (ε : ℝ) (hε : 0 < ε) : 0 < ε / 3 :=
begin
  sorry,
end

example (a b c d x y : ℝ) (h1 : a + c < x) (h2 : b + d < y) :
  a + b + c + d < x + y :=
begin
  sorry
end


/-
Copyright (c) 2019 Michael Howes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Howes
-/
import group_theory.free_group
import group_theory.quotient_group

/-!
# Defining a group given by generators and relations

Given a subset `rels` of relations of the free group on a type `α`, this file constructs the group
given by generators `x : α` and relations `r ∈ rels`.

## Main definitions

* `presented_group rels`: the quotient group of the free group on a type `α` by a subset `rels` of
  relations of the free group on `α`.
* `of`: The canonical map from `α` to a presented group with generators `α`.
* `to_group f`: the canonical group homomorphism `presented_group rels → G`, given a function
  `f : α → G` from a type `α` to a group `G` which satisfies the relations `rels`.

## Tags

generators, relations, group presentations
-/

variables {α : Type}

/-- Given a set of relations, rels, over a type `α`, presented_group constructs the group with
generators `x : α` and relations `rels` as a quotient of free_group `α`.-/
def presented_group (rels : set (free_group α)) : Type :=
free_group α ⧸ subgroup.normal_closure rels

namespace presented_group

instance (rels : set (free_group α)) : group (presented_group (rels)) :=
quotient_group.quotient.group _

/-- `of` is the canonical map from `α` to a presented group with generators `x : α`. The term `x` is
mapped to the equivalence class of the image of `x` in `free_group α`. -/
def of {rels : set (free_group α)} (x : α) : presented_group rels :=
quotient_group.mk (free_group.of x)

section to_group

/-
Presented groups satisfy a universal property. If `G` is a group and `f : α → G` is a map such that
the images of `f` satisfy all the given relations, then `f` extends uniquely to a group homomorphism
from `presented_group rels` to `G`.
-/

variables {G : Type} [group G] {f : α → G} {rels : set (free_group α)}

local notation `F` := free_group.lift f

variable (h : ∀ r ∈ rels, F r = 1)

lemma closure_rels_subset_ker : subgroup.normal_closure rels ≤ monoid_hom.ker F :=
subgroup.normal_closure_le_normal (λ x w, (monoid_hom.mem_ker _).2 (h x w))

lemma to_group_eq_one_of_mem_closure : ∀ x ∈ subgroup.normal_closure rels, F x = 1 :=
λ x w, (monoid_hom.mem_ker _).1 $ closure_rels_subset_ker h w

/-- The extension of a map `f : α → G` that satisfies the given relations to a group homomorphism
from `presented_group rels → G`. -/
def to_group : presented_group rels →* G :=
quotient_group.lift (subgroup.normal_closure rels) F (to_group_eq_one_of_mem_closure h)

@[simp] lemma to_group.of {x : α} : to_group h (of x) = f x := free_group.lift.of

theorem to_group.unique (g : presented_group rels →* G)
  (hg : ∀ x : α, g (of x) = f x) : ∀ {x}, g x = to_group h x :=
λ x, quotient_group.induction_on x
    (λ _, free_group.lift.unique (g.comp (quotient_group.mk' _)) hg)

end to_group

instance (rels : set (free_group α)) : inhabited (presented_group rels) := ⟨1⟩

end presented_group


import .love01_definitions_and_statements_demo

/-! # LoVe Homework 8: Operational Semantics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (5 points): Arithmetic expressions

Recall the type of arithmetic expressions from lecture 1 and its evaluation
function: -/

#check aexp
#check eval

/-! Let us introduce the following abbreviation for an environment that maps
variable names to values: -/

def envir : Type :=
string → ℤ

/-! 1.1 (2 points). Complete the following Lean definition of a big-step-style
semantics for arithmetic expressions. The predicate `big_step` (`⟹`) relates
an arithmetic expression, an environment, and the value to which it the
expression evaluates in the given environment: -/

inductive big_step : aexp × envir → ℤ → Prop
| num {i env} : big_step (aexp.num i, env) i

infix ` ⟹ ` : 110 := big_step

/-! 1.2 (1 point). Prove the following lemma to validate your definition
above. -/

lemma big_step_add_two_two (env : envir) :
  (aexp.add (aexp.num 2) (aexp.num 2), env) ⟹ 4 :=
sorry

/-! 1.3 (2 points). Prove that the big-step semantics is sound with respect to
the `eval` function: -/

lemma big_step_sound (env : envir) (a : aexp) (i : ℤ) :
  (a, env) ⟹ i → eval env a = i :=
sorry

/-! ## Question 2 (4 points + 1 bonus points): Semantics of Regular Expressions

Regular expression are a very popular tool for software development. Often,
when textual input needs to be analyzed it is matched against a regular
expression. In this question, we define the syntax of regular expressions and
what it means for a regular expression to match a string.

We define `regex` to represent the following grammar:

    R ::= ∅       — `nothing`: matches nothing
        | ε       — `empty`: matches the empty string
        | a       — `atom`: matches the atom `a`
        | R ⬝ R    — `concat`: matches the concatenation of two regexes
        | R + R   — `alt`: matches either of two regexes
        | R*      — `star`: matches arbitrary many repetitions of a regex

Notice the rough correspondence with a WHILE language:

    `empty`  ~ `skip`
    `atom`   ~ assignment
    `concat` ~ sequential composition
    `alt`    ~ conditional statement
    `star`   ~ while loop -/

inductive regex (α : Type) : Type
| nothing {} : regex
| empty   {} : regex
| atom       : α → regex
| concat     : regex → regex → regex
| alt        : regex → regex → regex
| star       : regex → regex

/-! The `matches r s` predicate indicates that the regular expression `r` matches
the string `s`. -/

inductive matches {α : Type } : regex α → list α → Prop
| empty :
  matches regex.empty []
| atom (a : α) :
  matches (regex.atom a) [a]
| concat {r₁ r₂ : regex α} (s₁ s₂ : list α) (h₁ : matches r₁ s₁)
    (h₂ : matches r₂ s₂) :
  matches (regex.concat r₁ r₂) (s₁ ++ s₂)
| alt_left {r₁ r₂ : regex α} (s : list α) (h : matches r₁ s) :
  matches (regex.alt r₁ r₂) s
| alt_right {r₁ r₂ : regex α} (s : list α) (h : matches r₂ s) :
  matches (regex.alt r₁ r₂) s
| star_base {r : regex α} :
  matches (regex.star r) []
| star_step {r : regex α} (s s' : list α) (h₁ : matches r s)
    (h₂ : matches (regex.star r) s') :
  matches (regex.star r) (s ++ s')

/-! The introduction rules correspond to the following cases:

* match the empty string
* match one atom (e.g., character)
* match two concatenated regexes
* match the left option
* match the right option
* match the empty string (the base case of `R*`)
* match `R` followed again by `R*` (the induction step of `R*`)

2.1 (1 point). Explain why there is no rule for `nothing`. -/

-- enter your answer here

/-! 2.2 (3 points). Prove the following inversion rules. -/

@[simp] lemma matches_atom {α : Type} {s : list α} {a : α} :
  matches (regex.atom a) s ↔ s = [a] :=
sorry

@[simp] lemma matches_nothing {α : Type} {s : list α} :
  ¬ matches regex.nothing s :=
sorry

@[simp] lemma matches_empty {α : Type} {s : list α} :
  matches regex.empty s ↔ s = [] :=
sorry

@[simp] lemma matches_concat {α : Type} {s : list α} {r₁ r₂ : regex α} :
  matches (regex.concat r₁ r₂) s
  ↔ (∃s₁ s₂, matches r₁ s₁ ∧ matches r₂ s₂ ∧ s = s₁ ++ s₂) :=
sorry

@[simp] lemma matches_alt {α : Type} {s : list α} {r₁ r₂ : regex α} :
  matches (regex.alt r₁ r₂) s ↔ (matches r₁ s ∨ matches r₂ s) :=
sorry

/-! 2.3 (1 bonus points). Prove the following inversion rule. -/

lemma matches_star {α : Type} {s : list α} {r : regex α} :
  matches (regex.star r) s ↔
  (s = [] ∨ (∃s₁ s₂, matches r s₁ ∧ matches (regex.star r) s₂ ∧ s = s₁ ++ s₂)) :=
sorry

end LoVe


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

import analysis.inner_product_space.basic
import analysis.special_functions.complex.arg

/-!
# Rays in the complex numbers

This file links the definition `same_ray ℝ x y` with the equality of arguments of complex numbers,
the usual way this is considered.

## Main statements

* `complex.same_ray_iff` : Two complex numbers are on the same ray iff one of them is zero, or they
  have the same argument.
* `complex.abs_add_eq/complex.abs_sub_eq`: If two non zero complex numbers have different argument,
  then the triangle inequality becomes strict.

-/

variables {x y : ℂ}

namespace complex

lemma same_ray_iff : same_ray ℝ x y ↔ x = 0 ∨ y = 0 ∨ x.arg = y.arg :=
begin
  rcases eq_or_ne x 0 with rfl | hx,
  { simp },
  rcases eq_or_ne y 0 with rfl | hy,
  { simp },
  simp only [hx, hy, false_or, same_ray_iff_norm_smul_eq, arg_eq_arg_iff hx hy],
  field_simp [hx, hy],
  rw [mul_comm, eq_comm]
end

lemma same_ray_iff_arg_div_eq_zero : same_ray ℝ x y ↔ arg (x / y) = 0 :=
begin
  rw [←real.angle.to_real_zero, ←arg_coe_angle_eq_iff_eq_to_real, same_ray_iff],
  by_cases hx : x = 0, { simp [hx] },
  by_cases hy : y = 0, { simp [hy] },
  simp [hx, hy, arg_div_coe_angle, sub_eq_zero]
end

lemma abs_add_eq_iff : (x + y).abs = x.abs + y.abs ↔ x = 0 ∨ y = 0 ∨ x.arg = y.arg :=
same_ray_iff_norm_add.symm.trans same_ray_iff

lemma abs_sub_eq_iff : (x - y).abs = |x.abs - y.abs| ↔ x = 0 ∨ y = 0 ∨ x.arg = y.arg :=
same_ray_iff_norm_sub.symm.trans same_ray_iff

lemma same_ray_of_arg_eq (h : x.arg = y.arg) : same_ray ℝ x y :=
same_ray_iff.mpr $ or.inr $ or.inr h

lemma abs_add_eq (h : x.arg = y.arg) : (x + y).abs = x.abs + y.abs :=
(same_ray_of_arg_eq h).norm_add

lemma abs_sub_eq (h : x.arg = y.arg) : (x - y).abs = ‖x.abs - y.abs‖ :=
(same_ray_of_arg_eq h).norm_sub

end complex