/-
Copyright (c) 2019 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.local_extr
import analysis.convex.slope
import analysis.convex.topology
import data.complex.is_R_or_C

/-!
# The mean value inequality and equalities

In this file we prove the following facts:

* `convex.norm_image_sub_le_of_norm_deriv_le` : if `f` is differentiable on a convex set `s`
  and the norm of its derivative is bounded by `C`, then `f` is Lipschitz continuous on `s` with
  constant `C`; also a variant in which what is bounded by `C` is the norm of the difference of the
  derivative from a fixed linear map. This lemma and its versions are formulated using `is_R_or_C`,
  so they work both for real and complex derivatives.

* `image_le_of*`, `image_norm_le_of_*` : several similar lemmas deducing `f x ≤ B x` or
  `∥f x∥ ≤ B x` from upper estimates on `f'` or `∥f'∥`, respectively. These lemmas differ by
  their assumptions:

  * `of_liminf_*` lemmas assume that limit inferior of some ratio is less than `B' x`;
  * `of_deriv_right_*`, `of_norm_deriv_right_*` lemmas assume that the right derivative
    or its norm is less than `B' x`;
  * `of_*_lt_*` lemmas assume a strict inequality whenever `f x = B x` or `∥f x∥ = B x`;
  * `of_*_le_*` lemmas assume a non-strict inequality everywhere on `[a, b)`;
  * name of a lemma ends with `'` if (1) it assumes that `B` is continuous on `[a, b]`
    and has a right derivative at every point of `[a, b)`, and (2) the lemma has
    a counterpart assuming that `B` is differentiable everywhere on `ℝ`

* `norm_image_sub_le_*_segment` : if derivative of `f` on `[a, b]` is bounded above
  by a constant `C`, then `∥f x - f a∥ ≤ C * ∥x - a∥`; several versions deal with
  right derivative and derivative within `[a, b]` (`has_deriv_within_at` or `deriv_within`).

* `convex.is_const_of_fderiv_within_eq_zero` : if a function has derivative `0` on a convex set `s`,
  then it is a constant on `s`.

* `exists_ratio_has_deriv_at_eq_ratio_slope` and `exists_ratio_deriv_eq_ratio_slope` :
  Cauchy's Mean Value Theorem.

* `exists_has_deriv_at_eq_slope` and `exists_deriv_eq_slope` : Lagrange's Mean Value Theorem.

* `domain_mvt` : Lagrange's Mean Value Theorem, applied to a segment in a convex domain.

* `convex.image_sub_lt_mul_sub_of_deriv_lt`, `convex.mul_sub_lt_image_sub_of_lt_deriv`,
  `convex.image_sub_le_mul_sub_of_deriv_le`, `convex.mul_sub_le_image_sub_of_le_deriv`,
  if `∀ x, C (</≤/>/≥) (f' x)`, then `C * (y - x) (</≤/>/≥) (f y - f x)` whenever `x < y`.

* `convex.monotone_on_of_deriv_nonneg`, `convex.antitone_on_of_deriv_nonpos`,
  `convex.strict_mono_of_deriv_pos`, `convex.strict_anti_of_deriv_neg` :
  if the derivative of a function is non-negative/non-positive/positive/negative, then
  the function is monotone/antitone/strictly monotone/strictly monotonically
  decreasing.

* `convex_on_of_deriv_monotone_on`, `convex_on_of_deriv2_nonneg` : if the derivative of a function
  is increasing or its second derivative is nonnegative, then the original function is convex.

* `strict_fderiv_of_cont_diff` : a C^1 function over the reals is strictly differentiable.  (This
  is a corollary of the mean value inequality.)
-/

variables {E : Type*} [normed_group E] [normed_space ℝ E]
          {F : Type*} [normed_group F] [normed_space ℝ F]

open metric set asymptotics continuous_linear_map filter
open_locale classical topological_space nnreal

/-! ### One-dimensional fencing inequalities -/

/-- General fencing theorem for continuous functions with an estimate on the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `f a ≤ B a`;
* `B` has right derivative `B'` at every point of `[a, b)`;
* for each `x ∈ [a, b)` the right-side limit inferior of `(f z - f x) / (z - x)`
  is bounded above by a function `f'`;
* we have `f' x < B' x` whenever `f x = B x`.

