/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import order.complete_lattice
import order.order_dual
/-!
# Galois connections, insertions and coinsertions

Galois connections are order theoretic adjoints, i.e. a pair of functions `u` and `l`,
such that `∀ a b, l a ≤ b ↔ a ≤ u b`.

## Main definitions

* `galois_connection`: A Galois connection is a pair of functions `l` and `u` satisfying
  `l a ≤ b ↔ a ≤ u b`. They are special cases of adjoint functors in category theory,
  but do not depend on the category theory library in mathlib.
* `galois_insertion`: A Galois insertion is a Galois connection where `l ∘ u = id`
* `galois_coinsertion`: A Galois coinsertion is a Galois connection where `u ∘ l = id`

## Implementation details

Galois insertions can be used to lift order structures from one type to another.
For example if `α` is a complete lattice, and `l : α → β`, and `u : β → α` form a Galois insertion,
then `β` is also a complete lattice. `l` is the lower adjoint and `u` is the upper adjoint.

An example of a Galois insertion is in group theory. If `G` is a group, then there is a Galois
insertion between the set of subsets of `G`, `set G`, and the set of subgroups of `G`,
`subgroup G`. The lower adjoint is `subgroup.closure`, taking the `subgroup` generated by a `set`,
and the upper adjoint is the coercion from `subgroup G` to `set G`, taking the underlying set
of a subgroup.

Naively lifting a lattice structure along this Galois insertion would mean that the definition
of `inf` on subgroups would be `subgroup.closure (↑S ∩ ↑T)`. This is an undesirable definition
because the intersection of subgroups is already a subgroup, so there is no need to take the
closure. For this reason a `choice` function is added as a field to the `galois_insertion`
structure. It has type `Π S : set G, ↑(closure S) ≤ S → subgroup G`. When `↑(closure S) ≤ S`, then
`S` is already a subgroup, so this function can be defined using `subgroup.mk` and not `closure`.
This means the infimum of subgroups will be defined to be the intersection of sets, paired
with a proof that intersection of subgroups is a subgroup, rather than the closure of the
intersection.
-/
open function set

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x} {a a₁ a₂ : α} {b b₁ b₂ : β}

/-- A Galois connection is a pair of functions `l` and `u` satisfying
  `l a ≤ b ↔ a ≤ u b`. They are special cases of adjoint functors in category theory,
    but do not depend on the category theory library in mathlib. -/
def galois_connection [preorder α] [preorder β] (l : α → β) (u : β → α) := ∀ a b, l a ≤ b ↔ a ≤ u b

/-- Makes a Galois connection from an order-preserving bijection. -/
theorem order_iso.to_galois_connection [preorder α] [preorder β] (oi : α ≃o β) :
  galois_connection oi oi.symm :=
λ b g, oi.rel_symm_apply.symm

namespace galois_connection

section
variables [preorder α] [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u)

lemma monotone_intro (hu : monotone u) (hl : monotone l)
  (hul : ∀ a, a ≤ u (l a)) (hlu : ∀ a, l (u a) ≤ a) : galois_connection l u :=
λ a b, ⟨λ h, (hul _).trans (hu h), λ h, (hl h).trans (hlu _)⟩

include gc

protected lemma dual {l : α → β} {u : β → α} (gc : galois_connection l u) :
  galois_connection (order_dual.to_dual ∘ u ∘ order_dual.of_dual)
    (order_dual.to_dual ∘ l ∘ order_dual.of_dual) :=
λ a b, (gc b a).symm

lemma l_le {a : α} {b : β} : a ≤ u b → l a ≤ b :=
(gc _ _).mpr

lemma le_u {a : α} {b : β} : l a ≤ b → a ≤ u b :=
(gc _ _).mp

lemma le_u_l (a) : a ≤ u (l a) :=
gc.le_u $ le_refl _

lemma l_u_le (a) : l (u a) ≤ a :=
gc.l_le $ le_refl _

lemma monotone_u : monotone u :=
λ a b H, gc.le_u ((gc.l_u_le a).trans H)

lemma monotone_l : monotone l :=
gc.dual.monotone_u.dual

lemma upper_bounds_l_image (s : set α) : upper_bounds (l '' s) = u ⁻¹' upper_bounds s :=
set.ext $ λ b, by simp [upper_bounds, gc _ _]

lemma lower_bounds_u_image (s : set β) : lower_bounds (u '' s) = l ⁻¹' lower_bounds s :=
gc.dual.upper_bounds_l_image s

lemma bdd_above_l_image {s : set α} : bdd_above (l '' s) ↔ bdd_above s :=
⟨λ ⟨x, hx⟩, ⟨u x, by rwa [gc.upper_bounds_l_image] at hx⟩, gc.monotone_l.map_bdd_above⟩

lemma bdd_below_u_image {s : set β} : bdd_below (u '' s) ↔ bdd_below s :=
gc.dual.bdd_above_l_image

lemma is_lub_l_image {s : set α} {a : α} (h : is_lub s a) : is_lub (l '' s) (l a) :=
⟨gc.monotone_l.mem_upper_bounds_image h.left,
  λ b hb, gc.l_le $ h.right $ by rwa [gc.upper_bounds_l_image] at hb⟩

lemma is_glb_u_image {s : set β} {b : β} (h : is_glb s b) : is_glb (u '' s) (u b) :=
gc.dual.is_lub_l_image h

lemma is_least_l {a : α} : is_least {b | a ≤ u b} (l a) :=
⟨gc.le_u_l _, λ b hb, gc.l_le hb⟩

lemma is_greatest_u {b : β} : is_greatest {a | l a ≤ b} (u b) :=
gc.dual.is_least_l

lemma is_glb_l {a : α} : is_glb {b | a ≤ u b} (l a) := gc.is_least_l.is_glb

lemma is_lub_u {b : β} : is_lub { a | l a ≤ b } (u b) := gc.is_greatest_u.is_lub

end

section partial_order
variables [partial_order α] [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u)
include gc

lemma u_l_u_eq_u (b : β) : u (l (u b)) = u b :=
(gc.monotone_u (gc.l_u_le _)).antisymm (gc.le_u_l _)

lemma u_l_u_eq_u' : u ∘ l ∘ u = u := funext gc.u_l_u_eq_u

lemma u_unique {l' : α → β} {u' : β → α} (gc' : galois_connection l' u')
  (hl : ∀ a, l a = l' a) {b : β} : u b = u' b :=
le_antisymm (gc'.le_u $ hl (u b) ▸ gc.l_u_le _)
  (gc.le_u $ (hl (u' b)).symm ▸ gc'.l_u_le _)

/-- If there exists a `b` such that `a = u a`, then `b = l a` is one such element. -/
lemma exists_eq_u (a : α) : (∃ b : β, a = u b) ↔ a = u (l a) :=
⟨λ ⟨S, hS⟩, hS.symm ▸ (gc.u_l_u_eq_u _).symm, λ HI, ⟨_, HI⟩ ⟩

end partial_order

section partial_order
variables [preorder α] [partial_order β] {l : α → β} {u : β → α} (gc : galois_connection l u)
include gc

lemma l_u_l_eq_l (a : α) : l (u (l a)) = l a :=
(gc.l_u_le _).antisymm (gc.monotone_l (gc.le_u_l _))

lemma l_u_l_eq_l' : l ∘ u ∘ l = l := funext gc.l_u_l_eq_l

lemma l_unique {l' : α → β} {u' : β → α} (gc' : galois_connection l' u')
  (hu : ∀ b, u b = u' b) {a : α} : l a = l' a :=
le_antisymm (gc.l_le $ (hu (l' a)).symm ▸ gc'.le_u_l _)
  (gc'.l_le $ hu (l a) ▸ gc.le_u_l _)

/-- If there exists an `a` such that `b = l a`, then `a = u b` is one such element. -/
lemma exists_eq_l (b : β) : (∃ a : α, b = l a) ↔ b = l (u b) :=
⟨λ ⟨S, hS⟩, hS.symm ▸ (gc.l_u_l_eq_l _).symm, λ HI, ⟨_, HI⟩ ⟩

end partial_order

section order_top
variables [partial_order α] [preorder β] [order_top α] [order_top β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma u_top : u ⊤ = ⊤ := top_unique $ gc.le_u le_top

end order_top

section order_bot
variables [preorder α] [partial_order β] [order_bot α] [order_bot β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_bot : l ⊥ = ⊥ := gc.dual.u_top

end order_bot

section semilattice_sup
variables [semilattice_sup α] [semilattice_sup β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_sup : l (a₁ ⊔ a₂) = l a₁ ⊔ l a₂ :=
(gc.is_lub_l_image is_lub_pair).unique $ by simp only [image_pair, is_lub_pair]

end semilattice_sup

section semilattice_inf
variables [semilattice_inf α] [semilattice_inf β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma u_inf : u (b₁ ⊓ b₂) = u b₁ ⊓ u b₂ := gc.dual.l_sup

end semilattice_inf

section complete_lattice
variables [complete_lattice α] [complete_lattice β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_supr {f : ι → α} : l (supr f) = (⨆i, l (f i)) :=
eq.symm $ is_lub.supr_eq $ show is_lub (range (l ∘ f)) (l (supr f)),
  by rw [range_comp, ← Sup_range]; exact gc.is_lub_l_image (is_lub_Sup _)

lemma u_infi {f : ι → β} : u (infi f) = (⨅i, u (f i)) := gc.dual.l_supr

lemma l_Sup {s : set α} : l (Sup s) = (⨆a ∈ s, l a) :=
by simp only [Sup_eq_supr, gc.l_supr]

lemma u_Inf {s : set β} : u (Inf s) = (⨅a ∈ s, u a) := gc.dual.l_Sup

end complete_lattice

/- Constructing Galois connections -/
section constructions

protected lemma id [pα : preorder α] : @galois_connection α α pα pα id id :=
λ a b, iff.intro (λ x, x) (λ x, x)

protected lemma compose [preorder α] [preorder β] [preorder γ]
  {l1 : α → β} {u1 : β → α} {l2 : β → γ} {u2 : γ → β}
  (gc1 : galois_connection l1 u1) (gc2 : galois_connection l2 u2) :
  galois_connection (l2 ∘ l1) (u1 ∘ u2) :=
by intros a b; rw [gc2, gc1]

protected lemma dfun {ι : Type u} {α : ι → Type v} {β : ι → Type w}
  [∀ i, preorder (α i)] [∀ i, preorder (β i)]
  (l : Πi, α i → β i) (u : Πi, β i → α i) (gc : ∀ i, galois_connection (l i) (u i)) :
  galois_connection (λ (a : Π i, α i) i, l i (a i)) (λ b i, u i (b i)) :=
λ a b, forall_congr $ λ i, gc i (a i) (b i)

end constructions

end galois_connection

namespace order_iso

variables [preorder α] [preorder β]

@[simp] lemma bdd_above_image (e : α ≃o β) {s : set α} : bdd_above (e '' s) ↔ bdd_above s :=
e.to_galois_connection.bdd_above_l_image

@[simp] lemma bdd_below_image (e : α ≃o β) {s : set α} : bdd_below (e '' s) ↔ bdd_below s :=
e.dual.bdd_above_image

@[simp] lemma bdd_above_preimage (e : α ≃o β) {s : set β} : bdd_above (e ⁻¹' s) ↔ bdd_above s :=
by rw [← e.bdd_above_image, e.image_preimage]

@[simp] lemma bdd_below_preimage (e : α ≃o β) {s : set β} : bdd_below (e ⁻¹' s) ↔ bdd_below s :=
by rw [← e.bdd_below_image, e.image_preimage]

end order_iso

namespace nat

lemma galois_connection_mul_div {k : ℕ} (h : 0 < k) : galois_connection (λ n, n * k) (λ n, n / k) :=
λ x y, (le_div_iff_mul_le x y h).symm

end nat

/-- A Galois insertion is a Galois connection where `l ∘ u = id`. It also contains a constructive
choice function, to give better definitional equalities when lifting order structures. Dual
to `galois_coinsertion` -/
@[nolint has_inhabited_instance]
structure galois_insertion {α β : Type*} [preorder α] [preorder β] (l : α → β) (u : β → α) :=
(choice : Πx : α, u (l x) ≤ x → β)
(gc : galois_connection l u)
(le_l_u : ∀ x, x ≤ l (u x))
(choice_eq : ∀ a h, choice a h = l a)

/-- A constructor for a Galois insertion with the trivial `choice` function. -/
def galois_insertion.monotone_intro {α β : Type*} [preorder α] [preorder β] {l : α → β} {u : β → α}
  (hu : monotone u) (hl : monotone l) (hul : ∀ a, a ≤ u (l a)) (hlu : ∀ b, l (u b) = b) :
  galois_insertion l u :=
{ choice := λ x _, l x,
  gc := galois_connection.monotone_intro hu hl hul (λ b, le_of_eq (hlu b)),
  le_l_u := λ b, le_of_eq $ (hlu b).symm,
  choice_eq := λ _ _, rfl }

/-- Makes a Galois insertion from an order-preserving bijection. -/
protected def order_iso.to_galois_insertion [preorder α] [preorder β] (oi : α ≃o β) :
@galois_insertion α β _ _ (oi) (oi.symm) :=
{ choice := λ b h, oi b,
  gc := oi.to_galois_connection,
  le_l_u := λ g, le_of_eq (oi.right_inv g).symm,
  choice_eq := λ b h, rfl }

/-- Make a `galois_insertion l u` from a `galois_connection l u` such that `∀ b, b ≤ l (u b)` -/
def galois_connection.to_galois_insertion {α β : Type*} [preorder α] [preorder β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) (h : ∀ b, b ≤ l (u b)) :
  galois_insertion l u :=
{ choice := λ x _, l x,
  gc := gc,
  le_l_u := h,
  choice_eq := λ _ _, rfl }

/-- Lift the bottom along a Galois connection -/
def galois_connection.lift_order_bot {α β : Type*} [preorder α] [order_bot α] [partial_order β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) :
  order_bot β :=
{ bot    := l ⊥,
  bot_le := λ b, gc.l_le $ bot_le }

namespace galois_insertion

variables {l : α → β} {u : β → α}

lemma l_u_eq [preorder α] [partial_order β] (gi : galois_insertion l u) (b : β) :
  l (u b) = b :=
(gi.gc.l_u_le _).antisymm (gi.le_l_u _)

lemma left_inverse_l_u [preorder α] [partial_order β] (gi : galois_insertion l u) :
  left_inverse l u :=
gi.l_u_eq

lemma l_surjective [preorder α] [partial_order β] (gi : galois_insertion l u) :
  surjective l :=
gi.left_inverse_l_u.surjective

lemma u_injective [preorder α] [partial_order β] (gi : galois_insertion l u) :
  injective u :=
gi.left_inverse_l_u.injective

lemma l_sup_u [semilattice_sup α] [semilattice_sup β] (gi : galois_insertion l u) (a b : β) :
  l (u a ⊔ u b) = a ⊔ b :=
calc l (u a ⊔ u b) = l (u a) ⊔ l (u b) : gi.gc.l_sup
               ... = a ⊔ b : by simp only [gi.l_u_eq]

lemma l_supr_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → β) :
  l (⨆ i, u (f i)) = ⨆ i, (f i) :=
calc l (⨆ (i : ι), u (f i)) = ⨆ (i : ι), l (u (f i)) : gi.gc.l_supr
                        ... = ⨆ (i : ι), f i : congr_arg _ $ funext $ λ i, gi.l_u_eq (f i)

lemma l_inf_u [semilattice_inf α] [semilattice_inf β] (gi : galois_insertion l u) (a b : β) :
  l (u a ⊓ u b) = a ⊓ b :=
calc l (u a ⊓ u b) = l (u (a ⊓ b)) : congr_arg l gi.gc.u_inf.symm
               ... = a ⊓ b : by simp only [gi.l_u_eq]

lemma l_infi_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → β) :
  l (⨅ i, u (f i)) = ⨅ i, (f i) :=
calc l (⨅ (i : ι), u (f i)) = l (u (⨅ (i : ι), (f i))) : congr_arg l gi.gc.u_infi.symm
                        ... = ⨅ (i : ι), f i : gi.l_u_eq _

lemma l_infi_of_ul_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → α) (hf : ∀ i, u (l (f i)) = f i) :
  l (⨅ i, (f i)) = ⨅ i, l (f i) :=
calc l (⨅ i, (f i)) =  l ⨅ (i : ι), (u (l (f i))) : by simp [hf]
                ... = ⨅ i, l (f i) : gi.l_infi_u _

lemma u_le_u_iff [preorder α] [preorder β] (gi : galois_insertion l u) {a b} :
  u a ≤ u b ↔ a ≤ b :=
⟨λ h, (gi.le_l_u _).trans (gi.gc.l_le h),
    λ h, gi.gc.monotone_u h⟩

lemma strict_mono_u [preorder α] [preorder β] (gi : galois_insertion l u) : strict_mono u :=
strict_mono_of_le_iff_le $ λ _ _, gi.u_le_u_iff.symm

lemma is_lub_of_u_image [preorder α] [preorder β] (gi : galois_insertion l u) {s : set β} {a : α}
  (hs : is_lub (u '' s) a) : is_lub s (l a) :=
⟨λ x hx, (gi.le_l_u x).trans $ gi.gc.monotone_l $ hs.1 $ mem_image_of_mem _ hx,
  λ x hx, gi.gc.l_le $ hs.2 $ gi.gc.monotone_u.mem_upper_bounds_image hx⟩

lemma is_glb_of_u_image [preorder α] [preorder β] (gi : galois_insertion l u) {s : set β} {a : α}
  (hs : is_glb (u '' s) a) : is_glb s (l a) :=
⟨λ x hx, gi.gc.l_le $ hs.1 $ mem_image_of_mem _ hx,
  λ x hx, (gi.le_l_u x).trans $ gi.gc.monotone_l $ hs.2 $
    gi.gc.monotone_u.mem_lower_bounds_image hx⟩

section lift

variables [partial_order β]

/-- Lift the suprema along a Galois insertion -/
def lift_semilattice_sup [semilattice_sup α] (gi : galois_insertion l u) : semilattice_sup β :=
{ sup := λ a b, l (u a ⊔ u b),
  le_sup_left  := λ a b, (gi.le_l_u a).trans $ gi.gc.monotone_l $ le_sup_left,
  le_sup_right := λ a b, (gi.le_l_u b).trans $ gi.gc.monotone_l $ le_sup_right,
  sup_le       := λ a b c hac hbc,
    gi.gc.l_le $ sup_le (gi.gc.monotone_u hac) (gi.gc.monotone_u hbc),
  .. ‹partial_order β› }

/-- Lift the infima along a Galois insertion -/
def lift_semilattice_inf [semilattice_inf α] (gi : galois_insertion l u) : semilattice_inf β :=
{ inf := λ a b, gi.choice (u a ⊓ u b) $
    (le_inf (gi.gc.monotone_u $ gi.gc.l_le $ inf_le_left)
      (gi.gc.monotone_u $ gi.gc.l_le $ inf_le_right)),
  inf_le_left  := by simp only [gi.choice_eq]; exact λ a b, gi.gc.l_le inf_le_left,
  inf_le_right := by simp only [gi.choice_eq]; exact λ a b, gi.gc.l_le inf_le_right,
  le_inf       := by simp only [gi.choice_eq]; exact λ a b c hac hbc,
    (gi.le_l_u a).trans $ gi.gc.monotone_l $ le_inf (gi.gc.monotone_u hac) (gi.gc.monotone_u hbc),
  .. ‹partial_order β› }

/-- Lift the suprema and infima along a Galois insertion -/
def lift_lattice [lattice α] (gi : galois_insertion l u) : lattice β :=
{ .. gi.lift_semilattice_sup, .. gi.lift_semilattice_inf }

/-- Lift the top along a Galois insertion -/
def lift_order_top [preorder α] [order_top α] (gi : galois_insertion l u) : order_top β :=
{ top    := gi.choice ⊤ $ le_top,
  le_top := by simp only [gi.choice_eq]; exact λ b, (gi.le_l_u b).trans (gi.gc.monotone_l le_top) }

/-- Lift the top, bottom, suprema, and infima along a Galois insertion -/
def lift_bounded_order [preorder α] [bounded_order α]
  (gi : galois_insertion l u) : bounded_order β :=
{ .. gi.lift_order_top, .. gi.gc.lift_order_bot }

/-- Lift all suprema and infima along a Galois insertion -/
def lift_complete_lattice [complete_lattice α] (gi : galois_insertion l u) : complete_lattice β :=
{ Sup := λ s, l (Sup (u '' s)),
  Sup_le := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).2,
  le_Sup := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).1,
  Inf := λ s, gi.choice (Inf (u '' s)) $ gi.gc.monotone_u.le_is_glb_image
    (gi.is_glb_of_u_image $ is_glb_Inf _) (is_glb_Inf _),
  Inf_le := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).1 },
  le_Inf := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).2 },
  .. gi.lift_bounded_order,
  .. gi.lift_lattice }

end lift

end galois_insertion

/-- A Galois coinsertion is a Galois connection where `u ∘ l = id`. It also contains a constructive
choice function, to give better definitional equalities when lifting order structures. Dual to
`galois_insertion` -/
@[nolint has_inhabited_instance]
structure galois_coinsertion {α β : Type*} [preorder α] [preorder β] (l : α → β) (u : β → α) :=
(choice : Πx : β, x ≤ l (u x) → α)
(gc : galois_connection l u)
(u_l_le : ∀ x, u (l x) ≤ x)
(choice_eq : ∀ a h, choice a h = u a)

/-- Make a `galois_insertion u l` in the `order_dual`, from a `galois_coinsertion l u` -/
def galois_coinsertion.dual {α β : Type*} [preorder α] [preorder β] {l : α → β} {u : β → α} :
  galois_coinsertion l u → @galois_insertion (order_dual β) (order_dual α) _ _ u l :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_coinsertion u l` in the `order_dual`, from a `galois_insertion l u` -/
def galois_insertion.dual {α β : Type*} [preorder α] [preorder β] {l : α → β} {u : β → α} :
  galois_insertion l u → @galois_coinsertion (order_dual β) (order_dual α) _ _ u l :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_coinsertion l u` from a `galois_insertion l u` in the `order_dual` -/
def galois_coinsertion.of_dual {α β : Type*} [preorder α] [preorder β] {l : α → β} {u : β → α} :
  @galois_insertion (order_dual β) (order_dual α) _ _ u l → galois_coinsertion l u :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_insertion l u` from a `galois_coinsertion l u` in the `order_dual` -/
def galois_insertion.of_dual {α β : Type*} [preorder α] [preorder β] {l : α → β} {u : β → α} :
  @galois_coinsertion (order_dual β) (order_dual α) _ _ u l → galois_insertion l u :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Makes a Galois coinsertion from an order-preserving bijection. -/
protected def rel_iso.to_galois_coinsertion [preorder α] [preorder β] (oi : α ≃o β) :
@galois_coinsertion α β _ _ (oi) (oi.symm) :=
{ choice := λ b h, oi.symm b,
  gc := oi.to_galois_connection,
  u_l_le := λ g, le_of_eq (oi.left_inv g),
  choice_eq := λ b h, rfl }

/-- A constructor for a Galois coinsertion with the trivial `choice` function. -/
def galois_coinsertion.monotone_intro [preorder α] [preorder β] {l : α → β} {u : β → α}
  (hu : monotone u) (hl : monotone l) (hlu : ∀ b, l (u b) ≤ b)
  (hul : ∀ a, u (l a) = a) :
  galois_coinsertion l u :=
galois_coinsertion.of_dual (galois_insertion.monotone_intro hl.dual hu.dual hlu hul)

/-- Make a `galois_coinsertion l u` from a `galois_connection l u` such that `∀ b, b ≤ l (u b)` -/
def galois_connection.to_galois_coinsertion {α β : Type*} [preorder α] [preorder β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) (h : ∀ a, u (l a) ≤ a) :
  galois_coinsertion l u :=
{ choice := λ x _, u x,
  gc := gc,
  u_l_le := h,
  choice_eq := λ _ _, rfl }

/-- Lift the top along a Galois connection -/
def galois_connection.lift_order_top {α β : Type*} [partial_order α] [preorder β] [order_top β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) :
  order_top α :=
{ top    := u ⊤,
  le_top := λ b, gc.le_u $ le_top }

namespace galois_coinsertion

variables {l : α → β} {u : β → α}

lemma u_l_eq [partial_order α] [preorder β] (gi : galois_coinsertion l u) (a : α) :
  u (l a) = a :=
gi.dual.l_u_eq a

lemma u_l_left_inverse [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  left_inverse u l :=
gi.u_l_eq

lemma u_surjective [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  surjective u :=
gi.dual.l_surjective

lemma l_injective [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  injective l :=
gi.dual.u_injective

lemma u_inf_l [semilattice_inf α] [semilattice_inf β] (gi : galois_coinsertion l u) (a b : α) :
  u (l a ⊓ l b) = a ⊓ b :=
gi.dual.l_sup_u a b

lemma u_infi_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → α) :
  u (⨅ i, l (f i)) = ⨅ i, (f i) :=
gi.dual.l_supr_u _

lemma u_sup_l [semilattice_sup α] [semilattice_sup β] (gi : galois_coinsertion l u) (a b : α) :
  u (l a ⊔ l b) = a ⊔ b :=
gi.dual.l_inf_u _ _

lemma u_supr_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → α) :
  u (⨆ i, l (f i)) = ⨆ i, (f i) :=
gi.dual.l_infi_u _

lemma u_supr_of_lu_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → β) (hf : ∀ i, l (u (f i)) = f i) :
  u (⨆ i, (f i)) = ⨆ i, u (f i) :=
gi.dual.l_infi_of_ul_eq_self _ hf

lemma l_le_l_iff [preorder α] [preorder β] (gi : galois_coinsertion l u) {a b} :
  l a ≤ l b ↔ a ≤ b :=
gi.dual.u_le_u_iff

lemma strict_mono_l [partial_order α] [preorder β] (gi : galois_coinsertion l u) : strict_mono l :=
λ a b h, gi.dual.strict_mono_u h

lemma is_glb_of_l_image [preorder α] [preorder β] (gi : galois_coinsertion l u) {s : set α} {a : β}
  (hs : is_glb (l '' s) a) : is_glb s (u a) :=
gi.dual.is_lub_of_u_image hs

lemma is_lub_of_l_image [preorder α] [preorder β] (gi : galois_coinsertion l u) {s : set α} {a : β}
  (hs : is_lub (l '' s) a) : is_lub s (u a) :=
gi.dual.is_glb_of_u_image hs

section lift

variables [partial_order α]

/-- Lift the infima along a Galois coinsertion -/
def lift_semilattice_inf [semilattice_inf β] (gi : galois_coinsertion l u) : semilattice_inf α :=
{ inf := λ a b, u (l a ⊓ l b),
  .. ‹partial_order α›, .. @order_dual.semilattice_inf _ gi.dual.lift_semilattice_sup }

/-- Lift the suprema along a Galois coinsertion -/
def lift_semilattice_sup [semilattice_sup β] (gi : galois_coinsertion l u) : semilattice_sup α :=
{ sup := λ a b, gi.choice (l a ⊔ l b) $
    (sup_le (gi.gc.monotone_l $ gi.gc.le_u $ le_sup_left)
      (gi.gc.monotone_l $ gi.gc.le_u $ le_sup_right)),
  .. ‹partial_order α›, .. @order_dual.semilattice_sup _ gi.dual.lift_semilattice_inf }

/-- Lift the suprema and infima along a Galois coinsertion -/
def lift_lattice [lattice β] (gi : galois_coinsertion l u) : lattice α :=
{ .. gi.lift_semilattice_sup, .. gi.lift_semilattice_inf }

/-- Lift the bot along a Galois coinsertion -/
def lift_order_bot [preorder β] [order_bot β] (gi : galois_coinsertion l u) : order_bot α :=
{ bot    := gi.choice ⊥ $ bot_le,
  .. @order_dual.order_bot _ _ gi.dual.lift_order_top }

/-- Lift the top, bottom, suprema, and infima along a Galois coinsertion -/
def lift_bounded_order [preorder β] [bounded_order β]
  (gi : galois_coinsertion l u) : bounded_order α :=
{ .. gi.lift_order_bot, .. gi.gc.lift_order_top }

/-- Lift all suprema and infima along a Galois coinsertion -/
def lift_complete_lattice [complete_lattice β] (gi : galois_coinsertion l u) : complete_lattice α :=
{ Inf := λ s, u (Inf (l '' s)),
  Sup := λ s, gi.choice (Sup (l '' s)) _,
  .. @order_dual.complete_lattice _ gi.dual.lift_complete_lattice }

end lift

end galois_coinsertion

/-- If `α` is a partial order with bottom element (e.g., `ℕ`, `ℝ≥0`), then
`λ o : with_bot α, o.get_or_else ⊥` and coercion form a Galois insertion. -/
def with_bot.gi_get_or_else_bot [preorder α] [order_bot α] :
  galois_insertion (λ o : with_bot α, o.get_or_else ⊥) coe :=
{ gc := λ a b, with_bot.get_or_else_bot_le_iff,
  le_l_u := λ a, le_rfl,
  choice := λ o ho, _,
  choice_eq := λ _ _, rfl }


/-
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.normed
import data.is_R_or_C.basic
import topology.instances.real_vector_space

/-!
# 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_add_comm_group E] [normed_space ℝ E]
          {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]

open metric set asymptotics continuous_linear_map filter
open_locale classical topology 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 (f z - f x) / (z - x) ≤ f' x`
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r → ∃ᶠ z in 𝓝[>] x, slope f x z < 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 𝓝[>] 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 𝓝[>] x, r < slope B x z,
      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, slope f x z < r ∧ r < slope B x z ∧ z ∈ Ioc x y,
      from (hf'.and_eventually (HB.and (Ioc_mem_nhds_within_Ioi ⟨le_rfl, hy⟩))).exists,
    refine ⟨z, _, hz⟩,
    have := (hfz.trans hzB).le,
    rwa [slope_def_field, slope_def_field, div_le_div_right (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 (f z - f x) / (z - x) ≤ f' x`
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r → ∃ᶠ z in 𝓝[>] x, slope f x z < 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 (f z - f x) / (z - x) ≤ B' x`
  (bound : ∀ x ∈ Ico a b, ∀ r, B' x < r → ∃ᶠ z in 𝓝[>] x, slope f x z < 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_add_comm_group E] {f : ℝ → E} {f' : ℝ → ℝ} (hf : continuous_on f (Icc a b))
  -- `hf'` actually says `liminf (‖f z‖ - ‖f x‖) / (z - x) ≤ f' x`
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r →
    ∃ᶠ z in 𝓝[>] x, slope (norm ∘ f) x z < 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]` to have a notion of a `convex` set. -/

section

variables {𝕜 G : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E] [normed_add_comm_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,
  /- 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 :=
(exists_gt _).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

/-- The mean value theorem set in dimension 1: if the derivative of a function is bounded by `C`,
then the function is `C`-Lipschitz.  Version with `deriv` and `lipschitz_with`. -/
theorem _root_.lipschitz_with_of_nnnorm_deriv_le {C : ℝ≥0} (hf : differentiable 𝕜 f)
  (bound : ∀ x, ‖deriv f x‖₊ ≤ C) : lipschitz_with C f :=
lipschitz_on_univ.1 $ convex_univ.lipschitz_on_with_of_nnnorm_deriv_le (λ x hx, hf x)
  (λ x hx, bound x)

/-- If `f : 𝕜 → G`, `𝕜 = R` or `𝕜 = ℂ`, is differentiable everywhere and its derivative equal zero,
then it is a constant function. -/
theorem _root_.is_const_of_deriv_eq_zero (hf : differentiable 𝕜 f) (hf' : ∀ x, deriv f x = 0)
  (x y : 𝕜) :
  f x = f y :=
is_const_of_fderiv_eq_zero hf (λ z, by { ext, simp [← deriv_fderiv, hf'] }) _ _

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 (𝓝[>] a) (𝓝 lfa)) (hga : tendsto g (𝓝[>] a) (𝓝 lga))
  (hfb : tendsto f (𝓝[<] b) (𝓝 lfb)) (hgb : tendsto g (𝓝[<] 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 (𝓝[>] a) (𝓝 $ lgb * lfa - lfb * lga),
  { have : tendsto h (𝓝[>] 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 (𝓝[<] b) (𝓝 $ lgb * lfa - lfb * lga),
  { have : tendsto h (𝓝[<] 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 (𝓝[>] a) (𝓝 lfa)) (hga : tendsto g (𝓝[>] a) (𝓝 lga))
  (hfb : tendsto f (𝓝[<] b) (𝓝 lfb)) (hgb : tendsto g (𝓝[<] 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 hx y 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 trivial y 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 hx y 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 trivial y 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 hx y 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 hx y 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 trivial y 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 hx y 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 hx y 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 trivial y 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 hx y 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 hx y 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 hx y

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

lemma strict_mono_on.exists_slope_lt_deriv_aux {x y : ℝ} {f : ℝ → ℝ}
  (hf : continuous_on f (Icc x y)) (hxy : x < y)
  (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) (h : ∀ w ∈ Ioo x y, deriv f w ≠ 0) :
  ∃ a ∈ Ioo x y, (f y - f x) / (y - x) < deriv f a :=
begin
  have A : differentiable_on ℝ f (Ioo x y),
    from λ w wmem, (differentiable_at_of_deriv_ne_zero (h w wmem)).differentiable_within_at,
  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 A,
  rcases nonempty_Ioo.2 hay with ⟨b, ⟨hab, hby⟩⟩,
  refine ⟨b, ⟨hxa.trans hab, hby⟩, _⟩,
  rw ← ha,
  exact hf'_mono ⟨hxa, hay⟩ ⟨hxa.trans hab, hby⟩ hab
end

lemma strict_mono_on.exists_slope_lt_deriv {x y : ℝ} {f : ℝ → ℝ}
  (hf : continuous_on f (Icc x y)) (hxy : x < y)
  (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) :
  ∃ a ∈ Ioo x y, (f y - f x) / (y - x) < deriv f a :=
begin
  by_cases h : ∀ w ∈ Ioo x y, deriv f w ≠ 0,
  { apply strict_mono_on.exists_slope_lt_deriv_aux hf hxy hf'_mono h },
  { push_neg at h,
    rcases h with ⟨w, ⟨hxw, hwy⟩, hw⟩,
    obtain ⟨a, ⟨hxa, haw⟩, ha⟩ : ∃ (a : ℝ) (H : a ∈ Ioo x w), (f w - f x) / (w - x) < deriv f a,
    { apply strict_mono_on.exists_slope_lt_deriv_aux _ hxw _ _,
      { exact hf.mono (Icc_subset_Icc le_rfl hwy.le) },
      { exact hf'_mono.mono (Ioo_subset_Ioo le_rfl hwy.le) },
      { assume z hz,
        rw ← hw,
        apply ne_of_lt,
        exact hf'_mono ⟨hz.1, hz.2.trans hwy⟩ ⟨hxw, hwy⟩ hz.2 } },
    obtain ⟨b, ⟨hwb, hby⟩, hb⟩ : ∃ (b : ℝ) (H : b ∈ Ioo w y), (f y - f w) / (y - w) < deriv f b,
    { apply strict_mono_on.exists_slope_lt_deriv_aux _ hwy _ _,
      { refine hf.mono (Icc_subset_Icc hxw.le le_rfl), },
      { exact hf'_mono.mono (Ioo_subset_Ioo hxw.le le_rfl) },
      { assume z hz,
        rw ← hw,
        apply ne_of_gt,
        exact hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hz.1, hz.2⟩ hz.1, } },
    refine ⟨b, ⟨hxw.trans hwb, hby⟩, _⟩,
    simp only [div_lt_iff, hxy, hxw, hwy, sub_pos] at ⊢ ha hb,
    have : deriv f a * (w - x) < deriv f b * (w - x),
    { apply mul_lt_mul _ le_rfl (sub_pos.2 hxw) _,
      { exact hf'_mono ⟨hxa, haw.trans hwy⟩ ⟨hxw.trans hwb, hby⟩ (haw.trans hwb) },
      { rw ← hw,
        exact (hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hwb, hby⟩ hwb).le } },
    linarith }
end

lemma strict_mono_on.exists_deriv_lt_slope_aux {x y : ℝ} {f : ℝ → ℝ}
  (hf : continuous_on f (Icc x y)) (hxy : x < y)
  (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) (h : ∀ w ∈ Ioo x y, deriv f w ≠ 0) :
  ∃ a ∈ Ioo x y, deriv f a < (f y - f x) / (y - x) :=
begin
  have A : differentiable_on ℝ f (Ioo x y),
    from λ w wmem, (differentiable_at_of_deriv_ne_zero (h w wmem)).differentiable_within_at,
  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 A,
  rcases nonempty_Ioo.2 hxa with ⟨b, ⟨hxb, hba⟩⟩,
  refine ⟨b, ⟨hxb, hba.trans hay⟩, _⟩,
  rw ← ha,
  exact hf'_mono ⟨hxb, hba.trans hay⟩ ⟨hxa, hay⟩ hba
end

lemma strict_mono_on.exists_deriv_lt_slope {x y : ℝ} {f : ℝ → ℝ}
  (hf : continuous_on f (Icc x y)) (hxy : x < y)
  (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) :
  ∃ a ∈ Ioo x y, deriv f a < (f y - f x) / (y - x) :=
begin
  by_cases h : ∀ w ∈ Ioo x y, deriv f w ≠ 0,
  { apply strict_mono_on.exists_deriv_lt_slope_aux hf hxy hf'_mono h },
  { push_neg at h,
    rcases h with ⟨w, ⟨hxw, hwy⟩, hw⟩,
    obtain ⟨a, ⟨hxa, haw⟩, ha⟩ : ∃ (a : ℝ) (H : a ∈ Ioo x w), deriv f a < (f w - f x) / (w - x),
    { apply strict_mono_on.exists_deriv_lt_slope_aux _ hxw _ _,
      { exact hf.mono (Icc_subset_Icc le_rfl hwy.le) },
      { exact hf'_mono.mono (Ioo_subset_Ioo le_rfl hwy.le) },
      { assume z hz,
        rw ← hw,
        apply ne_of_lt,
        exact hf'_mono ⟨hz.1, hz.2.trans hwy⟩ ⟨hxw, hwy⟩ hz.2 } },
    obtain ⟨b, ⟨hwb, hby⟩, hb⟩ : ∃ (b : ℝ) (H : b ∈ Ioo w y), deriv f b < (f y - f w) / (y - w),
    { apply strict_mono_on.exists_deriv_lt_slope_aux _ hwy _ _,
      { refine hf.mono (Icc_subset_Icc hxw.le le_rfl), },
      { exact hf'_mono.mono (Ioo_subset_Ioo hxw.le le_rfl) },
      { assume z hz,
        rw ← hw,
        apply ne_of_gt,
        exact hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hz.1, hz.2⟩ hz.1, } },
    refine ⟨a, ⟨hxa, haw.trans hwy⟩, _⟩,
    simp only [lt_div_iff, hxy, hxw, hwy, sub_pos] at ⊢ ha hb,
    have : deriv f a * (y - w) < deriv f b * (y - w),
    { apply mul_lt_mul _ le_rfl (sub_pos.2 hwy) _,
      { exact hf'_mono ⟨hxa, haw.trans hwy⟩ ⟨hxw.trans hwb, hby⟩ (haw.trans hwb) },
      { rw ← hw,
        exact (hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hwb, hby⟩ hwb).le } },
    linarith }
end

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, and `f'` is strictly monotone on the
interior, then `f` is strictly convex on `D`.
Note that we don't require differentiability, since it is guaranteed at all but at most
one point by the strict monotonicity of `f'`. -/
lemma strict_mono_on.strict_convex_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f D) (hf' : 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 get points `a` and `b` in each interval `[x, y]` and `[y, z]` where the derivatives
  -- can be compared to the slopes between `x, y` and `y, z` respectively.
  obtain ⟨a, ⟨hxa, hay⟩, ha⟩ : ∃ a ∈ Ioo x y, (f y - f x) / (y - x) < deriv f a,
    from strict_mono_on.exists_slope_lt_deriv (hf.mono hxyD) hxy (hf'.mono hxyD'),
  obtain ⟨b, ⟨hyb, hbz⟩, hb⟩ : ∃ b ∈ Ioo y z, deriv f b < (f z - f y) / (z - y),
    from strict_mono_on.exists_deriv_lt_slope (hf.mono hyzD) hyz (hf'.mono hyzD'),
  apply ha.trans (lt_trans _ hb),
  exact hf' (hxyD' ⟨hxa, hay⟩) (hyzD' ⟨hyb, hbz⟩) (hay.trans hyb),
end

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ` and `f'` is strictly antitone on the
interior, then `f` is strictly concave on `D`.
Note that we don't require differentiability, since it is guaranteed at all but at most
one point by the strict antitonicity of `f'`. -/
lemma strict_anti_on.strict_concave_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f 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),
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 continuous and `f'` is strictly monotone on `ℝ` then `f` is strictly
convex. Note that we don't require differentiability, since it is guaranteed at all but at most
one point by the strict monotonicity of `f'`. -/
lemma strict_mono.strict_convex_on_univ_of_deriv {f : ℝ → ℝ} (hf : continuous 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_on

/-- If a function `f` is continuous and `f'` is strictly antitone on `ℝ` then `f` is strictly
concave. Note that we don't require differentiability, since it is guaranteed at all but at most
one point by the strict antitonicity of `f'`. -/
lemma strict_anti.strict_concave_on_univ_of_deriv {f : ℝ → ℝ} (hf : continuous 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_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 ⊆ ℝ` 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 is already implied by the second
derivative being strictly positive, except at at most one point. -/
lemma strict_convex_on_of_deriv2_pos {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f 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

/-- If a function `f` is continuous on a convex set `D ⊆ ℝ` 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, except at at most one point. -/
lemma strict_concave_on_of_deriv2_neg {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ}
  (hf : continuous_on f 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

/-- 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_of_deriv2_nonneg' {D : set ℝ} (hD : convex ℝ 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 (hf'.mono interior_subset)
  (hf''.mono interior_subset) (λ x hx, hf''_nonneg x (interior_subset hx))

/-- 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_of_deriv2_nonpos' {D : set ℝ} (hD : convex ℝ 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 (hf'.mono interior_subset)
  (hf''.mono interior_subset) (λ x hx, hf''_nonpos x (interior_subset hx))

/-- If a function `f` is continuous on a 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 is already implied by the second
derivative being strictly positive, except at at most one point. -/
lemma strict_convex_on_of_deriv2_pos' {D : set ℝ} (hD : convex ℝ D)
  {f : ℝ → ℝ} (hf : continuous_on f D) (hf'' : ∀ x ∈ D, 0 < (deriv^[2] f) x) :
  strict_convex_on ℝ D f :=
strict_convex_on_of_deriv2_pos hD hf $ λ x hx, hf'' x (interior_subset hx)

/-- If a function `f` is continuous on a 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 is already implied by the second
derivative being strictly negative, except at at most one point. -/
lemma strict_concave_on_of_deriv2_neg' {D : set ℝ} (hD : convex ℝ D)
  {f : ℝ → ℝ} (hf : continuous_on f D) (hf'' : ∀ x ∈ D, deriv^[2] f x < 0) :
  strict_concave_on ℝ D f :=
strict_concave_on_of_deriv2_neg hD hf $ λ x hx, hf'' x (interior_subset hx)

/-- 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_of_deriv2_nonneg' convex_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_of_deriv2_nonpos' convex_univ hf'.differentiable_on
  hf''.differentiable_on (λ x _, hf''_nonpos x)

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

/-- If a function `f` is continuous on `ℝ`, and `f''` is strictly negative on `ℝ`,
then `f` is strictly concave on `ℝ`.
Note that we don't require twice differentiability explicitly as it is already implied by the second
derivative being strictly negative, except at at most one point.  -/
lemma strict_concave_on_univ_of_deriv2_neg {f : ℝ → ℝ} (hf : continuous f)
  (hf'' : ∀ x, deriv^[2] f x < 0) :
  strict_concave_on ℝ univ f :=
strict_concave_on_of_deriv2_neg' convex_univ hf.continuous_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_add_comm_group G] [normed_space 𝕜 G]
  {H : Type*} [normed_add_comm_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,
  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 𝕜 𝕜 G 1).continuous.continuous_at.comp hcont

end is_R_or_C


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

import data.polynomial.taylor
import field_theory.ratfunc

/-!
# Laurent expansions of rational functions

## Main declarations

* `ratfunc.laurent`: the Laurent expansion of the rational function `f` at `r`, as an `alg_hom`.
* `ratfunc.laurent_injective`: the Laurent expansion at `r` is unique

## Implementation details

Implemented as the quotient of two Taylor expansions, over domains.
An auxiliary definition is provided first to make the construction of the `alg_hom` easier,
  which works on `comm_ring` which are not necessarily domains.
-/

universe u
namespace ratfunc
noncomputable theory
open polynomial
open_locale classical non_zero_divisors polynomial

variables {R : Type u} [comm_ring R] [hdomain : is_domain R]
  (r s : R) (p q : R[X]) (f : ratfunc R)

lemma taylor_mem_non_zero_divisors (hp : p ∈ R[X]⁰) : taylor r p ∈ R[X]⁰ :=
begin
  rw mem_non_zero_divisors_iff,
  intros x hx,
  have : x = taylor (r - r) x,
  { simp },
  rwa [this, sub_eq_add_neg, ←taylor_taylor, ←taylor_mul,
       linear_map.map_eq_zero_iff _ (taylor_injective _),
       mul_right_mem_non_zero_divisors_eq_zero_iff hp,
       linear_map.map_eq_zero_iff _ (taylor_injective _)] at hx,
end

/-- The Laurent expansion of rational functions about a value.
Auxiliary definition, usage when over integral domains should prefer `ratfunc.laurent`. -/
def laurent_aux : ratfunc R →+* ratfunc R :=
ratfunc.map_ring_hom (ring_hom.mk (taylor r) (taylor_one _) (taylor_mul _)
  (linear_map.map_zero _) (linear_map.map_add _)) (taylor_mem_non_zero_divisors _)

lemma laurent_aux_of_fraction_ring_mk (q : R[X]⁰) :
  laurent_aux r (of_fraction_ring (localization.mk p q)) =
    of_fraction_ring (localization.mk (taylor r p)
      ⟨taylor r q, taylor_mem_non_zero_divisors r q q.prop⟩) :=
map_apply_of_fraction_ring_mk _ _ _ _

include hdomain

lemma laurent_aux_div :
  laurent_aux r (algebra_map _ _ p / (algebra_map _ _ q)) =
    algebra_map _ _ (taylor r p) / (algebra_map _ _ (taylor r q)) :=
map_apply_div _ _ _ _

@[simp] lemma laurent_aux_algebra_map :
  laurent_aux r (algebra_map _ _ p) = algebra_map _ _ (taylor r p) :=
by rw [←mk_one, ←mk_one, mk_eq_div, laurent_aux_div, mk_eq_div, taylor_one, _root_.map_one]

/-- The Laurent expansion of rational functions about a value. -/
def laurent : ratfunc R →ₐ[R] ratfunc R :=
ratfunc.map_alg_hom (alg_hom.mk (taylor r) (taylor_one _) (taylor_mul _)
  (linear_map.map_zero _) (linear_map.map_add _) (by simp [polynomial.algebra_map_apply]))
  (taylor_mem_non_zero_divisors _)

lemma laurent_div :
  laurent r (algebra_map _ _ p / (algebra_map _ _ q)) =
    algebra_map _ _ (taylor r p) / (algebra_map _ _ (taylor r q)) :=
laurent_aux_div r p q

@[simp] lemma laurent_algebra_map :
  laurent r (algebra_map _ _ p) = algebra_map _ _ (taylor r p) :=
laurent_aux_algebra_map _ _

@[simp] lemma laurent_X : laurent r X = X + C r :=
by rw [←algebra_map_X, laurent_algebra_map, taylor_X, _root_.map_add, algebra_map_C]

@[simp] lemma laurent_C (x : R) : laurent r (C x) = C x :=
by rw [←algebra_map_C, laurent_algebra_map, taylor_C]

@[simp] lemma laurent_at_zero : laurent 0 f = f :=
by { induction f using ratfunc.induction_on, simp }

lemma laurent_laurent :
  laurent r (laurent s f) = laurent (r + s) f :=
begin
  induction f using ratfunc.induction_on,
  simp_rw [laurent_div, taylor_taylor]
end

lemma laurent_injective : function.injective (laurent r) :=
λ _ _ h, by simpa [laurent_laurent] using congr_arg (laurent (-r)) h

end ratfunc


import world6.level8

lemma contra (P Q : Prop) : P ∧ ¬ P → Q :=
begin
    intro h,
    exfalso,
    cases h with p np,
    rw not_iff_imp_false at np,
    apply np,
    exact p,
end