Then `f x ≤ B x` everywhere on `[a, b]`. -/
lemma image_le_of_liminf_slope_right_lt_deriv_boundary' {f f' : ℝ → ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  -- `hf'` actually says `liminf (z - x)⁻¹ * (f z - f x) ≤ f' x`
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r →
    ∃ᶠ z in 𝓝[Ioi x] x, (z - x)⁻¹ * (f z - f x) < r)
  {B B' : ℝ → ℝ} (ha : f a ≤ B a) (hB : continuous_on B (Icc a b))
  (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x)
  (bound : ∀ x ∈ Ico a b, f x = B x → f' x < B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → f x ≤ B x :=
begin
  change Icc a b ⊆ {x | f x ≤ B x},
  set s := {x | f x ≤ B x} ∩ Icc a b,
  have A : continuous_on (λ x, (f x, B x)) (Icc a b), from hf.prod hB,
  have : is_closed s,
  { simp only [s, inter_comm],
    exact A.preimage_closed_of_closed is_closed_Icc order_closed_topology.is_closed_le' },
  apply this.Icc_subset_of_forall_exists_gt ha,
  rintros x ⟨hxB : f x ≤ B x, xab⟩ y hy,
  cases hxB.lt_or_eq with hxB hxB,
  { -- If `f x < B x`, then all we need is continuity of both sides
    refine nonempty_of_mem (inter_mem _ (Ioc_mem_nhds_within_Ioi ⟨le_rfl, hy⟩)),
    have : ∀ᶠ x in 𝓝[Icc a b] x, f x < B x,
      from A x (Ico_subset_Icc_self xab)
        (is_open.mem_nhds (is_open_lt continuous_fst continuous_snd) hxB),
    have : ∀ᶠ x in 𝓝[Ioi x] x, f x < B x,
      from nhds_within_le_of_mem (Icc_mem_nhds_within_Ioi xab) this,
    exact this.mono (λ y, le_of_lt) },
  { rcases exists_between (bound x xab hxB) with ⟨r, hfr, hrB⟩,
    specialize hf' x xab r hfr,
    have HB : ∀ᶠ z in 𝓝[Ioi x] x, r < (z - x)⁻¹ * (B z - B x),
      from (has_deriv_within_at_iff_tendsto_slope' $ lt_irrefl x).1
        (hB' x xab).Ioi_of_Ici (Ioi_mem_nhds hrB),
    obtain ⟨z, ⟨hfz, hzB⟩, hz⟩ :
      ∃ z, ((z - x)⁻¹ * (f z - f x) < r ∧ r < (z - x)⁻¹ * (B z - B x)) ∧ z ∈ Ioc x y,
      from ((hf'.and_eventually HB).and_eventually (Ioc_mem_nhds_within_Ioi ⟨le_rfl, hy⟩)).exists,
    refine ⟨z, _, hz⟩,
    have := (hfz.trans hzB).le,
    rwa [mul_le_mul_left (inv_pos.2 $ sub_pos.2 hz.1), hxB, sub_le_sub_iff_right] at this }
end

/-- General fencing theorem for continuous functions with an estimate on the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `f a ≤ B a`;
* `B` has derivative `B'` everywhere on `ℝ`;
* for each `x ∈ [a, b)` the right-side limit inferior of `(f z - f x) / (z - x)`
  is bounded above by a function `f'`;
* we have `f' x < B' x` whenever `f x = B x`.

Then `f x ≤ B x` everywhere on `[a, b]`. -/
lemma image_le_of_liminf_slope_right_lt_deriv_boundary {f f' : ℝ → ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  -- `hf'` actually says `liminf (z - x)⁻¹ * (f z - f x) ≤ f' x`
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r →
    ∃ᶠ z in 𝓝[Ioi x] x, (z - x)⁻¹ * (f z - f x) < r)
  {B B' : ℝ → ℝ} (ha : f a ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x)
  (bound : ∀ x ∈ Ico a b, f x = B x → f' x < B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → f x ≤ B x :=
image_le_of_liminf_slope_right_lt_deriv_boundary' hf hf' ha
  (λ x hx, (hB x).continuous_at.continuous_within_at)
  (λ x hx, (hB x).has_deriv_within_at) bound

/-- General fencing theorem for continuous functions with an estimate on the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `f a ≤ B a`;
* `B` has right derivative `B'` at every point of `[a, b)`;
* for each `x ∈ [a, b)` the right-side limit inferior of `(f z - f x) / (z - x)`
  is bounded above by `B'`.

Then `f x ≤ B x` everywhere on `[a, b]`. -/
lemma image_le_of_liminf_slope_right_le_deriv_boundary {f : ℝ → ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  {B B' : ℝ → ℝ} (ha : f a ≤ B a) (hB : continuous_on B (Icc a b))
  (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x)
  -- `bound` actually says `liminf (z - x)⁻¹ * (f z - f x) ≤ B' x`
  (bound : ∀ x ∈ Ico a b, ∀ r, B' x < r →
    ∃ᶠ z in 𝓝[Ioi x] x, (z - x)⁻¹ * (f z - f x) < r) :
  ∀ ⦃x⦄, x ∈ Icc a b → f x ≤ B x :=
begin
  have Hr : ∀ x ∈ Icc a b, ∀ r > 0, f x ≤ B x + r * (x - a),
  { intros x hx r hr,
    apply image_le_of_liminf_slope_right_lt_deriv_boundary' hf bound,
    { rwa [sub_self, mul_zero, add_zero] },
    { exact hB.add (continuous_on_const.mul
        (continuous_id.continuous_on.sub continuous_on_const)) },
    { assume x hx,
      exact (hB' x hx).add (((has_deriv_within_at_id x (Ici x)).sub_const a).const_mul r) },
    { assume x hx _,
      rw [mul_one],
      exact (lt_add_iff_pos_right _).2 hr },
    exact hx },
  assume x hx,
  have : continuous_within_at (λ r, B x + r * (x - a)) (Ioi 0) 0,
    from continuous_within_at_const.add (continuous_within_at_id.mul continuous_within_at_const),
  convert continuous_within_at_const.closure_le _ this (Hr x hx); simp
end

/-- General fencing theorem for continuous functions with an estimate on the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `f a ≤ B a`;
* `B` has right derivative `B'` at every point of `[a, b)`;
* `f` has right derivative `f'` at every point of `[a, b)`;
* we have `f' x < B' x` whenever `f x = B x`.

Then `f x ≤ B x` everywhere on `[a, b]`. -/
lemma image_le_of_deriv_right_lt_deriv_boundary' {f f' : ℝ → ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  {B B' : ℝ → ℝ} (ha : f a ≤ B a) (hB : continuous_on B (Icc a b))
  (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x)
  (bound : ∀ x ∈ Ico a b, f x = B x → f' x < B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → f x ≤ B x :=
image_le_of_liminf_slope_right_lt_deriv_boundary' hf
  (λ x hx r hr, (hf' x hx).liminf_right_slope_le hr) ha hB hB' bound

/-- General fencing theorem for continuous functions with an estimate on the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `f a ≤ B a`;
* `B` has derivative `B'` everywhere on `ℝ`;
* `f` has right derivative `f'` at every point of `[a, b)`;
* we have `f' x < B' x` whenever `f x = B x`.

Then `f x ≤ B x` everywhere on `[a, b]`. -/
lemma image_le_of_deriv_right_lt_deriv_boundary {f f' : ℝ → ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  {B B' : ℝ → ℝ} (ha : f a ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x)
  (bound : ∀ x ∈ Ico a b, f x = B x → f' x < B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → f x ≤ B x :=
image_le_of_deriv_right_lt_deriv_boundary' hf hf' ha
  (λ x hx, (hB x).continuous_at.continuous_within_at)
  (λ x hx, (hB x).has_deriv_within_at) bound

/-- General fencing theorem for continuous functions with an estimate on the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `f a ≤ B a`;
* `B` has derivative `B'` everywhere on `ℝ`;
* `f` has right derivative `f'` at every point of `[a, b)`;
* we have `f' x ≤ B' x` on `[a, b)`.

Then `f x ≤ B x` everywhere on `[a, b]`. -/
lemma image_le_of_deriv_right_le_deriv_boundary {f f' : ℝ → ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  {B B' : ℝ → ℝ} (ha : f a ≤ B a) (hB : continuous_on B (Icc a b))
  (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x)
  (bound : ∀ x ∈ Ico a b, f' x ≤ B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → f x ≤ B x :=
image_le_of_liminf_slope_right_le_deriv_boundary hf ha hB hB' $
assume x hx r hr, (hf' x hx).liminf_right_slope_le (lt_of_le_of_lt (bound x hx) hr)

/-! ### Vector-valued functions `f : ℝ → E` -/

section

variables {f : ℝ → E} {a b : ℝ}

/-- General fencing theorem for continuous functions with an estimate on the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `∥f a∥ ≤ B a`;
* `B` has right derivative at every point of `[a, b)`;
* for each `x ∈ [a, b)` the right-side limit inferior of `(∥f z∥ - ∥f x∥) / (z - x)`
  is bounded above by a function `f'`;
* we have `f' x < B' x` whenever `∥f x∥ = B x`.

Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. -/
lemma image_norm_le_of_liminf_right_slope_norm_lt_deriv_boundary {E : Type*} [normed_group E]
  {f : ℝ → E} {f' : ℝ → ℝ} (hf : continuous_on f (Icc a b))
  -- `hf'` actually says `liminf ∥z - x∥⁻¹ * (∥f z∥ - ∥f x∥) ≤ f' x`
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r →
    ∃ᶠ z in 𝓝[Ioi x] x, (z - x)⁻¹ * (∥f z∥ - ∥f x∥) < r)
  {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : continuous_on B (Icc a b))
  (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x)
  (bound : ∀ x ∈ Ico a b, ∥f x∥ = B x → f' x < B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x :=
image_le_of_liminf_slope_right_lt_deriv_boundary' (continuous_norm.comp_continuous_on hf) hf'
    ha hB hB' bound

/-- General fencing theorem for continuous functions with an estimate on the norm of the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `∥f a∥ ≤ B a`;
* `f` and `B` have right derivatives `f'` and `B'` respectively at every point of `[a, b)`;
* the norm of `f'` is strictly less than `B'` whenever `∥f x∥ = B x`.

Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions
to make this theorem work for piecewise differentiable functions.
-/
lemma image_norm_le_of_norm_deriv_right_lt_deriv_boundary' {f' : ℝ → E}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : continuous_on B (Icc a b))
  (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x)
  (bound : ∀ x ∈ Ico a b, ∥f x∥ = B x → ∥f' x∥ < B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x :=
image_norm_le_of_liminf_right_slope_norm_lt_deriv_boundary hf
  (λ x hx r hr, (hf' x hx).liminf_right_slope_norm_le hr) ha hB hB' bound

/-- General fencing theorem for continuous functions with an estimate on the norm of the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `∥f a∥ ≤ B a`;
* `f` has right derivative `f'` at every point of `[a, b)`;
* `B` has derivative `B'` everywhere on `ℝ`;
* the norm of `f'` is strictly less than `B'` whenever `∥f x∥ = B x`.

Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions
to make this theorem work for piecewise differentiable functions.
-/
lemma image_norm_le_of_norm_deriv_right_lt_deriv_boundary {f' : ℝ → E}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x)
  (bound : ∀ x ∈ Ico a b, ∥f x∥ = B x → ∥f' x∥ < B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x :=
image_norm_le_of_norm_deriv_right_lt_deriv_boundary' hf hf' ha
  (λ x hx, (hB x).continuous_at.continuous_within_at)
  (λ x hx, (hB x).has_deriv_within_at) bound

/-- General fencing theorem for continuous functions with an estimate on the norm of the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `∥f a∥ ≤ B a`;
* `f` and `B` have right derivatives `f'` and `B'` respectively at every point of `[a, b)`;
* we have `∥f' x∥ ≤ B x` everywhere on `[a, b)`.

Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions
to make this theorem work for piecewise differentiable functions.
-/
lemma image_norm_le_of_norm_deriv_right_le_deriv_boundary' {f' : ℝ → E}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : continuous_on B (Icc a b))
  (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x)
  (bound : ∀ x ∈ Ico a b, ∥f' x∥ ≤ B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x :=
image_le_of_liminf_slope_right_le_deriv_boundary (continuous_norm.comp_continuous_on hf) ha hB hB' $
  (λ x hx r hr, (hf' x hx).liminf_right_slope_norm_le (lt_of_le_of_lt (bound x hx) hr))

/-- General fencing theorem for continuous functions with an estimate on the norm of the derivative.
Let `f` and `B` be continuous functions on `[a, b]` such that

* `∥f a∥ ≤ B a`;
* `f` has right derivative `f'` at every point of `[a, b)`;
* `B` has derivative `B'` everywhere on `ℝ`;
* we have `∥f' x∥ ≤ B x` everywhere on `[a, b)`.

Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions
to make this theorem work for piecewise differentiable functions.
-/
lemma image_norm_le_of_norm_deriv_right_le_deriv_boundary {f' : ℝ → E}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x)
  (bound : ∀ x ∈ Ico a b, ∥f' x∥ ≤ B' x) :
  ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x :=
image_norm_le_of_norm_deriv_right_le_deriv_boundary' hf hf' ha
  (λ x hx, (hB x).continuous_at.continuous_within_at)
  (λ x hx, (hB x).has_deriv_within_at) bound

/-- A function on `[a, b]` with the norm of the right derivative bounded by `C`
satisfies `∥f x - f a∥ ≤ C * (x - a)`. -/
theorem norm_image_sub_le_of_norm_deriv_right_le_segment {f' : ℝ → E} {C : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  (bound : ∀x ∈ Ico a b, ∥f' x∥ ≤ C) :
  ∀ x ∈ Icc a b, ∥f x - f a∥ ≤ C * (x - a) :=
begin
  let g := λ x, f x - f a,
  have hg : continuous_on g (Icc a b), from hf.sub continuous_on_const,
  have hg' : ∀ x ∈ Ico a b, has_deriv_within_at g (f' x) (Ici x) x,
  { assume x hx,
    simpa using (hf' x hx).sub (has_deriv_within_at_const _ _ _) },
  let B := λ x, C * (x - a),
  have hB : ∀ x, has_deriv_at B C x,
  { assume x,
    simpa using (has_deriv_at_const x C).mul ((has_deriv_at_id x).sub (has_deriv_at_const x a)) },
  convert image_norm_le_of_norm_deriv_right_le_deriv_boundary hg hg' _ hB bound,
  simp only [g, B], rw [sub_self, norm_zero, sub_self, mul_zero]
end

/-- A function on `[a, b]` with the norm of the derivative within `[a, b]`
bounded by `C` satisfies `∥f x - f a∥ ≤ C * (x - a)`, `has_deriv_within_at`
version. -/
theorem norm_image_sub_le_of_norm_deriv_le_segment' {f' : ℝ → E} {C : ℝ}
  (hf : ∀ x ∈ Icc a b, has_deriv_within_at f (f' x) (Icc a b) x)
  (bound : ∀x ∈ Ico a b, ∥f' x∥ ≤ C) :
  ∀ x ∈ Icc a b, ∥f x - f a∥ ≤ C * (x - a) :=
begin
  refine norm_image_sub_le_of_norm_deriv_right_le_segment
    (λ x hx, (hf x hx).continuous_within_at) (λ x hx, _) bound,
  exact (hf x $ Ico_subset_Icc_self hx).nhds_within (Icc_mem_nhds_within_Ici hx)
end

/-- A function on `[a, b]` with the norm of the derivative within `[a, b]`
bounded by `C` satisfies `∥f x - f a∥ ≤ C * (x - a)`, `deriv_within`
version. -/
theorem norm_image_sub_le_of_norm_deriv_le_segment {C : ℝ} (hf : differentiable_on ℝ f (Icc a b))
  (bound : ∀x ∈ Ico a b, ∥deriv_within f (Icc a b) x∥ ≤ C) :
  ∀ x ∈ Icc a b, ∥f x - f a∥ ≤ C * (x - a) :=
begin
  refine norm_image_sub_le_of_norm_deriv_le_segment' _ bound,
  exact λ x hx, (hf x  hx).has_deriv_within_at
end

/-- A function on `[0, 1]` with the norm of the derivative within `[0, 1]`
bounded by `C` satisfies `∥f 1 - f 0∥ ≤ C`, `has_deriv_within_at`
version. -/
theorem norm_image_sub_le_of_norm_deriv_le_segment_01' {f' : ℝ → E} {C : ℝ}
  (hf : ∀ x ∈ Icc (0:ℝ) 1, has_deriv_within_at f (f' x) (Icc (0:ℝ) 1) x)
  (bound : ∀x ∈ Ico (0:ℝ) 1, ∥f' x∥ ≤ C) :
  ∥f 1 - f 0∥ ≤ C :=
by simpa only [sub_zero, mul_one]
  using norm_image_sub_le_of_norm_deriv_le_segment' hf bound 1 (right_mem_Icc.2 zero_le_one)

/-- A function on `[0, 1]` with the norm of the derivative within `[0, 1]`
bounded by `C` satisfies `∥f 1 - f 0∥ ≤ C`, `deriv_within` version. -/
theorem norm_image_sub_le_of_norm_deriv_le_segment_01 {C : ℝ}
  (hf : differentiable_on ℝ f (Icc (0:ℝ) 1))
  (bound : ∀x ∈ Ico (0:ℝ) 1, ∥deriv_within f (Icc (0:ℝ) 1) x∥ ≤ C) :
  ∥f 1 - f 0∥ ≤ C :=
by simpa only [sub_zero, mul_one]
  using norm_image_sub_le_of_norm_deriv_le_segment hf bound 1 (right_mem_Icc.2 zero_le_one)

theorem constant_of_has_deriv_right_zero (hcont : continuous_on f (Icc a b))
  (hderiv : ∀ x ∈ Ico a b, has_deriv_within_at f 0 (Ici x) x) :
  ∀ x ∈ Icc a b, f x = f a :=
by simpa only [zero_mul, norm_le_zero_iff, sub_eq_zero] using
  λ x hx, norm_image_sub_le_of_norm_deriv_right_le_segment
    hcont hderiv (λ y hy, by rw norm_le_zero_iff) x hx

theorem constant_of_deriv_within_zero (hdiff : differentiable_on ℝ f (Icc a b))
  (hderiv : ∀ x ∈ Ico a b, deriv_within f (Icc a b) x = 0) :
  ∀ x ∈ Icc a b, f x = f a :=
begin
  have H : ∀ x ∈ Ico a b, ∥deriv_within f (Icc a b) x∥ ≤ 0 :=
    by simpa only [norm_le_zero_iff] using λ x hx, hderiv x hx,
  simpa only [zero_mul, norm_le_zero_iff, sub_eq_zero] using
    λ x hx, norm_image_sub_le_of_norm_deriv_le_segment hdiff H x hx,
end

variables {f' g : ℝ → E}

/-- If two continuous functions on `[a, b]` have the same right derivative and are equal at `a`,
  then they are equal everywhere on `[a, b]`. -/
theorem eq_of_has_deriv_right_eq
  (derivf : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  (derivg : ∀ x ∈ Ico a b, has_deriv_within_at g (f' x) (Ici x) x)
  (fcont : continuous_on f (Icc a b)) (gcont : continuous_on g (Icc a b))
  (hi : f a = g a) :
  ∀ y ∈ Icc a b, f y = g y :=
begin
  simp only [← @sub_eq_zero _ _ (f _)] at hi ⊢,
  exact hi ▸ constant_of_has_deriv_right_zero (fcont.sub gcont)
    (λ y hy, by simpa only [sub_self] using (derivf y hy).sub (derivg y hy)),
end

/-- If two differentiable functions on `[a, b]` have the same derivative within `[a, b]` everywhere
  on `[a, b)` and are equal at `a`, then they are equal everywhere on `[a, b]`. -/
theorem eq_of_deriv_within_eq (fdiff : differentiable_on ℝ f (Icc a b))
  (gdiff : differentiable_on ℝ g (Icc a b))
  (hderiv : eq_on (deriv_within f (Icc a b)) (deriv_within g (Icc a b)) (Ico a b))
  (hi : f a = g a) :
  ∀ y ∈ Icc a b, f y = g y :=
begin
  have A : ∀ y ∈ Ico a b, has_deriv_within_at f (deriv_within f (Icc a b) y) (Ici y) y :=
    λ y hy, (fdiff y (mem_Icc_of_Ico hy)).has_deriv_within_at.nhds_within
      (Icc_mem_nhds_within_Ici hy),
  have B : ∀ y ∈ Ico a b, has_deriv_within_at g (deriv_within g (Icc a b) y) (Ici y) y :=
    λ y hy, (gdiff y (mem_Icc_of_Ico hy)).has_deriv_within_at.nhds_within
      (Icc_mem_nhds_within_Ici hy),
  exact eq_of_has_deriv_right_eq A (λ y hy, (hderiv hy).symm ▸ B y hy) fdiff.continuous_on
    gdiff.continuous_on hi
end

end

/-!
### Vector-valued functions `f : E → G`

Theorems in this section work both for real and complex differentiable functions. We use assumptions
`[is_R_or_C 𝕜] [normed_space 𝕜 E] [normed_space 𝕜 G]` to achieve this result. For the domain `E` we
also assume `[normed_space ℝ E] [is_scalar_tower ℝ 𝕜 E]` to have a notion of a `convex` set. In both
interesting cases `𝕜 = ℝ` and `𝕜 = ℂ` the assumption `[is_scalar_tower ℝ 𝕜 E]` is satisfied
automatically. -/

section

variables {𝕜 G : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E] [is_scalar_tower ℝ 𝕜 E]
  [normed_group G] [normed_space 𝕜 G]

namespace convex

variables  {f : E → G} {C : ℝ} {s : set E} {x y : E} {f' : E → E →L[𝕜] G} {φ : E →L[𝕜] G}

/-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C`, then
the function is `C`-Lipschitz. Version with `has_fderiv_within`. -/
theorem norm_image_sub_le_of_norm_has_fderiv_within_le
  (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ :=
begin
  letI : normed_space ℝ G := restrict_scalars.normed_space ℝ 𝕜 G,
  letI : is_scalar_tower ℝ 𝕜 G := restrict_scalars.is_scalar_tower _ _ _,
  /- By composition with `t ↦ x + t • (y-x)`, we reduce to a statement for functions defined
  on `[0,1]`, for which it is proved in `norm_image_sub_le_of_norm_deriv_le_segment`.
  We just have to check the differentiability of the composition and bounds on its derivative,
  which is straightforward but tedious for lack of automation. -/
  have C0 : 0 ≤ C := le_trans (norm_nonneg _) (bound x xs),
  set g : ℝ → E := λ t, x + t • (y - x),
  have Dg : ∀ t, has_deriv_at g (y-x) t,
  { assume t,
    simpa only [one_smul] using ((has_deriv_at_id t).smul_const (y - x)).const_add x },
  have segm : Icc 0 1 ⊆ g ⁻¹' s,
  { rw [← image_subset_iff, ← segment_eq_image'],
    apply hs.segment_subset xs ys },
  have : f x = f (g 0), by { simp only [g], rw [zero_smul, add_zero] },
  rw this,
  have : f y = f (g 1), by { simp only [g], rw [one_smul, add_sub_cancel'_right] },
  rw this,
  have D2: ∀ t ∈ Icc (0:ℝ) 1, has_deriv_within_at (f ∘ g) (f' (g t) (y - x)) (Icc 0 1) t,
  { intros t ht,
    have : has_fderiv_within_at f ((f' (g t)).restrict_scalars ℝ) s (g t),
      from hf (g t) (segm ht),
    exact this.comp_has_deriv_within_at _ (Dg t).has_deriv_within_at segm },
  apply norm_image_sub_le_of_norm_deriv_le_segment_01' D2,
  refine λ t ht, le_of_op_norm_le _ _ _,
  exact bound (g t) (segm $ Ico_subset_Icc_self ht)
end

/-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C` on
`s`, then the function is `C`-Lipschitz on `s`. Version with `has_fderiv_within` and
`lipschitz_on_with`. -/
theorem lipschitz_on_with_of_nnnorm_has_fderiv_within_le {C : ℝ≥0}
  (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥₊ ≤ C)
  (hs : convex ℝ s) : lipschitz_on_with C f s :=
begin
  rw lipschitz_on_with_iff_norm_sub_le,
  intros x x_in y y_in,
  exact hs.norm_image_sub_le_of_norm_has_fderiv_within_le hf bound y_in x_in
end

/-- Let `s` be a convex set in a real normed vector space `E`, let `f : E → G` be a function
differentiable within `s` in a neighborhood of `x : E` with derivative `f'`. Suppose that `f'` is
continuous within `s` at `x`. Then for any number `K : ℝ≥0` larger than `∥f' x∥₊`, `f` is
`K`-Lipschitz on some neighborhood of `x` within `s`. See also
`convex.exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at` for a version that claims
existence of `K` instead of an explicit estimate. -/
lemma exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at_of_nnnorm_lt
  (hs : convex ℝ s) {f : E → G} (hder : ∀ᶠ y in 𝓝[s] x, has_fderiv_within_at f (f' y) s y)
  (hcont : continuous_within_at f' s x) (K : ℝ≥0) (hK : ∥f' x∥₊ < K) :
  ∃ t ∈ 𝓝[s] x, lipschitz_on_with K f t :=
begin
  obtain ⟨ε, ε0, hε⟩ :
    ∃ ε > 0, ball x ε ∩ s ⊆ {y | has_fderiv_within_at f (f' y) s y ∧ ∥f' y∥₊ < K},
    from mem_nhds_within_iff.1 (hder.and $ hcont.nnnorm.eventually (gt_mem_nhds hK)),
  rw inter_comm at hε,
  refine ⟨s ∩ ball x ε, inter_mem_nhds_within _ (ball_mem_nhds _ ε0), _⟩,
  exact (hs.inter (convex_ball _ _)).lipschitz_on_with_of_nnnorm_has_fderiv_within_le
    (λ y hy, (hε hy).1.mono (inter_subset_left _ _)) (λ y hy, (hε hy).2.le)
end

/-- Let `s` be a convex set in a real normed vector space `E`, let `f : E → G` be a function
differentiable within `s` in a neighborhood of `x : E` with derivative `f'`. Suppose that `f'` is
continuous within `s` at `x`. Then for any number `K : ℝ≥0` larger than `∥f' x∥₊`, `f` is Lipschitz
on some neighborhood of `x` within `s`. See also
`convex.exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at_of_nnnorm_lt` for a version
with an explicit estimate on the Lipschitz constant. -/
lemma exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at
  (hs : convex ℝ s) {f : E → G} (hder : ∀ᶠ y in 𝓝[s] x, has_fderiv_within_at f (f' y) s y)
  (hcont : continuous_within_at f' s x) :
  ∃ K (t ∈ 𝓝[s] x), lipschitz_on_with K f t :=
(no_top _).imp $
  hs.exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at_of_nnnorm_lt hder hcont

/-- The mean value theorem on a convex set: if the derivative of a function within this set is
bounded by `C`, then the function is `C`-Lipschitz. Version with `fderiv_within`. -/
theorem norm_image_sub_le_of_norm_fderiv_within_le
  (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥fderiv_within 𝕜 f s x∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ :=
hs.norm_image_sub_le_of_norm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at)
bound xs ys

/-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C` on
`s`, then the function is `C`-Lipschitz on `s`. Version with `fderiv_within` and
`lipschitz_on_with`. -/
theorem lipschitz_on_with_of_nnnorm_fderiv_within_le {C : ℝ≥0}
  (hf : differentiable_on 𝕜 f s) (bound : ∀ x ∈ s, ∥fderiv_within 𝕜 f s x∥₊ ≤ C)
  (hs : convex ℝ s) : lipschitz_on_with C f s:=
hs.lipschitz_on_with_of_nnnorm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at) bound

/-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C`,
then the function is `C`-Lipschitz. Version with `fderiv`. -/
theorem norm_image_sub_le_of_norm_fderiv_le
  (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥fderiv 𝕜 f x∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ :=
hs.norm_image_sub_le_of_norm_has_fderiv_within_le
(λ x hx, (hf x hx).has_fderiv_at.has_fderiv_within_at) bound xs ys

/-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C` on
`s`, then the function is `C`-Lipschitz on `s`. Version with `fderiv` and `lipschitz_on_with`. -/
theorem lipschitz_on_with_of_nnnorm_fderiv_le {C : ℝ≥0}
  (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥fderiv 𝕜 f x∥₊ ≤ C)
  (hs : convex ℝ s) : lipschitz_on_with C f s :=
hs.lipschitz_on_with_of_nnnorm_has_fderiv_within_le
(λ x hx, (hf x hx).has_fderiv_at.has_fderiv_within_at) bound

/-- Variant of the mean value inequality on a convex set, using a bound on the difference between
the derivative and a fixed linear map, rather than a bound on the derivative itself. Version with
`has_fderiv_within`. -/
theorem norm_image_sub_le_of_norm_has_fderiv_within_le'
  (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x - φ∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x - φ (y - x)∥ ≤ C * ∥y - x∥ :=
begin
  /- We subtract `φ` to define a new function `g` for which `g' = 0`, for which the previous theorem
  applies, `convex.norm_image_sub_le_of_norm_has_fderiv_within_le`. Then, we just need to glue
  together the pieces, expressing back `f` in terms of `g`. -/
  let g := λy, f y - φ y,
  have hg : ∀ x ∈ s, has_fderiv_within_at g (f' x - φ) s x :=
    λ x xs, (hf x xs).sub φ.has_fderiv_within_at,
  calc ∥f y - f x - φ (y - x)∥ = ∥f y - f x - (φ y - φ x)∥ : by simp
  ... = ∥(f y - φ y) - (f x - φ x)∥ : by abel
  ... = ∥g y - g x∥ : by simp
  ... ≤ C * ∥y - x∥ : convex.norm_image_sub_le_of_norm_has_fderiv_within_le hg bound hs xs ys,
end

/-- Variant of the mean value inequality on a convex set. Version with `fderiv_within`. -/
theorem norm_image_sub_le_of_norm_fderiv_within_le'
  (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥fderiv_within 𝕜 f s x - φ∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x - φ (y - x)∥ ≤ C * ∥y - x∥ :=
hs.norm_image_sub_le_of_norm_has_fderiv_within_le' (λ x hx, (hf x hx).has_fderiv_within_at)
bound xs ys

/-- Variant of the mean value inequality on a convex set. Version with `fderiv`. -/
theorem norm_image_sub_le_of_norm_fderiv_le'
  (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥fderiv 𝕜 f x - φ∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x - φ (y - x)∥ ≤ C * ∥y - x∥ :=
hs.norm_image_sub_le_of_norm_has_fderiv_within_le'
(λ x hx, (hf x hx).has_fderiv_at.has_fderiv_within_at) bound xs ys

/-- If a function has zero Fréchet derivative at every point of a convex set,
then it is a constant on this set. -/
theorem is_const_of_fderiv_within_eq_zero (hs : convex ℝ s) (hf : differentiable_on 𝕜 f s)
  (hf' : ∀ x ∈ s, fderiv_within 𝕜 f s x = 0) (hx : x ∈ s) (hy : y ∈ s) :
  f x = f y :=
have bound : ∀ x ∈ s, ∥fderiv_within 𝕜 f s x∥ ≤ 0,
  from λ x hx, by simp only [hf' x hx, norm_zero],
by simpa only [(dist_eq_norm _ _).symm, zero_mul, dist_le_zero, eq_comm]
  using hs.norm_image_sub_le_of_norm_fderiv_within_le hf bound hx hy

theorem _root_.is_const_of_fderiv_eq_zero (hf : differentiable 𝕜 f) (hf' : ∀ x, fderiv 𝕜 f x = 0)
  (x y : E) :
  f x = f y :=
convex_univ.is_const_of_fderiv_within_eq_zero hf.differentiable_on
  (λ x _, by rw fderiv_within_univ; exact hf' x) trivial trivial

end convex

namespace convex

variables {f f' : 𝕜 → G} {s : set 𝕜} {x y : 𝕜}

/-- The mean value theorem on a convex set in dimension 1: if the derivative of a function is
bounded by `C`, then the function is `C`-Lipschitz. Version with `has_deriv_within`. -/
theorem norm_image_sub_le_of_norm_has_deriv_within_le {C : ℝ}
  (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ :=
convex.norm_image_sub_le_of_norm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at)
(λ x hx, le_trans (by simp) (bound x hx)) hs xs ys

/-- The mean value theorem on a convex set in dimension 1: if the derivative of a function is
bounded by `C` on `s`, then the function is `C`-Lipschitz on `s`.
Version with `has_deriv_within` and `lipschitz_on_with`. -/
theorem lipschitz_on_with_of_nnnorm_has_deriv_within_le {C : ℝ≥0} (hs : convex ℝ s)
  (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥₊ ≤ C) :
  lipschitz_on_with C f s :=
convex.lipschitz_on_with_of_nnnorm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at)
(λ x hx, le_trans (by simp) (bound x hx)) hs

/-- The mean value theorem on a convex set in dimension 1: if the derivative of a function within
this set is bounded by `C`, then the function is `C`-Lipschitz. Version with `deriv_within` -/
theorem norm_image_sub_le_of_norm_deriv_within_le {C : ℝ}
  (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥deriv_within f s x∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ :=
hs.norm_image_sub_le_of_norm_has_deriv_within_le (λ x hx, (hf x hx).has_deriv_within_at)
bound xs ys

/-- The mean value theorem on a convex set in dimension 1: if the derivative of a function is
bounded by `C` on `s`, then the function is `C`-Lipschitz on `s`.
Version with `deriv_within` and `lipschitz_on_with`. -/
theorem lipschitz_on_with_of_nnnorm_deriv_within_le {C : ℝ≥0} (hs : convex ℝ s)
  (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥deriv_within f s x∥₊ ≤ C) :
  lipschitz_on_with C f s :=
hs.lipschitz_on_with_of_nnnorm_has_deriv_within_le (λ x hx, (hf x hx).has_deriv_within_at) bound

/-- The mean value theorem on a convex set in dimension 1: if the derivative of a function is
bounded by `C`, then the function is `C`-Lipschitz. Version with `deriv`. -/
theorem norm_image_sub_le_of_norm_deriv_le {C : ℝ}
  (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥deriv f x∥ ≤ C)
  (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ :=
hs.norm_image_sub_le_of_norm_has_deriv_within_le
(λ x hx, (hf x hx).has_deriv_at.has_deriv_within_at) bound xs ys

/-- The mean value theorem on a convex set in dimension 1: if the derivative of a function is
bounded by `C` on `s`, then the function is `C`-Lipschitz on `s`.
Version with `deriv` and `lipschitz_on_with`. -/
theorem lipschitz_on_with_of_nnnorm_deriv_le {C : ℝ≥0}
  (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥deriv f x∥₊ ≤ C)
  (hs : convex ℝ s) : lipschitz_on_with C f s :=
hs.lipschitz_on_with_of_nnnorm_has_deriv_within_le
(λ x hx, (hf x hx).has_deriv_at.has_deriv_within_at) bound

end convex

end

/-! ### Functions `[a, b] → ℝ`. -/

section interval

-- Declare all variables here to make sure they come in a correct order
variables (f f' : ℝ → ℝ) {a b : ℝ} (hab : a < b) (hfc : continuous_on f (Icc a b))
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hfd : differentiable_on ℝ f (Ioo a b))
  (g g' : ℝ → ℝ) (hgc : continuous_on g (Icc a b)) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hgd : differentiable_on ℝ g (Ioo a b))

include hab hfc hff' hgc hgg'

/-- Cauchy's **Mean Value Theorem**, `has_deriv_at` version. -/
lemma exists_ratio_has_deriv_at_eq_ratio_slope :
  ∃ c ∈ Ioo a b, (g b - g a) * f' c = (f b - f a) * g' c :=
begin
  let h := λ x, (g b - g a) * f x - (f b - f a) * g x,
  have hI : h a = h b,
  { simp only [h], ring },
  let h' := λ x, (g b - g a) * f' x - (f b - f a) * g' x,
  have hhh' : ∀ x ∈ Ioo a b, has_deriv_at h (h' x) x,
    from λ x hx, ((hff' x hx).const_mul (g b - g a)).sub ((hgg' x hx).const_mul (f b - f a)),
  have hhc : continuous_on h (Icc a b),
    from (continuous_on_const.mul hfc).sub (continuous_on_const.mul hgc),
  rcases exists_has_deriv_at_eq_zero h h' hab hhc hI hhh' with ⟨c, cmem, hc⟩,
  exact ⟨c, cmem, sub_eq_zero.1 hc⟩
end

omit hfc hgc

/-- Cauchy's **Mean Value Theorem**, extended `has_deriv_at` version. -/
lemma exists_ratio_has_deriv_at_eq_ratio_slope' {lfa lga lfb lgb : ℝ}
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 lfa)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 lga))
  (hfb : tendsto f (𝓝[Iio b] b) (𝓝 lfb)) (hgb : tendsto g (𝓝[Iio b] b) (𝓝 lgb)) :
  ∃ c ∈ Ioo a b, (lgb - lga) * (f' c) = (lfb - lfa) * (g' c) :=
begin
  let h := λ x, (lgb - lga) * f x - (lfb - lfa) * g x,
  have hha : tendsto h (𝓝[Ioi a] a) (𝓝 $ lgb * lfa - lfb * lga),
  { have : tendsto h (𝓝[Ioi a] a)(𝓝 $ (lgb - lga) * lfa - (lfb - lfa) * lga) :=
      (tendsto_const_nhds.mul hfa).sub (tendsto_const_nhds.mul hga),
    convert this using 2,
    ring },
  have hhb : tendsto h (𝓝[Iio b] b) (𝓝 $ lgb * lfa - lfb * lga),
  { have : tendsto h (𝓝[Iio b] b)(𝓝 $ (lgb - lga) * lfb - (lfb - lfa) * lgb) :=
      (tendsto_const_nhds.mul hfb).sub (tendsto_const_nhds.mul hgb),
    convert this using 2,
    ring },
  let h' := λ x, (lgb - lga) * f' x - (lfb - lfa) * g' x,
  have hhh' : ∀ x ∈ Ioo a b, has_deriv_at h (h' x) x,
  { intros x hx,
    exact ((hff' x hx).const_mul _ ).sub (((hgg' x hx)).const_mul _) },
  rcases exists_has_deriv_at_eq_zero' hab hha hhb hhh' with ⟨c, cmem, hc⟩,
  exact ⟨c, cmem, sub_eq_zero.1 hc⟩
end

include hfc

omit hgg'

/-- Lagrange's Mean Value Theorem, `has_deriv_at` version -/
lemma exists_has_deriv_at_eq_slope : ∃ c ∈ Ioo a b, f' c = (f b - f a) / (b - a) :=
begin
  rcases exists_ratio_has_deriv_at_eq_ratio_slope f f' hab hfc hff'
    id 1 continuous_id.continuous_on (λ x hx, has_deriv_at_id x) with ⟨c, cmem, hc⟩,
  use [c, cmem],
  simp only [_root_.id, pi.one_apply, mul_one] at hc,
  rw [← hc, mul_div_cancel_left],
  exact ne_of_gt (sub_pos.2 hab)
end

omit hff'

/-- Cauchy's Mean Value Theorem, `deriv` version. -/
lemma exists_ratio_deriv_eq_ratio_slope :
  ∃ c ∈ Ioo a b, (g b - g a) * (deriv f c) = (f b - f a) * (deriv g c) :=
exists_ratio_has_deriv_at_eq_ratio_slope f (deriv f) hab hfc
  (λ x hx, ((hfd x hx).differentiable_at $ is_open.mem_nhds is_open_Ioo hx).has_deriv_at)
  g (deriv g) hgc $
    λ x hx, ((hgd x hx).differentiable_at $ is_open.mem_nhds is_open_Ioo hx).has_deriv_at

omit hfc

/-- Cauchy's Mean Value Theorem, extended `deriv` version. -/
lemma exists_ratio_deriv_eq_ratio_slope' {lfa lga lfb lgb : ℝ}
  (hdf : differentiable_on ℝ f $ Ioo a b) (hdg : differentiable_on ℝ g $ Ioo a b)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 lfa)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 lga))
  (hfb : tendsto f (𝓝[Iio b] b) (𝓝 lfb)) (hgb : tendsto g (𝓝[Iio b] b) (𝓝 lgb)) :
  ∃ c ∈ Ioo a b, (lgb - lga) * (deriv f c) = (lfb - lfa) * (deriv g c) :=
exists_ratio_has_deriv_at_eq_ratio_slope' _ _ hab _ _
  (λ x hx, ((hdf x hx).differentiable_at $ Ioo_mem_nhds hx.1 hx.2).has_deriv_at)
  (λ x hx, ((hdg x hx).differentiable_at $ Ioo_mem_nhds hx.1 hx.2).has_deriv_at)
  hfa hga hfb hgb

/-- Lagrange's **Mean Value Theorem**, `deriv` version. -/
lemma exists_deriv_eq_slope : ∃ c ∈ Ioo a b, deriv f c = (f b - f a) / (b - a) :=
exists_has_deriv_at_eq_slope f (deriv f) hab hfc
  (λ x hx, ((hfd x hx).differentiable_at $ is_open.mem_nhds is_open_Ioo hx).has_deriv_at)

end interval

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `C < f'`, then
`f` grows faster than `C * x` on `D`, i.e., `C * (y - x) < f y - f x` whenever `x, y ∈ D`,
`x < y`. -/
theorem convex.mul_sub_lt_image_sub_of_lt_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  {C} (hf'_gt : ∀ x ∈ interior D, C < deriv f x) :
  ∀ x y ∈ D, x < y → C * (y - x) < f y - f x :=
begin
  assume x y hx hy hxy,
  have hxyD : Icc x y ⊆ D, from hD.ord_connected.out hx hy,
  have hxyD' : Ioo x y ⊆ interior D,
    from subset_sUnion_of_mem ⟨is_open_Ioo, subset.trans Ioo_subset_Icc_self hxyD⟩,
  obtain ⟨a, a_mem, ha⟩ : ∃ a ∈ Ioo x y, deriv f a = (f y - f x) / (y - x),
    from exists_deriv_eq_slope f hxy (hf.mono hxyD) (hf'.mono hxyD'),
  have : C < (f y - f x) / (y - x), by { rw [← ha], exact hf'_gt _ (hxyD' a_mem) },
  exact (lt_div_iff (sub_pos.2 hxy)).1 this
end

/-- Let `f : ℝ → ℝ` be a differentiable function. If `C < f'`, then `f` grows faster than
`C * x`, i.e., `C * (y - x) < f y - f x` whenever `x < y`. -/
theorem mul_sub_lt_image_sub_of_lt_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f)
  {C} (hf'_gt : ∀ x, C < deriv f x) ⦃x y⦄ (hxy : x < y) :
  C * (y - x) < f y - f x :=
convex_univ.mul_sub_lt_image_sub_of_lt_deriv hf.continuous.continuous_on hf.differentiable_on
  (λ x _, hf'_gt x) x y trivial trivial hxy

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `C ≤ f'`, then
`f` grows at least as fast as `C * x` on `D`, i.e., `C * (y - x) ≤ f y - f x` whenever `x, y ∈ D`,
`x ≤ y`. -/
theorem convex.mul_sub_le_image_sub_of_le_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  {C} (hf'_ge : ∀ x ∈ interior D, C ≤ deriv f x) :
  ∀ x y ∈ D, x ≤ y → C * (y - x) ≤ f y - f x :=
begin
  assume x y hx hy hxy,
  cases eq_or_lt_of_le hxy with hxy' hxy', by rw [hxy', sub_self, sub_self, mul_zero],
  have hxyD : Icc x y ⊆ D, from hD.ord_connected.out hx hy,
  have hxyD' : Ioo x y ⊆ interior D,
    from subset_sUnion_of_mem ⟨is_open_Ioo, subset.trans Ioo_subset_Icc_self hxyD⟩,
  obtain ⟨a, a_mem, ha⟩ : ∃ a ∈ Ioo x y, deriv f a = (f y - f x) / (y - x),
    from exists_deriv_eq_slope f hxy' (hf.mono hxyD) (hf'.mono hxyD'),
  have : C ≤ (f y - f x) / (y - x), by { rw [← ha], exact hf'_ge _ (hxyD' a_mem) },
  exact (le_div_iff (sub_pos.2 hxy')).1 this
end

/-- Let `f : ℝ → ℝ` be a differentiable function. If `C ≤ f'`, then `f` grows at least as fast
as `C * x`, i.e., `C * (y - x) ≤ f y - f x` whenever `x ≤ y`. -/
theorem mul_sub_le_image_sub_of_le_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f)
  {C} (hf'_ge : ∀ x, C ≤ deriv f x) ⦃x y⦄ (hxy : x ≤ y) :
  C * (y - x) ≤ f y - f x :=
convex_univ.mul_sub_le_image_sub_of_le_deriv hf.continuous.continuous_on hf.differentiable_on
  (λ x _, hf'_ge x) x y trivial trivial hxy

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `f' < C`, then
`f` grows slower than `C * x` on `D`, i.e., `f y - f x < C * (y - x)` whenever `x, y ∈ D`,
`x < y`. -/
theorem convex.image_sub_lt_mul_sub_of_deriv_lt {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  {C} (lt_hf' : ∀ x ∈ interior D, deriv f x < C) :
  ∀ x y ∈ D, x < y → f y - f x < C * (y - x) :=
begin
  assume x y hx hy hxy,
  have hf'_gt : ∀ x ∈ interior D, -C < deriv (λ y, -f y) x,
  { assume x hx,
    rw [deriv.neg, neg_lt_neg_iff],
    exact lt_hf' x hx },
  simpa [-neg_lt_neg_iff]
    using neg_lt_neg (hD.mul_sub_lt_image_sub_of_lt_deriv hf.neg hf'.neg hf'_gt x y hx hy hxy)
end

/-- Let `f : ℝ → ℝ` be a differentiable function. If `f' < C`, then `f` grows slower than
`C * x` on `D`, i.e., `f y - f x < C * (y - x)` whenever `x < y`. -/
theorem image_sub_lt_mul_sub_of_deriv_lt {f : ℝ → ℝ} (hf : differentiable ℝ f)
  {C} (lt_hf' : ∀ x, deriv f x < C) ⦃x y⦄ (hxy : x < y) :
  f y - f x < C * (y - x) :=
convex_univ.image_sub_lt_mul_sub_of_deriv_lt hf.continuous.continuous_on hf.differentiable_on
  (λ x _, lt_hf' x) x y trivial trivial hxy

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `f' ≤ C`, then
`f` grows at most as fast as `C * x` on `D`, i.e., `f y - f x ≤ C * (y - x)` whenever `x, y ∈ D`,
`x ≤ y`. -/
theorem convex.image_sub_le_mul_sub_of_deriv_le {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  {C} (le_hf' : ∀ x ∈ interior D, deriv f x ≤ C) :
  ∀ x y ∈ D, x ≤ y → f y - f x ≤ C * (y - x) :=
begin
  assume x y hx hy hxy,
  have hf'_ge : ∀ x ∈ interior D, -C ≤ deriv (λ y, -f y) x,
  { assume x hx,
    rw [deriv.neg, neg_le_neg_iff],
    exact le_hf' x hx },
  simpa [-neg_le_neg_iff]
    using neg_le_neg (hD.mul_sub_le_image_sub_of_le_deriv hf.neg hf'.neg hf'_ge x y hx hy hxy)
end

/-- Let `f : ℝ → ℝ` be a differentiable function. If `f' ≤ C`, then `f` grows at most as fast
as `C * x`, i.e., `f y - f x ≤ C * (y - x)` whenever `x ≤ y`. -/
theorem image_sub_le_mul_sub_of_deriv_le {f : ℝ → ℝ} (hf : differentiable ℝ f)
  {C} (le_hf' : ∀ x, deriv f x ≤ C) ⦃x y⦄ (hxy : x ≤ y) :
  f y - f x ≤ C * (y - x) :=
convex_univ.image_sub_le_mul_sub_of_deriv_le hf.continuous.continuous_on hf.differentiable_on
  (λ x _, le_hf' x) x y trivial trivial hxy

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `f'` is positive, then
`f` is a strictly monotone function on `D`.
Note that we don't require differentiability explicitly as it already implied by the derivative
being strictly positive. -/
theorem convex.strict_mono_on_of_deriv_pos {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : ∀ x ∈ interior D, 0 < deriv f x) :
  strict_mono_on f D :=
begin
  rintro x hx y hy,
  simpa only [zero_mul, sub_pos] using hD.mul_sub_lt_image_sub_of_lt_deriv hf _ hf' x y hx hy,
  exact λ z hz, (differentiable_at_of_deriv_ne_zero (hf' z hz).ne').differentiable_within_at,
end

/-- Let `f : ℝ → ℝ` be a differentiable function. If `f'` is positive, then
`f` is a strictly monotone function.
Note that we don't require differentiability explicitly as it already implied by the derivative
being strictly positive. -/
theorem strict_mono_of_deriv_pos {f : ℝ → ℝ} (hf' : ∀ x, 0 < deriv f x) : strict_mono f :=
strict_mono_on_univ.1 $ convex_univ.strict_mono_on_of_deriv_pos
  (λ z _, (differentiable_at_of_deriv_ne_zero (hf' z).ne').differentiable_within_at
    .continuous_within_at)
  (λ x _, hf' x)

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `f'` is nonnegative, then
`f` is a monotone function on `D`. -/
theorem convex.monotone_on_of_deriv_nonneg {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'_nonneg : ∀ x ∈ interior D, 0 ≤ deriv f x) :
  monotone_on f D :=
λ x hx y hy hxy, by simpa only [zero_mul, sub_nonneg]
  using hD.mul_sub_le_image_sub_of_le_deriv hf hf' hf'_nonneg x y hx hy hxy

/-- Let `f : ℝ → ℝ` be a differentiable function. If `f'` is nonnegative, then
`f` is a monotone function. -/
theorem monotone_of_deriv_nonneg {f : ℝ → ℝ} (hf : differentiable ℝ f) (hf' : ∀ x, 0 ≤ deriv f x) :
  monotone f :=
monotone_on_univ.1 $ convex_univ.monotone_on_of_deriv_nonneg hf.continuous.continuous_on
  hf.differentiable_on (λ x _, hf' x)

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `f'` is negative, then
`f` is a strictly antitone function on `D`. -/
theorem convex.strict_anti_on_of_deriv_neg {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : ∀ x ∈ interior D, deriv f x < 0) :
  strict_anti_on f D :=
λ x hx y, by simpa only [zero_mul, sub_lt_zero]
  using hD.image_sub_lt_mul_sub_of_deriv_lt hf
  (λ z hz, (differentiable_at_of_deriv_ne_zero (hf' z hz).ne).differentiable_within_at) hf' x y hx

/-- Let `f : ℝ → ℝ` be a differentiable function. If `f'` is negative, then
`f` is a strictly antitone function.
Note that we don't require differentiability explicitly as it already implied by the derivative
being strictly negative. -/
theorem strict_anti_of_deriv_neg {f : ℝ → ℝ} (hf' : ∀ x, deriv f x < 0) :
  strict_anti f :=
strict_anti_on_univ.1 $ convex_univ.strict_anti_on_of_deriv_neg
  (λ z _, (differentiable_at_of_deriv_ne_zero (hf' z).ne).differentiable_within_at
    .continuous_within_at)
  (λ x _, hf' x)

/-- Let `f` be a function continuous on a convex (or, equivalently, connected) subset `D`
of the real line. If `f` is differentiable on the interior of `D` and `f'` is nonpositive, then
`f` is an antitone function on `D`. -/
theorem convex.antitone_on_of_deriv_nonpos {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'_nonpos : ∀ x ∈ interior D, deriv f x ≤ 0) :
  antitone_on f D :=
λ x hx y hy hxy, by simpa only [zero_mul, sub_nonpos]
  using hD.image_sub_le_mul_sub_of_deriv_le hf hf' hf'_nonpos x y hx hy hxy

/-- Let `f : ℝ → ℝ` be a differentiable function. If `f'` is nonpositive, then
`f` is an antitone function. -/
theorem antitone_of_deriv_nonpos {f : ℝ → ℝ} (hf : differentiable ℝ f) (hf' : ∀ x, deriv f x ≤ 0) :
  antitone f :=
antitone_on_univ.1 $ convex_univ.antitone_on_of_deriv_nonpos hf.continuous.continuous_on
  hf.differentiable_on (λ x _, hf' x)

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is differentiable on its interior,
and `f'` is monotone on the interior, then `f` is convex on `D`. -/
theorem monotone_on.convex_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'_mono : monotone_on (deriv f) (interior D)) :
  convex_on ℝ D f :=
convex_on_of_slope_mono_adjacent hD
begin
  intros x y z hx hz hxy hyz,
  -- First we prove some trivial inclusions
  have hxzD : Icc x z ⊆ D, from hD.ord_connected.out hx hz,
  have hxyD : Icc x y ⊆ D, from subset.trans (Icc_subset_Icc_right $ le_of_lt hyz) hxzD,
  have hxyD' : Ioo x y ⊆ interior D,
    from subset_sUnion_of_mem ⟨is_open_Ioo, subset.trans Ioo_subset_Icc_self hxyD⟩,
  have hyzD : Icc y z ⊆ D, from subset.trans (Icc_subset_Icc_left $ le_of_lt hxy) hxzD,
  have hyzD' : Ioo y z ⊆ interior D,
    from subset_sUnion_of_mem ⟨is_open_Ioo, subset.trans Ioo_subset_Icc_self hyzD⟩,
  -- Then we apply MVT to both `[x, y]` and `[y, z]`
  obtain ⟨a, ⟨hxa, hay⟩, ha⟩ : ∃ a ∈ Ioo x y, deriv f a = (f y - f x) / (y - x),
    from exists_deriv_eq_slope f hxy (hf.mono hxyD) (hf'.mono hxyD'),
  obtain ⟨b, ⟨hyb, hbz⟩, hb⟩ : ∃ b ∈ Ioo y z, deriv f b = (f z - f y) / (z - y),
    from exists_deriv_eq_slope f hyz (hf.mono hyzD) (hf'.mono hyzD'),
  rw [← ha, ← hb],
  exact hf'_mono (hxyD' ⟨hxa, hay⟩) (hyzD' ⟨hyb, hbz⟩) (hay.trans hyb).le
end

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is differentiable on its interior,
and `f'` is antitone on the interior, then `f` is concave on `D`. -/
theorem antitone_on.concave_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (h_anti : antitone_on (deriv f) (interior D)) :
  concave_on ℝ D f :=
begin
  have : monotone_on (deriv (-f)) (interior D),
  { intros x hx y hy hxy,
    convert neg_le_neg (h_anti hx hy hxy);
    convert deriv.neg },
  exact neg_convex_on_iff.mp (this.convex_on_of_deriv hD hf.neg hf'.neg),
end

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is differentiable on its interior,
and `f'` is strictly monotone on the interior, then `f` is strictly convex on `D`. -/
lemma strict_mono_on.strict_convex_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'_mono : strict_mono_on (deriv f) (interior D)) :
  strict_convex_on ℝ D f :=
strict_convex_on_of_slope_strict_mono_adjacent hD
begin
  intros x y z hx hz hxy hyz,
  -- First we prove some trivial inclusions
  have hxzD : Icc x z ⊆ D, from hD.ord_connected.out hx hz,
  have hxyD : Icc x y ⊆ D, from subset.trans (Icc_subset_Icc_right $ le_of_lt hyz) hxzD,
  have hxyD' : Ioo x y ⊆ interior D,
    from subset_sUnion_of_mem ⟨is_open_Ioo, subset.trans Ioo_subset_Icc_self hxyD⟩,
  have hyzD : Icc y z ⊆ D, from subset.trans (Icc_subset_Icc_left $ le_of_lt hxy) hxzD,
  have hyzD' : Ioo y z ⊆ interior D,
    from subset_sUnion_of_mem ⟨is_open_Ioo, subset.trans Ioo_subset_Icc_self hyzD⟩,
  -- Then we apply MVT to both `[x, y]` and `[y, z]`
  obtain ⟨a, ⟨hxa, hay⟩, ha⟩ : ∃ a ∈ Ioo x y, deriv f a = (f y - f x) / (y - x),
    from exists_deriv_eq_slope f hxy (hf.mono hxyD) (hf'.mono hxyD'),
  obtain ⟨b, ⟨hyb, hbz⟩, hb⟩ : ∃ b ∈ Ioo y z, deriv f b = (f z - f y) / (z - y),
    from exists_deriv_eq_slope f hyz (hf.mono hyzD) (hf'.mono hyzD'),
  rw [← ha, ← hb],
  exact hf'_mono (hxyD' ⟨hxa, hay⟩) (hyzD' ⟨hyb, hbz⟩) (hay.trans hyb)
end

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is differentiable on its interior,
and `f'` is strictly antitone on the interior, then `f` is strictly concave on `D`. -/
lemma strict_anti_on.strict_concave_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (h_anti : strict_anti_on (deriv f) (interior D)) :
  strict_concave_on ℝ D f :=
begin
  have : strict_mono_on (deriv (-f)) (interior D),
  { intros x hx y hy hxy,
    convert neg_lt_neg (h_anti hx hy hxy);
    convert deriv.neg },
  exact neg_strict_convex_on_iff.mp (this.strict_convex_on_of_deriv hD hf.neg hf'.neg),
end

/-- If a function `f` is differentiable and `f'` is monotone on `ℝ` then `f` is convex. -/
theorem monotone.convex_on_univ_of_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f)
  (hf'_mono : monotone (deriv f)) : convex_on ℝ univ f :=
(hf'_mono.monotone_on _).convex_on_of_deriv convex_univ hf.continuous.continuous_on
  hf.differentiable_on

/-- If a function `f` is differentiable and `f'` is antitone on `ℝ` then `f` is concave. -/
theorem antitone.concave_on_univ_of_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f)
  (hf'_anti : antitone (deriv f)) : concave_on ℝ univ f :=
(hf'_anti.antitone_on _).concave_on_of_deriv convex_univ hf.continuous.continuous_on
  hf.differentiable_on

/-- If a function `f` is differentiable and `f'` is strictly monotone on `ℝ` then `f` is strictly
convex. -/
lemma strict_mono.strict_convex_on_univ_of_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f)
  (hf'_mono : strict_mono (deriv f)) :
  strict_convex_on ℝ univ f :=
(hf'_mono.strict_mono_on _).strict_convex_on_of_deriv convex_univ hf.continuous.continuous_on
  hf.differentiable_on

/-- If a function `f` is differentiable and `f'` is strictly antitone on `ℝ` then `f` is strictly
concave. -/
lemma strict_anti.strict_concave_on_univ_of_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f)
  (hf'_anti : strict_anti (deriv f)) : strict_concave_on ℝ univ f :=
(hf'_anti.strict_anti_on _).strict_concave_on_of_deriv convex_univ hf.continuous.continuous_on
  hf.differentiable_on

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is twice differentiable on its
interior, and `f''` is nonnegative on the interior, then `f` is convex on `D`. -/
theorem convex_on_of_deriv2_nonneg {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'' : differentiable_on ℝ (deriv f) (interior D))
  (hf''_nonneg : ∀ x ∈ interior D, 0 ≤ (deriv^[2] f x)) :
  convex_on ℝ D f :=
(hD.interior.monotone_on_of_deriv_nonneg hf''.continuous_on (by rwa interior_interior)
  $ by rwa interior_interior).convex_on_of_deriv hD hf hf'

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is twice differentiable on its
interior, and `f''` is nonpositive on the interior, then `f` is concave on `D`. -/
theorem concave_on_of_deriv2_nonpos {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'' : differentiable_on ℝ (deriv f) (interior D))
  (hf''_nonpos : ∀ x ∈ interior D, deriv^[2] f x ≤ 0) :
  concave_on ℝ D f :=
(hD.interior.antitone_on_of_deriv_nonpos hf''.continuous_on (by rwa interior_interior)
  $ by rwa interior_interior).concave_on_of_deriv hD hf hf'

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is twice differentiable on its
interior, and `f''` is strictly positive on the interior, then `f` is strictly convex on `D`.
Note that we don't require twice differentiability explicitly as it already implied by the second
derivative being strictly positive. -/
lemma strict_convex_on_of_deriv2_pos {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'' : ∀ x ∈ interior D, 0 < (deriv^[2] f) x) :
  strict_convex_on ℝ D f :=
(hD.interior.strict_mono_on_of_deriv_pos (λ z hz,
  (differentiable_at_of_deriv_ne_zero (hf'' z hz).ne').differentiable_within_at
   .continuous_within_at) $ by rwa interior_interior).strict_convex_on_of_deriv hD hf hf'

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is twice differentiable on its
interior, and `f''` is strictly negative on the interior, then `f` is strictly concave on `D`.
Note that we don't require twice differentiability explicitly as it already implied by the second
derivative being strictly negative. -/
lemma strict_concave_on_of_deriv2_neg {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D))
  (hf'' : ∀ x ∈ interior D, deriv^[2] f x < 0) :
  strict_concave_on ℝ D f :=
(hD.interior.strict_anti_on_of_deriv_neg (λ z hz,
  (differentiable_at_of_deriv_ne_zero (hf'' z hz).ne).differentiable_within_at
   .continuous_within_at) $ by rwa interior_interior).strict_concave_on_of_deriv hD hf hf'

/-- If a function `f` is twice differentiable on a open convex set `D ⊆ ℝ` and
`f''` is nonnegative on `D`, then `f` is convex on `D`. -/
theorem convex_on_open_of_deriv2_nonneg {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D) {f : ℝ → ℝ}
  (hf' : differentiable_on ℝ f D) (hf'' : differentiable_on ℝ (deriv f) D)
  (hf''_nonneg : ∀ x ∈ D, 0 ≤ (deriv^[2] f) x) : convex_on ℝ D f :=
convex_on_of_deriv2_nonneg hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf')
  (by simpa [hD₂.interior_eq] using hf'') (by simpa [hD₂.interior_eq] using hf''_nonneg)

/-- If a function `f` is twice differentiable on an open convex set `D ⊆ ℝ` and
`f''` is nonpositive on `D`, then `f` is concave on `D`. -/
theorem concave_on_open_of_deriv2_nonpos {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D) {f : ℝ → ℝ}
  (hf' : differentiable_on ℝ f D) (hf'' : differentiable_on ℝ (deriv f) D)
  (hf''_nonpos : ∀ x ∈ D, deriv^[2] f x ≤ 0) : concave_on ℝ D f :=
concave_on_of_deriv2_nonpos hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf')
  (by simpa [hD₂.interior_eq] using hf'') (by simpa [hD₂.interior_eq] using hf''_nonpos)

/-- If a function `f` is twice differentiable on a open convex set `D ⊆ ℝ` and
`f''` is strictly positive on `D`, then `f` is strictly convex on `D`.
Note that we don't require twice differentiability explicitly as it already implied by the second
derivative being strictly positive. -/
lemma strict_convex_on_open_of_deriv2_pos {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D)
  {f : ℝ → ℝ} (hf' : differentiable_on ℝ f D) (hf'' : ∀ x ∈ D, 0 < (deriv^[2] f) x) :
  strict_convex_on ℝ D f :=
strict_convex_on_of_deriv2_pos hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf') $
  by simpa [hD₂.interior_eq] using hf''

/-- If a function `f` is twice differentiable on an open convex set `D ⊆ ℝ` and
`f''` is strictly negative on `D`, then `f` is strictly concave on `D`.
Note that we don't require twice differentiability explicitly as it already implied by the second
derivative being strictly negative. -/
lemma strict_concave_on_open_of_deriv2_neg {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D)
  {f : ℝ → ℝ} (hf' : differentiable_on ℝ f D) (hf'' : ∀ x ∈ D, deriv^[2] f x < 0) :
  strict_concave_on ℝ D f :=
strict_concave_on_of_deriv2_neg hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf') $
  by simpa [hD₂.interior_eq] using hf''

/-- If a function `f` is twice differentiable on `ℝ`, and `f''` is nonnegative on `ℝ`,
then `f` is convex on `ℝ`. -/
theorem convex_on_univ_of_deriv2_nonneg {f : ℝ → ℝ} (hf' : differentiable ℝ f)
  (hf'' : differentiable ℝ (deriv f)) (hf''_nonneg : ∀ x, 0 ≤ (deriv^[2] f) x) :
  convex_on ℝ univ f :=
convex_on_open_of_deriv2_nonneg convex_univ is_open_univ hf'.differentiable_on
  hf''.differentiable_on (λ x _, hf''_nonneg x)

/-- If a function `f` is twice differentiable on `ℝ`, and `f''` is nonpositive on `ℝ`,
then `f` is concave on `ℝ`. -/
theorem concave_on_univ_of_deriv2_nonpos {f : ℝ → ℝ} (hf' : differentiable ℝ f)
  (hf'' : differentiable ℝ (deriv f)) (hf''_nonpos : ∀ x, deriv^[2] f x ≤ 0) :
  concave_on ℝ univ f :=
concave_on_open_of_deriv2_nonpos convex_univ is_open_univ hf'.differentiable_on
  hf''.differentiable_on (λ x _, hf''_nonpos x)

/-- If a function `f` is twice differentiable on `ℝ`, and `f''` is strictly positive on `ℝ`,
then `f` is strictly convex on `ℝ`.
Note that we don't require twice differentiability explicitly as it already implied by the second
derivative being strictly positive. -/
lemma strict_convex_on_univ_of_deriv2_pos {f : ℝ → ℝ} (hf' : differentiable ℝ f)
  (hf'' : ∀ x, 0 < (deriv^[2] f) x) :
  strict_convex_on ℝ univ f :=
strict_convex_on_open_of_deriv2_pos convex_univ is_open_univ hf'.differentiable_on $ λ x _, hf'' x

/-- If a function `f` is twice differentiable on `ℝ`, and `f''` is strictly negative on `ℝ`,
then `f` is strictly concave on `ℝ`.
Note that we don't require twice differentiability explicitly as it already implied by the second
derivative being strictly negative. -/
lemma strict_concave_on_univ_of_deriv2_neg {f : ℝ → ℝ} (hf' : differentiable ℝ f)
  (hf'' : ∀ x, deriv^[2] f x < 0) :
  strict_concave_on ℝ univ f :=
strict_concave_on_open_of_deriv2_neg convex_univ is_open_univ hf'.differentiable_on $ λ x _, hf'' x

/-! ### Functions `f : E → ℝ` -/

/-- Lagrange's Mean Value Theorem, applied to convex domains. -/
theorem domain_mvt
  {f : E → ℝ} {s : set E} {x y : E} {f' : E → (E →L[ℝ] ℝ)}
  (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) :
  ∃ z ∈ segment ℝ x y, f y - f x = f' z (y - x) :=
begin
  have hIccIoo := @Ioo_subset_Icc_self ℝ _ 0 1,
-- parametrize segment
  set g : ℝ → E := λ t, x + t • (y - x),
  have hseg : ∀ t ∈ Icc (0:ℝ) 1, g t ∈ segment ℝ x y,
  { rw segment_eq_image',
    simp only [mem_image, and_imp, add_right_inj],
    intros t ht, exact ⟨t, ht, rfl⟩ },
  have hseg' : Icc 0 1 ⊆ g ⁻¹' s,
  { rw ← image_subset_iff, unfold image, change ∀ _, _,
    intros z Hz, rw mem_set_of_eq at Hz, rcases Hz with ⟨t, Ht, hgt⟩,
    rw ← hgt, exact hs.segment_subset xs ys (hseg t Ht) },
-- derivative of pullback of f under parametrization
  have hfg: ∀ t ∈ Icc (0:ℝ) 1, has_deriv_within_at (f ∘ g)
    ((f' (g t) : E → ℝ) (y-x)) (Icc (0:ℝ) 1) t,
  { intros t Ht,
    have hg : has_deriv_at g (y-x) t,
    { have := ((has_deriv_at_id t).smul_const (y - x)).const_add x,
      rwa one_smul at this },
    exact (hf (g t) $ hseg' Ht).comp_has_deriv_within_at _ hg.has_deriv_within_at hseg' },
-- apply 1-variable mean value theorem to pullback
  have hMVT : ∃ (t ∈ Ioo (0:ℝ) 1), ((f' (g t) : E → ℝ) (y-x)) = (f (g 1) - f (g 0)) / (1 - 0),
  { refine exists_has_deriv_at_eq_slope (f ∘ g) _ (by norm_num) _ _,
    { exact λ t Ht, (hfg t Ht).continuous_within_at },
    { exact λ t Ht, (hfg t $ hIccIoo Ht).has_deriv_at (Icc_mem_nhds Ht.1 Ht.2) } },
-- reinterpret on domain
  rcases hMVT with ⟨t, Ht, hMVT'⟩,
  use g t, refine ⟨hseg t $ hIccIoo Ht, _⟩,
  simp [g, hMVT'],
end

section is_R_or_C

/-!
### Vector-valued functions `f : E → F`.  Strict differentiability.

A `C^1` function is strictly differentiable, when the field is `ℝ` or `ℂ`. This follows from the
mean value inequality on balls, which is a particular case of the above results after restricting
the scalars to `ℝ`. Note that it does not make sense to talk of a convex set over `ℂ`, but balls
make sense and are enough. Many formulations of the mean value inequality could be generalized to
balls over `ℝ` or `ℂ`. For now, we only include the ones that we need.
-/

variables {𝕜 : Type*} [is_R_or_C 𝕜] {G : Type*} [normed_group G] [normed_space 𝕜 G]
  {H : Type*} [normed_group H] [normed_space 𝕜 H] {f : G → H} {f' : G → G →L[𝕜] H} {x : G}

/-- Over the reals or the complexes, a continuously differentiable function is strictly
differentiable. -/
lemma has_strict_fderiv_at_of_has_fderiv_at_of_continuous_at
  (hder : ∀ᶠ y in 𝓝 x, has_fderiv_at f (f' y) y) (hcont : continuous_at f' x) :
  has_strict_fderiv_at f (f' x) x :=
begin
-- turn little-o definition of strict_fderiv into an epsilon-delta statement
  refine is_o_iff.mpr (λ c hc, metric.eventually_nhds_iff_ball.mpr _),
-- the correct ε is the modulus of continuity of f'
  rcases metric.mem_nhds_iff.mp (inter_mem hder (hcont $ ball_mem_nhds _ hc)) with ⟨ε, ε0, hε⟩,
  refine ⟨ε, ε0, _⟩,
-- simplify formulas involving the product E × E
  rintros ⟨a, b⟩ h,
  rw [← ball_prod_same, prod_mk_mem_set_prod_eq] at h,
-- exploit the choice of ε as the modulus of continuity of f'
  have hf' : ∀ x' ∈ ball x ε, ∥f' x' - f' x∥ ≤ c,
  { intros x' H', rw ← dist_eq_norm, exact le_of_lt (hε H').2 },
-- apply mean value theorem
  letI : normed_space ℝ G := restrict_scalars.normed_space ℝ 𝕜 G,
  letI : is_scalar_tower ℝ 𝕜 G := restrict_scalars.is_scalar_tower _ _ _,
  refine (convex_ball _ _).norm_image_sub_le_of_norm_has_fderiv_within_le' _ hf' h.2 h.1,
  exact λ y hy, (hε hy).1.has_fderiv_within_at
end

/-- Over the reals or the complexes, a continuously differentiable function is strictly
differentiable. -/
lemma has_strict_deriv_at_of_has_deriv_at_of_continuous_at {f f' : 𝕜 → G} {x : 𝕜}
  (hder : ∀ᶠ y in 𝓝 x, has_deriv_at f (f' y) y) (hcont : continuous_at f' x) :
  has_strict_deriv_at f (f' x) x :=
has_strict_fderiv_at_of_has_fderiv_at_of_continuous_at (hder.mono (λ y hy, hy.has_fderiv_at)) $
  (smul_rightL 𝕜 _ _ 1).continuous.continuous_at.comp hcont

end is_R_or_C


import data.int.basic data.fintype data.nat.modeq data.set.finite data.nat.prime tactic.ring
universe u

local attribute [instance, priority 0] classical.prop_decidable

local attribute [instance] set_fintype

open fintype finset

noncomputable lemma fintype_of_injective {α β : Type*} {f : α → β} [fintype β]
  (hf : function.injective f) : fintype α :=
if h : nonempty α
then have i : inhabited α := classical.inhabited_of_nonempty h,
  of_surjective (@function.inv_fun _ i _ f) $ @function.inv_fun_surjective _ i _ _ hf
else ⟨∅, λ x, h ⟨x⟩⟩

lemma bijective_of_involution {α : Type*} {f : α → α} (hf : ∀ x, f (f x) = x) : function.bijective f :=
⟨λ x y hxy, by rw [← hf x, ← hf y, hxy], λ x, ⟨f x, hf x⟩⟩

lemma int.coe_nat_nonneg (n : ℕ) : (0 : ℤ) ≤ n := int.coe_nat_le_coe_nat_of_le $ nat.zero_le n

lemma finset_even_card_of_involution {α : Type*} {f : α → α} (s : finset α) : (∀ x ∈ s, f x ≠ x)
    → (∀ x ∈ s, f (f x) = x) → (∀ x : α, x ∈ s → f x ∈ s) → 2 ∣ card s :=
finset.strong_induction_on s $ λ s ht hf₁ hf₂ hs, or.by_cases (decidable.em (s = ∅)) (by simp {contextual := tt}) $
λ h, let ⟨x, hx⟩ := exists_mem_of_ne_empty h in
let t := filter (λ y, y ≠ x ∧ y ≠ f x) s in
have hts : t ⊂ s := ⟨filter_subset _, λ h, by have := subset_iff.1 h hx; simp * at *⟩,
have ht₂ : ∀ y, y ∈ t → f y ∈ t := λ y hyt,
  have hys : y ∈ s := mem_of_subset hts.1 hyt,
  have h₁ : f y ≠ x := λ h₂,
    have h₃ : y = f x := by rw [← h₂, hf₂ _ hys],
    by rw h₃ at hyt; simp * at *,
  have h₂ : f y ≠ f x := λ h₂,
    have hxy : y = x := by rw [← hf₂ _ hys, ← hf₂ _ hx, h₂],
    by simpa [hxy] using hyt,
  by simp * at *,
have hst : s = insert (f x) (insert x t) :=
  ext.2 $ λ z, ⟨λ h, by simp [*, or_iff_not_and_not] at * {contextual := tt},
  λ h, by rw [mem_insert, mem_insert] at h; exact or.by_cases h (λ h, h.symm ▸ hs _ hx)
  (λ h, or.by_cases h (λ h, h.symm ▸ hx) (λ h, mem_of_subset hts.1 h))⟩,
have hxt : x ∉ t := by simp [t],
have hfxt : f x ∉ insert x t := by simp [t, hf₁ x hx],
have hft₁ : ∀ y ∈ t, f y ≠ y := λ y hyt, hf₁ y (mem_of_subset hts.1 hyt),
have hft₂ : ∀ y ∈ t, f (f y) = y := λ y hyt, hf₂ y (mem_of_subset hts.1 hyt),
by rw [hst, card_insert_of_not_mem hfxt, card_insert_of_not_mem hxt, add_assoc];
  exact (nat.dvd_add_iff_right (ht _ hts hft₁ hft₂ ht₂)).1 dec_trivial

lemma fintype_even_card_of_involution {α : Type*} {f : α → α} [fintype α] (hf₁ : ∀ x : α, f x ≠ x)
    (hf₂ : ∀ x : α, f (f x) = x) : 2 ∣ card α :=
finset_even_card_of_involution _ (λ x hx, hf₁ x) (λ x hx, hf₂ x) (λ x hx, mem_univ _)

lemma set.card_univ {α : Type*} [fintype α] : fintype.card (set.univ : set α) = fintype.card α :=
card_congr ⟨λ a, a.1, λ a, ⟨a, set.mem_univ _⟩, λ ⟨_, _⟩, rfl, λ _, rfl⟩

lemma odd_card_of_involution_of_unique_fixed_point {α : Type*} {f : α → α} [fintype α]
    (hf₂ : ∀ x : α, f (f x) = x) (hf₃ : ∃! a : α, f a = a) : card α % 2 = 1 :=
let ⟨a, (ha₁ : f a = a), ha₂⟩ := hf₃ in
let f' : {b : α // b ≠ a} → {b : α // b ≠ a} :=
λ x, ⟨f x, λ h, x.2 ((bijective_of_involution hf₂).1 (h.trans ha₁.symm))⟩ in
have hf'₁ : ∀ x, f' x ≠ x := λ ⟨x, hx⟩ hx',
  have hx₂ : f x = x := subtype.mk.inj hx',
  hx (ha₂ x hx₂),
have hf'₂ : ∀ x, f' (f' x) = x := λ ⟨x, hx⟩, subtype.eq (hf₂ x),
have hab : a ∉ {b : α | b ≠ a} := by simp,
have hα : fintype.card α = fintype.card {b : α | b ≠ a} + 1 :=
  by rw [← set.card_fintype_insert' _ hab, ← set.card_univ];
  congr;
  exact set.ext (λ x, by simp [classical.em]),
let ⟨c, (hc : card {b : α | b ≠ a} = c * 2)⟩ := exists_eq_mul_left_of_dvd
    (fintype_even_card_of_involution hf'₁ hf'₂) in
by rw [hα, hc, add_comm]; exact nat.add_mul_mod_self_right _ _ _

lemma exists_fixed_point_of_involution_of_odd_card {α : Type*} {f : α → α} [fintype α]
    (ha : card α % 2 = 1) (hf₂ : ∀ x : α, f (f x) = x) : ∃ x, f x = x :=
by_contradiction $ λ hf₁, (dec_trivial : 0 ≠ 1) $ (nat.mod_eq_zero_of_dvd
(fintype_even_card_of_involution (forall_not_of_not_exists hf₁) hf₂)).symm.trans ha

open nat

private def S (p : ℕ) : set (ℤ × ℤ × ℤ) := {v | ((v.1) * (v.1) + 4 * v.2.1 * v.2.2 = ↑p)
    ∧ 0 ≤ v.1 ∧ 0 ≤ v.2.1 ∧ 0 ≤ v.2.2}

lemma nat.prime_not_square (n : ℕ) : ¬prime (n * n) :=
λ h, or.by_cases (h.2 _ $ dvd_mul_right n n)
(λ h₁, (dec_trivial : ¬ 1 ≥ 2) (h₁ ▸ h : prime (1 * 1)).1) $
λ h₁, have h₂ : n * 1 = n * n := by rwa mul_one,
have h₃ : 1 = n := (@nat.mul_left_inj n 1 n (prime.pos (h₁.symm ▸ h))).1 h₂,
(dec_trivial : ¬ 1 ≥ 2) (h₃.symm ▸ h : prime (1 * 1)).1

@[reducible] private def f₁ : ℤ × ℤ × ℤ → ℤ × ℤ × ℤ := λ ⟨x, y, z⟩, (x, z, y)

@[reducible] private def f₂ : ℤ × ℤ × ℤ → ℤ × ℤ × ℤ :=
λ ⟨x, y, z⟩, if x + z < y
  then (x + 2 * z, z, y - x - z)
  else (if 2 * y < x
      then (x - 2 * y, x - y + z, y)
      else (2 * y - x, y, x - y + z))

variables {p : ℕ} (hp : prime p) (hp₁ : p % 4 = 1)
include hp hp₁

private lemma x_pos : ∀ v : ℤ × ℤ × ℤ, v ∈ S p → (0 : ℤ) < v.1 :=
λ ⟨x, y, z⟩ ⟨hv, hx, hy, hz⟩,
lt_of_le_of_ne hx $ λ (h : 0 = x), have hp₂ : 4 * y * z = p := by simp [h.symm, hv.symm],
absurd (show (4 : ℤ) ∣ -1, from add_sub_cancel' (4 * (y * z)) (-1 : ℤ) ▸
dvd_sub (mul_assoc 4 y z ▸ hp₂.symm ▸ modeq.dvd_of_modeq hp₁.symm) (dvd_mul_right _ _)) dec_trivial

private lemma yz_pos : ∀ v : ℤ × ℤ × ℤ, v ∈ S p → (0 : ℤ) < v.2.1 ∧ (0 : ℤ) < v.2.2 :=
λ ⟨x, y, z⟩ ⟨hv, hx, hy, hz⟩,
have hxx : ↑p ≠ x * x := @int.nat_abs_mul_self x ▸ (λ h, nat.prime_not_square (int.nat_abs x)
  (by rwa ← int.coe_nat_inj h)),
⟨lt_of_le_of_ne hy $ λ (h : 0 = y), hxx $ eq.symm (by simpa [h.symm] using hv),
lt_of_le_of_ne hz $ λ (h : 0 = z), hxx $ eq.symm (by simpa [h.symm] using hv)⟩

private lemma v_lt_p_add_one : ∀ v : ℤ × ℤ × ℤ, v ∈ S p → int.nat_abs v.1 < p + 1 ∧
    int.nat_abs v.2.1 < p + 1 ∧ int.nat_abs v.2.2 < p + 1 :=
λ ⟨x, y, z⟩ ⟨(hv : x * x + 4 * y * z = p), (hx : 0 ≤ x), (hy : 0 ≤ y), (hz : 0 ≤ z)⟩,
begin
  suffices : (int.nat_abs x : ℤ) ≤ p ∧ (int.nat_abs y : ℤ) ≤ p ∧ (int.nat_abs z : ℤ) ≤ p,
    repeat {rw int.coe_nat_le at this},
    exact ⟨lt_succ_of_le this.1, lt_succ_of_le this.2.1, lt_succ_of_le this.2.2⟩,
  have hyz := yz_pos hp hp₁ (x, y, z) ⟨hv, hx, hy, hz⟩,
  rw [← int.nat_abs_mul_self, ← int.nat_abs_of_nonneg hy, ← int.nat_abs_of_nonneg hz] at hv,
  rw ← hv,
  exact ⟨le_add_of_le_of_nonneg (int.coe_nat_le.2 $ le_mul_self _)
      (mul_nonneg (mul_nonneg dec_trivial (int.coe_nat_nonneg _)) (int.coe_nat_nonneg _)),
    le_add_of_nonneg_of_le (int.coe_nat_nonneg _) (by rw mul_right_comm;
      exact le_mul_of_ge_one_left' (int.coe_nat_nonneg _) (@int.add_one_le_of_lt 0 _ $
      mul_pos (dec_trivial : (4 : ℤ) > 0) $ by rw int.nat_abs_of_nonneg hz; exact hyz.2)),
    le_add_of_nonneg_of_le (int.coe_nat_nonneg _)
      (le_mul_of_ge_one_left' (int.coe_nat_nonneg _) (@int.add_one_le_of_lt 0 _
      (mul_pos (dec_trivial : (4 : ℤ) > 0) (by rw int.nat_abs_of_nonneg hy; exact hyz.1))))⟩
end

private noncomputable lemma fintype_S : fintype (S p) :=
fintype_of_injective $ show function.injective (λ v, ⟨⟨int.nat_abs v.1.1,
(v_lt_p_add_one hp hp₁ v.1 v.2).1⟩, ⟨int.nat_abs v.1.2.1, (v_lt_p_add_one hp hp₁ v.1 v.2).2.1⟩,
⟨int.nat_abs v.1.2.2, (v_lt_p_add_one hp hp₁ v.1 v.2).2.2⟩⟩ :
S p → fin (p+1) × fin (p+1) × fin (p+1)), from λ ⟨⟨a₁, a₂, a₃⟩, ⟨ha, ha₁, ha₂, ha₃⟩⟩
⟨⟨b₁, b₂, b₃⟩, ⟨hb, hb₁, hb₂, hb₃⟩⟩ h,
have h : int.nat_abs a₁ = int.nat_abs b₁ ∧ int.nat_abs a₂ = int.nat_abs b₂
  ∧ int.nat_abs a₃ = int.nat_abs b₃ := by simpa [subtype.mk.inj_eq,
    iff.intro fin.veq_of_eq fin.eq_of_veq] using h,
subtype.eq $ by
  repeat {rw [← int.coe_nat_eq_coe_nat_iff, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg] at h};
  finish

private lemma f₁_S : ∀ v : ℤ × ℤ × ℤ, v ∈ S p → f₁ v ∈ S p :=
λ ⟨x, y, z⟩, by simp [S, mul_comm, *, mul_assoc, mul_left_comm, *, f₁] {contextual := tt}

private lemma f₁_invo_on_S : ∀ v : ℤ × ℤ × ℤ, f₁ (f₁ v) = v := λ ⟨x, y, z⟩, rfl

private lemma f₂_S : ∀ v : ℤ × ℤ × ℤ, v ∈ S p → f₂ v ∈ S p :=
λ ⟨x, y, z⟩ ⟨hv, hx, hy, hz⟩, or.by_cases (decidable.em (x + z < y))
(λ h, ⟨by simp [f₂, h, hv.symm, S, mul_add, add_mul]; ring,
by unfold f₂; rw if_pos h; exact add_nonneg hx (mul_nonneg dec_trivial hz),
by unfold f₂; rw if_pos h; exact hz, le_of_lt (by have h₂ := sub_pos.2 h; simpa [f₂, h] using h₂)⟩)
$ λ h, have h' : y ≤ x + z := le_of_not_gt h,
or.by_cases (decidable.em (2 * y < x)) (λ h₁, ⟨by simp [f₂, h, h₁, hv.symm, S, mul_add, add_mul]; ring,
le_of_lt (by have h₃ := sub_pos.2 h₁; simpa [f₂, h₃, h, h₁] using h₃),
by have h₃ := sub_nonneg.2 h'; simpa [f₂, h, h₁, h₃] using h₃, by simpa [f₂, h, h₁] using hy⟩) $
λ h₁, have h₁' : x ≤ 2 * y := le_of_not_gt h₁,
⟨by simp [f₂, h, h₁, hv.symm, S, mul_add, add_mul]; ring,
by have h₃ := sub_nonneg.2 h₁'; simpa [f₂, h, h₁, h₃] using h₃,
by simpa [f₂, h, h₁] using hy,
by have h₃ := sub_nonneg.2 h'; simpa [f₂, h, h₁] using h₃⟩

private lemma f₂_invo_on_S : ∀ v : ℤ × ℤ × ℤ, v ∈ S p → f₂ (f₂ v) = v :=
λ ⟨x, y, z⟩ hv,
have xp : 0 < x := x_pos hp hp₁ (x, y, z) hv,
have yzp : 0 < y ∧ 0 < z :=  yz_pos hp hp₁ (x, y, z) hv,
 or.by_cases (decidable.em (x + z < y)) (λ h,
have h₁ : ¬ x + (y + (2 * z + (-x + -z))) < z :=
  have h₁ : x + (y + (2 * z + (-x + -z))) = y + z := by ring,
  not_lt_of_ge (h₁.symm ▸ le_add_of_nonneg_left hv.2.2.1),
by simp[f₂, h, h₁, xp]; ring) $
λ h, or.by_cases (decidable.em (2 * y < x))
(λ h₁, have h₂ : y + -(2 * y) < z + -y :=
  have h₂ : y + -(2 * y) = -y := by ring,
  h₂.symm ▸ lt_add_of_pos_left _ yzp.2,
by simp[f₂, h, h₁, h₂]; ring) $
λ h₁, have h₂ : ¬ x + (z + (2 * y + (-x + -y))) < y :=
  have h₁ : x + (z + (2 * y + (-x + -y))) = z + y := by ring,
  not_lt_of_ge (h₁.symm ▸ le_add_of_nonneg_left hv.2.2.2),
have h₃ : ¬ 0 < -x := not_lt_of_ge $ le_of_lt $ neg_neg_of_pos xp,
by simp [f₂, h, h₁, h₂, h₃]; ring

private lemma f₂_fixed_point : ∃! v : S p, f₂ v = v :=
have hp4 : (0 : ℤ) ≤ p / 4 := int.div_nonneg (int.coe_nat_nonneg _) dec_trivial,
have h : ¬ (1 : ℤ) + p / 4 < 1 := not_lt_of_ge $ le_add_of_nonneg_right hp4,
⟨⟨(1, 1, (p / 4 : ℤ)),
⟨show (1 : ℤ) + 4 * (p / 4) = p,
from have h : (p : ℤ) % 4 = 1 := (int.coe_nat_eq_coe_nat_iff _ _).2 hp₁,
have h₁ : (p : ℤ) = p % 4 + 4 * (p / 4) := (int.mod_add_div _ _).symm,
by rw [h₁] {occs := occurrences.pos [2]}; rw h,
dec_trivial, dec_trivial, hp4 ⟩⟩,
⟨by simp [f₂, h, (dec_trivial : ¬ (2 : ℤ) < 1)]; refl,
λ ⟨⟨x, y, z⟩, ⟨hv, hx, hy, hz⟩ ⟩ hf,
have xp : 0 < x := x_pos hp hp₁ (x, y, z) ⟨hv, hx, hy, hz⟩,
have yzp : 0 < y ∧ 0 < z := yz_pos hp hp₁ (x, y, z) ⟨hv, hx, hy, hz⟩,
or.by_cases (decidable.em (x + z < y))
(λ h₁,
have h₂ : x + 2 * z ≠ x := λ h₃,
  have h₄ : x + 2 * z = x + 0 := by rwa add_zero,
  not_or dec_trivial (ne_of_lt yzp.2).symm (mul_eq_zero.1 ((add_left_inj _).1 h₄)),
by simpa [f₂, h₁, h₂] using hf) $ λ h₁,
or.by_cases (decidable.em (2 * y < x))
(λ h₂,
have h₃ : x + -(2 * y) ≠ x := λ h₄,
  have h₅ : x + -2 * y = x + 0 := by rwa [← neg_mul_eq_neg_mul, add_zero],
  not_or dec_trivial (ne_of_lt yzp.1).symm (mul_eq_zero.1 ((add_left_inj _).1 h₅)),
by simp [f₂, h₁, h₂, h₃] at hf; trivial) $ λ h₂,
have hf₁ : 2 * y - x = x ∧ x + (z + -y) = z := by simp [f₂, h₁, h₂] at hf; assumption,
have hxy : y = x := by rw [sub_eq_iff_eq_add, ← two_mul] at hf₁;
  exact eq_of_mul_eq_mul_left dec_trivial hf₁.1,
subtype.eq $ show (x, y, z) = (1, 1, p / 4), from
begin
  rw [hxy, mul_comm (4 : ℤ), mul_assoc] at hv,
  have hxp : int.nat_abs x ∣ p := int.coe_nat_dvd.1 (int.nat_abs_dvd.2 (hv ▸ dvd_add (dvd_mul_right _ _) (dvd_mul_right _ _))),
  have h4 : ((4 : ℕ) : ℤ) = 4 := rfl,
  cases hp.2 _ (hxp) with h₃ h₃,
  { have h₄ : x = 1 := by rwa [← int.coe_nat_eq_coe_nat_iff, int.nat_abs_of_nonneg hx] at h₃,
    rw [← mod_add_div p 4, hp₁, h₄, int.coe_nat_add, int.coe_nat_one, mul_one, one_mul, add_left_cancel_iff,
        int.coe_nat_mul] at hv,
    have : z = p / 4 := eq_of_mul_eq_mul_left_of_ne_zero dec_trivial hv,
    rw [hxy, h₄, this] },
  { have h4 : ((4 : ℕ) : ℤ) = 4 := rfl,
    rw [← int.nat_abs_of_nonneg hx, ← int.nat_abs_of_nonneg hz, h₃, ← mul_add] at hv,
    have := int.eq_one_of_mul_eq_self_right (int.coe_nat_ne_zero.2 (ne_of_lt (prime.pos hp)).symm) hv,
    rw [← h4, ← int.coe_nat_mul, ← int.coe_nat_add, ← int.coe_nat_one, int.coe_nat_eq_coe_nat_iff] at this,
    have : p ≤ 1 := this ▸ (le_add_right p (4 * int.nat_abs z)),
    exact absurd (prime.gt_one hp) (not_lt_of_ge this) }
end ⟩ ⟩

theorem fermat_sum_two_squares : ∃ a b : ℕ, a^2 + b^2 = p :=
have fS : fintype (S p) := fintype_S hp hp₁,
let f₁' : S p → S p := λ ⟨v, hv⟩, ⟨f₁ v, f₁_S hp hp₁ _ hv⟩ in
let f₂' : S p → S p := λ ⟨v, hv⟩, ⟨f₂ v, f₂_S hp hp₁ _ hv⟩ in
have hf₁ : ∀ v, f₁' (f₁' v) = v := λ ⟨v, hv⟩, subtype.eq $ f₁_invo_on_S hp hp₁ v,
have hf₂ : ∀ v, f₂' (f₂' v) = v := λ ⟨v, hv⟩, subtype.eq $ f₂_invo_on_S hp hp₁ v hv,
have hf₂u : ∃! v : S p, f₂' v = v :=
  let ⟨⟨v, vS⟩, ⟨hv₁, hv₂⟩⟩ := f₂_fixed_point hp hp₁ in
  ⟨⟨v, vS⟩, ⟨subtype.eq hv₁, λ ⟨w, wS⟩ hw, hv₂ ⟨w, wS⟩ (subtype.mk.inj hw) ⟩ ⟩,
let h := @odd_card_of_involution_of_unique_fixed_point _ _ fS hf₂ hf₂u in
let ⟨⟨⟨x, y, z⟩, hvp, ⟨hx, hy, hz⟩⟩, h⟩ := @exists_fixed_point_of_involution_of_odd_card _ _ fS h hf₁ in
have h : y = z := (prod.eq_iff_fst_eq_snd_eq.1 (prod.eq_iff_fst_eq_snd_eq.1 (subtype.mk.inj h)).2).2,
⟨int.nat_abs x, 2 * int.nat_abs y,
begin
  simp only [nat.pow_succ, nat.pow_zero, one_mul],
  rw [mul_right_comm 2, mul_assoc, mul_assoc, ← int.coe_nat_eq_coe_nat_iff, int.coe_nat_add,
      int.nat_abs_mul_self, int.coe_nat_mul, int.coe_nat_mul, int.nat_abs_mul_self, ← hvp, h],
  simp,
  ring,
end⟩


/-
Copyright (c) 2015 Jacob Gross. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jacob Gross, Jeremy Avigad

The complex numbers.
-/
import data.real
open real eq.ops

record complex : Type :=
(re : ℝ) (im : ℝ)

notation `ℂ` := complex

namespace complex

variables (u w z : ℂ)
variable n : ℕ

protected proposition eq {z w : ℂ} (H1 : complex.re z = complex.re w)
(H2 : complex.im z = complex.im w) : z = w :=
begin
  induction z,
  induction w,
  rewrite [H1, H2]
end

protected proposition eta (z : ℂ) : complex.mk (complex.re z) (complex.im z) = z :=
by cases z; exact rfl

definition of_real [coercion] (x : ℝ) : ℂ := complex.mk x 0
definition of_rat [coercion] (q : ℚ) : ℂ := q
definition of_int [coercion] (i : ℤ) : ℂ := i
definition of_nat [coercion] (n : ℕ) : ℂ := n
definition of_num [coercion] [reducible] (n : num) : ℂ := n

protected definition prio : num := num.pred real.prio

definition complex_has_zero [instance] [priority complex.prio] : has_zero ℂ :=
has_zero.mk (of_nat 0)

definition complex_has_one [instance] [priority complex.prio] : has_one ℂ :=
has_one.mk (of_nat 1)

theorem re_of_real (x : ℝ) : re (of_real x) = x := rfl

theorem im_of_real (x : ℝ) : im (of_real x) = 0 := rfl

protected definition add (z w : ℂ) : ℂ :=
complex.mk (complex.re z + complex.re w) (complex.im z + complex.im w)

protected definition neg (z : ℂ) : ℂ :=
complex.mk (-(re z)) (-(im z))

protected definition mul (z w : ℂ) : ℂ :=
complex.mk
  (complex.re w * complex.re z - complex.im w * complex.im z)
  (complex.re w * complex.im z + complex.im w * complex.re z)

/- notation -/

definition complex_has_add [instance] [priority complex.prio] : has_add complex :=
has_add.mk complex.add

definition complex_has_neg [instance] [priority complex.prio] : has_neg complex :=
has_neg.mk complex.neg

definition complex_has_mul [instance] [priority complex.prio] : has_mul complex :=
has_mul.mk complex.mul

protected theorem add_def (z w : ℂ) :
  z + w = complex.mk (complex.re z + complex.re w) (complex.im z + complex.im w) := rfl

protected theorem neg_def (z : ℂ) : -z = complex.mk (-(re z)) (-(im z)) := rfl

protected theorem mul_def (z w : ℂ) :
  z * w = complex.mk
    (complex.re w * complex.re z - complex.im w * complex.im z)
    (complex.re w * complex.im z + complex.im w * complex.re z) := rfl

-- TODO: what notation should we use for i?

definition ii := complex.mk 0 1

theorem i_mul_i : ii * ii = -1 := rfl

/- basic properties -/

protected theorem add_comm (w z : ℂ) : w + z = z + w :=
complex.eq !add.comm !add.comm

protected theorem add_assoc (w z u : ℂ) : (w + z) + u = w + (z + u) :=
complex.eq !add.assoc !add.assoc

protected theorem add_zero (z : ℂ) : z + 0 = z :=
complex.eq !add_zero !add_zero

protected theorem zero_add (z : ℂ) : 0 + z = z := !complex.add_comm ▸ !complex.add_zero

definition smul (x : ℝ) (z : ℂ) : ℂ :=
complex.mk (x*re z) (x*im z)

protected theorem add_right_inv : z + - z = 0 :=
complex.eq !add.right_inv !add.right_inv

protected theorem add_left_inv : - z + z = 0 :=
!complex.add_comm ▸ !complex.add_right_inv

protected theorem mul_comm : w * z = z * w :=
by rewrite [*complex.mul_def, *mul.comm (re w), *mul.comm (im w), add.comm]

protected theorem one_mul :  1 * z = z :=
by krewrite [complex.mul_def, *mul_one, *mul_zero, sub_zero, zero_add, complex.eta]

protected theorem mul_one :  z * 1 = z := !complex.mul_comm ▸ !complex.one_mul

protected theorem left_distrib  : u * (w + z) = u * w + u * z :=
begin
  rewrite [*complex.mul_def, *complex.add_def, ▸*, *right_distrib, -sub_sub, *sub_eq_add_neg],
  rewrite [*add.assoc, add.left_comm (re z * im u), add.left_comm (-_)]
end

protected theorem right_distrib : (u + w) * z = u * z + w * z :=
by rewrite [*complex.mul_comm _ z, complex.left_distrib]

protected theorem mul_assoc : (u * w) * z = u * (w * z) :=
begin
  rewrite [*complex.mul_def, ▸*, *sub_eq_add_neg, *left_distrib, *right_distrib, *neg_add],
  rewrite [-*neg_mul_eq_neg_mul, -*neg_mul_eq_mul_neg, *add.assoc, *mul.assoc],
  rewrite [add.comm (-(im z * (im w * _))), add.comm (-(im z * (im w * _))), *add.assoc]
end

theorem re_add (z w : ℂ) : re (z + w) = re z + re w := rfl

theorem im_add (z w : ℂ) : im (z + w) = im z + im w := rfl

/- coercions -/

theorem of_real_add (a b : ℝ) : of_real (a + b) = of_real a + of_real b := rfl

theorem of_real_mul (a b : ℝ) : of_real (a * b) = (of_real a) * (of_real b) :=
by rewrite [complex.mul_def, *re_of_real, *im_of_real, *mul_zero, *zero_mul, sub_zero, add_zero,
           mul.comm]

theorem of_real_neg (a : ℝ) : of_real (-a) = -(of_real a) := rfl

theorem of_real.inj {a b : ℝ} (H : of_real a = of_real b) : a = b :=
show re (of_real a) = re (of_real b), from congr_arg re H

theorem eq_of_of_real_eq_of_real {a b : ℝ} (H : of_real a = of_real b) : a = b :=
of_real.inj H

theorem of_real_eq_of_real_iff (a b : ℝ) : of_real a = of_real b ↔ a = b :=
iff.intro eq_of_of_real_eq_of_real !congr_arg

/- make complex an instance of ring -/

protected definition comm_ring [reducible] : comm_ring complex :=
  begin
    fapply comm_ring.mk,
    exact complex.add,
    exact complex.add_assoc,
    exact 0,
    exact complex.zero_add,
    exact complex.add_zero,
    exact complex.neg,
    exact complex.add_left_inv,
    exact complex.add_comm,
    exact complex.mul,
    exact complex.mul_assoc,
    exact 1,
    apply complex.one_mul,
    apply complex.mul_one,
    apply complex.left_distrib,
    apply complex.right_distrib,
    apply complex.mul_comm
  end

local attribute complex.comm_ring [instance]

definition complex_has_sub [instance] [priority complex.prio] : has_sub complex :=
has_sub.mk has_sub.sub

theorem of_real_sub (x y : ℝ) : of_real (x - y) = of_real x - of_real y :=
rfl

/- complex modulus and conjugate-/

definition cmod (z : ℂ) : ℝ :=
(complex.re z) * (complex.re z) + (complex.im z) * (complex.im z)

theorem cmod_zero : cmod 0 = 0 := rfl

theorem cmod_of_real (x : ℝ) : cmod x = x * x :=
by rewrite [↑cmod, re_of_real, im_of_real, mul_zero, add_zero]

theorem eq_zero_of_cmod_eq_zero {z : ℂ} (H : cmod z = 0) : z = 0 :=
have H1 : (complex.re z) * (complex.re z) + (complex.im z) * (complex.im z) = 0,
  from H,
have H2 : complex.re z = 0, from eq_zero_of_mul_self_add_mul_self_eq_zero H1,
have H3 : complex.im z = 0, from eq_zero_of_mul_self_add_mul_self_eq_zero (!add.comm ▸ H1),
show z = 0, from complex.eq H2 H3

definition conj (z : ℂ) : ℂ := complex.mk (complex.re z) (-(complex.im z))

theorem conj_of_real {x : ℝ} : conj (of_real x) = of_real x := rfl

theorem conj_add (z w : ℂ) : conj (z + w) = conj z + conj w :=
by rewrite [↑conj, *complex.add_def, ▸*, neg_add]

theorem conj_mul (z w : ℂ) : conj (z * w) = conj z * conj w :=
by rewrite [↑conj, *complex.mul_def, ▸*, neg_mul_neg, neg_add,
            -neg_mul_eq_mul_neg, -neg_mul_eq_neg_mul]

theorem conj_conj (z : ℂ) : conj (conj z) = z :=
by rewrite [↑conj, neg_neg, complex.eta]

theorem mul_conj_eq_of_real_cmod (z : ℂ) : z * conj z = of_real (cmod z) :=
by rewrite [↑conj, ↑cmod, ↑of_real, complex.mul_def, ▸*, -*neg_mul_eq_neg_mul,
            sub_neg_eq_add, mul.comm (re z) (im z), add.right_inv]

theorem cmod_conj (z : ℂ) : cmod (conj z) = cmod z :=
begin
  apply eq_of_of_real_eq_of_real,
  rewrite [-*mul_conj_eq_of_real_cmod, conj_conj, mul.comm]
end

theorem cmod_mul (z w : ℂ) : cmod (z * w) = cmod z * cmod w :=
begin
  apply eq_of_of_real_eq_of_real,
  rewrite [of_real_mul, -*mul_conj_eq_of_real_cmod, conj_mul, *mul.assoc, mul.left_comm w]
end

protected noncomputable definition inv (z : ℂ) : complex := conj z * of_real (cmod z)⁻¹

protected noncomputable definition complex_has_inv [instance] [priority complex.prio] :
  has_inv complex := has_inv.mk complex.inv

protected theorem inv_def (z : ℂ) : z⁻¹ = conj z * of_real (cmod z)⁻¹ := rfl

protected theorem inv_zero : 0⁻¹ = (0 : ℂ) :=
by krewrite [complex.inv_def, conj_of_real, zero_mul]

theorem of_real_inv (x : ℝ) : of_real x⁻¹ = (of_real x)⁻¹ :=
classical.by_cases
  (assume H : x = 0,
    by krewrite [H, inv_zero, complex.inv_zero])
  (assume H : x ≠ 0,
    by rewrite [complex.inv_def, cmod_of_real, conj_of_real, mul_inv_eq H H, -of_real_mul,
               -mul.assoc, mul_inv_cancel H, one_mul])

noncomputable protected definition div (z w : ℂ) : ℂ := z * w⁻¹

noncomputable definition complex_has_div [instance] [priority complex.prio] :
    has_div complex :=
  has_div.mk complex.div

protected theorem div_def (z w : ℂ) : z / w = z * w⁻¹ := rfl

theorem of_real_div (x y : ℝ) : of_real (x / y) = of_real x / of_real y :=
have H : x / y = x * y⁻¹, from rfl,
by rewrite [H, complex.div_def, of_real_mul, of_real_inv]

theorem conj_inv (z : ℂ) : (conj z)⁻¹ = conj (z⁻¹) :=
by rewrite [*complex.inv_def, conj_mul, *conj_conj, conj_of_real, cmod_conj]

protected theorem mul_inv_cancel {z : ℂ} (H : z ≠ 0) : z * z⁻¹ = 1 :=
by rewrite [complex.inv_def, -mul.assoc, mul_conj_eq_of_real_cmod, -of_real_mul,
            mul_inv_cancel (assume H', H (eq_zero_of_cmod_eq_zero H'))]

protected theorem inv_mul_cancel {z : ℂ} (H : z ≠ 0) : z⁻¹ * z = 1 :=
!mul.comm ▸ complex.mul_inv_cancel H

protected noncomputable definition has_decidable_eq : decidable_eq ℂ :=
take z w, classical.prop_decidable (z = w)

protected theorem zero_ne_one : (0 : ℂ) ≠ 1 :=
assume H, zero_ne_one (eq_of_of_real_eq_of_real H)

protected noncomputable definition discrete_field [trans_instance] :
  discrete_field ℂ :=
⦃ discrete_field, complex.comm_ring,
  mul_inv_cancel   := @complex.mul_inv_cancel,
  inv_mul_cancel   := @complex.inv_mul_cancel,
  zero_ne_one      := complex.zero_ne_one,
  inv_zero         := complex.inv_zero,
  has_decidable_eq := complex.has_decidable_eq
⦄

-- TODO : we still need the whole family of coercion properties, for nat, int, rat

-- coercions

theorem of_rat_eq (a : ℚ) : of_rat a = of_real (real.of_rat a) := rfl

theorem of_int_eq (a : ℤ) : of_int a = of_real (real.of_int a) := rfl

theorem of_nat_eq (a : ℕ) : of_nat a = of_real (real.of_nat a) := rfl

theorem of_rat.inj {x y : ℚ} (H : of_rat x = of_rat y) : x = y :=
real.of_rat.inj (of_real.inj H)

theorem eq_of_of_rat_eq_of_rat {x y : ℚ} (H : of_rat x = of_rat y) : x = y :=
of_rat.inj H

theorem of_rat_eq_of_rat_iff (x y : ℚ) : of_rat x = of_rat y ↔ x = y :=
iff.intro eq_of_of_rat_eq_of_rat !congr_arg

theorem of_int.inj {a b : ℤ} (H : of_int a = of_int b) : a = b :=
rat.of_int.inj (of_rat.inj H)

theorem eq_of_of_int_eq_of_int {a b : ℤ} (H : of_int a = of_int b) : a = b :=
of_int.inj H

theorem of_int_eq_of_int_iff (a b : ℤ) : of_int a = of_int b ↔ a = b :=
iff.intro of_int.inj !congr_arg

theorem of_nat.inj {a b : ℕ} (H : of_nat a = of_nat b) : a = b :=
int.of_nat.inj (of_int.inj H)

theorem eq_of_of_nat_eq_of_nat {a b : ℕ} (H : of_nat a = of_nat b) : a = b :=
of_nat.inj H

theorem of_nat_eq_of_nat_iff (a b : ℕ) : of_nat a = of_nat b ↔ a = b :=
iff.intro of_nat.inj !congr_arg

open rat

theorem of_rat_add (a b : ℚ) : of_rat (a + b) = of_rat a + of_rat b :=
by rewrite [of_rat_eq]

theorem of_rat_neg (a : ℚ) : of_rat (-a) = -of_rat a :=
by rewrite [of_rat_eq]

-- these show why we have to use krewrite in the next theorem: there are
-- two different instances of "has_mul".

-- set_option pp.notation false
-- set_option pp.coercions true
-- set_option pp.implicit true

theorem of_rat_mul (a b : ℚ) : of_rat (a * b) = of_rat a * of_rat b :=
by krewrite [of_rat_eq, real.of_rat_mul, of_real_mul]

open int

theorem of_int_add (a b : ℤ) : of_int (a + b) = of_int a + of_int b :=
  by krewrite [of_int_eq, real.of_int_add, of_real_add]

theorem of_int_neg (a : ℤ) : of_int (-a) = -of_int a :=
  by krewrite [of_int_eq, real.of_int_neg, of_real_neg]

theorem of_int_mul (a b : ℤ) : of_int (a * b) = of_int a * of_int b :=
  by krewrite [of_int_eq, real.of_int_mul, of_real_mul]

open nat

theorem of_nat_add (a b : ℕ) : of_nat (a + b) = of_nat a + of_nat b :=
  by krewrite [of_nat_eq, real.of_nat_add, of_real_add]

theorem of_nat_mul (a b : ℕ) : of_nat (a * b) = of_nat a * of_nat b :=
  by krewrite [of_nat_eq, real.of_nat_mul, of_real_mul]

end complex


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

/-!
# Type Spaces
This file defines the space of complete types over a first-order theory.
(Note that types in model theory are different from types in type theory.)

## Main Definitions
* `first_order.language.Theory.complete_type`:
  `T.complete_type α` consists of complete types over the theory `T` with variables `α`.

## Main Results
* `first_order.language.Theory.complete_type.nonempty_iff`:
  The space `T.complete_type α` is nonempty exactly when `T` is satisfiable.

## Implementation Notes
* Complete types are implemented as maximal consistent theories in an expanded language.
More frequently they are described as maximal consistent sets of formulas, but this is equivalent.

## TODO
* Connect `T.complete_type α` to sets of formulas `L.formula α`.

-/

universes u v w w'

open cardinal set
open_locale cardinal first_order classical

namespace first_order
namespace language
namespace Theory

variables {L : language.{u v}} (T : L.Theory) (α : Type w)

/-- A complete type over a given theory in a certain type of variables is a maximally
  consistent (with the theory) set of formulas in that type. -/
structure complete_type :=
(to_Theory : L[[α]].Theory)
(subset' : (L.Lhom_with_constants α).on_Theory T ⊆ to_Theory)
(is_maximal' : to_Theory.is_maximal)

variables {T α}

namespace complete_type

instance : set_like (T.complete_type α) (L[[α]].sentence) :=
⟨λ p, p.to_Theory, λ p q h, begin
  cases p,
  cases q,
  congr',
end⟩

lemma is_maximal (p : T.complete_type α) : is_maximal (p : L[[α]].Theory) :=
p.is_maximal'

lemma subset (p : T.complete_type α) :
  (L.Lhom_with_constants α).on_Theory T ⊆ (p : L[[α]].Theory) :=
p.subset'

lemma mem_or_not_mem (p : T.complete_type α) (φ : L[[α]].sentence) : φ ∈ p ∨ φ.not ∈ p :=
p.is_maximal.mem_or_not_mem φ

lemma mem_of_models (p : T.complete_type α) {φ : L[[α]].sentence}
  (h : (L.Lhom_with_constants α).on_Theory T ⊨ φ) :
  φ ∈ p :=
(p.mem_or_not_mem φ).resolve_right (λ con, ((models_iff_not_satisfiable _).1 h)
  (p.is_maximal.1.mono (union_subset p.subset (singleton_subset_iff.2 con))))

@[simp] lemma compl_set_of_mem {φ : L[[α]].sentence} :
  {p : T.complete_type α | φ ∈ p}ᶜ = {p : T.complete_type α | φ.not ∈ p} :=
ext (λ _, (not_mem_iff _ _).symm)

lemma set_of_subset_eq_empty_iff (S : L[[α]].Theory) :
  {p : T.complete_type α | S ⊆ ↑p} = ∅ ↔
    ¬ ((L.Lhom_with_constants α).on_Theory T ∪ S).is_satisfiable :=
begin
  rw [iff_not_comm, ← not_nonempty_iff_eq_empty, not_not, set.nonempty],
  refine ⟨λ h, ⟨⟨L[[α]].complete_theory h.some, (subset_union_left _ S).trans
    complete_theory.subset, complete_theory.is_maximal _ _⟩, (subset_union_right
      ((L.Lhom_with_constants α).on_Theory T) _).trans complete_theory.subset⟩, _⟩,
  rintro ⟨p, hp⟩,
  exact p.is_maximal.1.mono (union_subset p.subset hp),
end

lemma set_of_mem_eq_univ_iff (φ : L[[α]].sentence) :
  {p : T.complete_type α | φ ∈ p} = univ ↔ (L.Lhom_with_constants α).on_Theory T ⊨ φ :=
begin
  rw [models_iff_not_satisfiable, ← compl_empty_iff, compl_set_of_mem,
    ← set_of_subset_eq_empty_iff],
  simp,
end

lemma set_of_subset_eq_univ_iff (S : L[[α]].Theory) :
  {p : T.complete_type α | S ⊆ ↑p} = univ ↔
    (∀ φ, φ ∈ S → (L.Lhom_with_constants α).on_Theory T ⊨ φ) :=
begin
  have h : {p : T.complete_type α | S ⊆ ↑p} = ⋂₀ ((λ φ, {p | φ ∈ p}) '' S),
  { ext,
    simp [subset_def] },
  simp_rw [h, sInter_eq_univ, ← set_of_mem_eq_univ_iff],
  refine ⟨λ h φ φS, h _ ⟨_, φS, rfl⟩, _⟩,
  rintro h _ ⟨φ, h1, rfl⟩,
  exact h _ h1,
end

lemma nonempty_iff : nonempty (T.complete_type α) ↔
  T.is_satisfiable :=
begin
  rw ← is_satisfiable_on_Theory_iff (Lhom_with_constants_injective L α),
  rw [nonempty_iff_univ_nonempty, nonempty_iff_ne_empty, ne.def, not_iff_comm,
    ← union_empty ((L.Lhom_with_constants α).on_Theory T), ← set_of_subset_eq_empty_iff],
  simp,
end

instance : nonempty (complete_type ∅ α) :=
nonempty_iff.2 (is_satisfiable_empty L)

lemma Inter_set_of_subset {ι : Type*} (S : ι → L[[α]].Theory) :
  (⋂ (i : ι), {p : T.complete_type α | S i ⊆ p}) = {p | (⋃ (i : ι), S i) ⊆ p} :=
begin
  ext,
  simp only [mem_Inter, mem_set_of_eq, Union_subset_iff],
end

lemma to_list_foldr_inf_mem {p : T.complete_type α} {t : finset (L[[α]]).sentence} :
  t.to_list.foldr (⊓) ⊤ ∈ p ↔ (t : L[[α]].Theory) ⊆ ↑p :=
begin
  simp_rw [subset_def, ← set_like.mem_coe, p.is_maximal.mem_iff_models, models_sentence_iff,
    sentence.realize, formula.realize, bounded_formula.realize_foldr_inf, finset.mem_to_list],
  exact ⟨λ h φ hφ M, h _ _ hφ, λ h M φ hφ, h _ hφ _⟩,
end

end complete_type

end Theory
end language
end first_order