/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.local_extr
import analysis.calculus.deriv

/-!
# Local extrema of smooth functions

## Main definitions

In a real normed space `E` we define `pos_tangent_cone_at (s : set E) (x : E)`.
This would be the same as `tangent_cone_at ℝ≥0 s x` if we had a theory of normed semifields.
This set is used in the proof of Fermat's Theorem (see below), and can be used to formalize
[Lagrange multipliers](https://en.wikipedia.org/wiki/Lagrange_multiplier) and/or
[Karush–Kuhn–Tucker conditions](https://en.wikipedia.org/wiki/Karush–Kuhn–Tucker_conditions).

## Main statements

For each theorem name listed below,
we also prove similar theorems for `min`, `extr` (if applicable)`,
and `(f)deriv` instead of `has_fderiv`.

* `is_local_max_on.has_fderiv_within_at_nonpos` : `f' y ≤ 0` whenever `a` is a local maximum
  of `f` on `s`, `f` has derivative `f'` at `a` within `s`, and `y` belongs to the positive tangent
  cone of `s` at `a`.

* `is_local_max_on.has_fderiv_within_at_eq_zero` : In the settings of the previous theorem, if both
  `y` and `-y` belong to the positive tangent cone, then `f' y = 0`.

* `is_local_max.has_fderiv_at_eq_zero` :
  [Fermat's Theorem](https://en.wikipedia.org/wiki/Fermat's_theorem_(stationary_points)),
  the derivative of a differentiable function at a local extremum point equals zero.

* `exists_has_deriv_at_eq_zero` :
  [Rolle's Theorem](https://en.wikipedia.org/wiki/Rolle's_theorem): given a function `f` continuous
  on `[a, b]` and differentiable on `(a, b)`, there exists `c ∈ (a, b)` such that `f' c = 0`.

## Implementation notes

For each mathematical fact we prove several versions of its formalization:

* for maxima and minima;
* using `has_fderiv*`/`has_deriv*` or `fderiv*`/`deriv*`.

For the `fderiv*`/`deriv*` versions we omit the differentiability condition whenever it is possible
due to the fact that `fderiv` and `deriv` are defined to be zero for non-differentiable functions.

## References

* [Fermat's Theorem](https://en.wikipedia.org/wiki/Fermat's_theorem_(stationary_points));
* [Rolle's Theorem](https://en.wikipedia.org/wiki/Rolle's_theorem);
* [Tangent cone](https://en.wikipedia.org/wiki/Tangent_cone);

## Tags

local extremum, Fermat's Theorem, Rolle's Theorem
-/

universes u v

open filter set
open_locale topological_space classical

section module

variables {E : Type u} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {a : E}
  {f' : E →L[ℝ] ℝ}

/-- "Positive" tangent cone to `s` at `x`; the only difference from `tangent_cone_at`
is that we require `c n → ∞` instead of `∥c n∥ → ∞`. One can think about `pos_tangent_cone_at`
as `tangent_cone_at nnreal` but we have no theory of normed semifields yet. -/
def pos_tangent_cone_at (s : set E) (x : E) : set E :=
{y : E | ∃(c : ℕ → ℝ) (d : ℕ → E), (∀ᶠ n in at_top, x + d n ∈ s) ∧
  (tendsto c at_top at_top) ∧ (tendsto (λn, c n • d n) at_top (𝓝 y))}

lemma pos_tangent_cone_at_mono : monotone (λ s, pos_tangent_cone_at s a) :=
begin
  rintros s t hst y ⟨c, d, hd, hc, hcd⟩,
  exact ⟨c, d, mem_sets_of_superset hd $ λ h hn, hst hn, hc, hcd⟩
end

lemma mem_pos_tangent_cone_at_of_segment_subset {s : set E} {x y : E} (h : segment x y ⊆ s) :
  y - x ∈ pos_tangent_cone_at s x :=
begin
  let c := λn:ℕ, (2:ℝ)^n,
  let d := λn:ℕ, (c n)⁻¹ • (y-x),
  refine ⟨c, d, filter.univ_mem_sets' (λn, h _),
    tendsto_pow_at_top_at_top_of_one_lt one_lt_two, _⟩,
  show x + d n ∈ segment x y,
  { rw segment_eq_image',
    refine ⟨(c n)⁻¹, ⟨_, _⟩, rfl⟩,
    exacts [inv_nonneg.2 (pow_nonneg zero_le_two _),
      inv_le_one (one_le_pow_of_one_le one_le_two _)] },
  show tendsto (λ n, c n • d n) at_top (𝓝 (y - x)),
  { convert tendsto_const_nhds, ext n,
    simp only [d, smul_smul],
    rw [mul_inv_cancel, one_smul],
    exact pow_ne_zero _ two_ne_zero }
end

lemma mem_pos_tangent_cone_at_of_segment_subset' {s : set E} {x y : E} (h : segment x (x + y) ⊆ s) :
  y ∈ pos_tangent_cone_at s x :=
by simpa only [add_sub_cancel'] using mem_pos_tangent_cone_at_of_segment_subset h

lemma pos_tangent_cone_at_univ : pos_tangent_cone_at univ a = univ :=
eq_univ_of_forall $ λ x, mem_pos_tangent_cone_at_of_segment_subset' (subset_univ _)

/-- If `f` has a local max on `s` at `a`, `f'` is the derivative of `f` at `a` within `s`, and
`y` belongs to the positive tangent cone of `s` at `a`, then `f' y ≤ 0`. -/
lemma is_local_max_on.has_fderiv_within_at_nonpos {s : set E} (h : is_local_max_on f s a)
  (hf : has_fderiv_within_at f f' s a) {y} (hy : y ∈ pos_tangent_cone_at s a) :
  f' y ≤ 0 :=
begin
  rcases hy with ⟨c, d, hd, hc, hcd⟩,
  have hc' : tendsto (λ n, ∥c n∥) at_top at_top,
    from tendsto_at_top_mono (λ n, le_abs_self _) hc,
  refine le_of_tendsto (hf.lim at_top hd hc' hcd) _,
  replace hd : tendsto (λ n, a + d n) at_top (𝓝[s] (a + 0)),
  from tendsto_inf.2 ⟨tendsto_const_nhds.add (tangent_cone_at.lim_zero _ hc' hcd),
    by rwa tendsto_principal⟩,
  rw [add_zero] at hd,
  replace h : ∀ᶠ n in at_top, f (a + d n) ≤ f a, from mem_map.1 (hd h),
  replace hc : ∀ᶠ n in at_top, 0 ≤ c n, from mem_map.1 (hc (mem_at_top (0:ℝ))),
  filter_upwards [h, hc],
  simp only [smul_eq_mul, mem_preimage, subset_def],
  assume n hnf hn,
  exact mul_nonpos_of_nonneg_of_nonpos hn (sub_nonpos.2 hnf)
end

/-- If `f` has a local max on `s` at `a` and `y` belongs to the positive tangent cone
of `s` at `a`, then `f' y ≤ 0`. -/
lemma is_local_max_on.fderiv_within_nonpos {s : set E} (h : is_local_max_on f s a)
  {y} (hy : y ∈ pos_tangent_cone_at s a) :
  (fderiv_within ℝ f s a : E → ℝ) y ≤ 0 :=
if hf : differentiable_within_at ℝ f s a
then h.has_fderiv_within_at_nonpos hf.has_fderiv_within_at hy
else by { rw fderiv_within_zero_of_not_differentiable_within_at hf, refl }

/-- If `f` has a local max on `s` at `a`, `f'` is a derivative of `f` at `a` within `s`, and
both `y` and `-y` belong to the positive tangent cone of `s` at `a`, then `f' y ≤ 0`. -/
lemma is_local_max_on.has_fderiv_within_at_eq_zero {s : set E} (h : is_local_max_on f s a)
  (hf : has_fderiv_within_at f f' s a) {y} (hy : y ∈ pos_tangent_cone_at s a)
  (hy' : -y ∈ pos_tangent_cone_at s a) :
  f' y = 0 :=
le_antisymm (h.has_fderiv_within_at_nonpos hf hy) $
  by simpa using h.has_fderiv_within_at_nonpos hf hy'

/-- If `f` has a local max on `s` at `a` and both `y` and `-y` belong to the positive tangent cone
of `s` at `a`, then `f' y = 0`. -/
lemma is_local_max_on.fderiv_within_eq_zero {s : set E} (h : is_local_max_on f s a)
  {y} (hy : y ∈ pos_tangent_cone_at s a) (hy' : -y ∈ pos_tangent_cone_at s a) :
  (fderiv_within ℝ f s a : E → ℝ) y = 0 :=
if hf : differentiable_within_at ℝ f s a
then h.has_fderiv_within_at_eq_zero hf.has_fderiv_within_at hy hy'
else by { rw fderiv_within_zero_of_not_differentiable_within_at hf, refl }

/-- If `f` has a local min on `s` at `a`, `f'` is the derivative of `f` at `a` within `s`, and
`y` belongs to the positive tangent cone of `s` at `a`, then `0 ≤ f' y`. -/
lemma is_local_min_on.has_fderiv_within_at_nonneg {s : set E} (h : is_local_min_on f s a)
  (hf : has_fderiv_within_at f f' s a) {y} (hy : y ∈ pos_tangent_cone_at s a) :
  0 ≤ f' y :=
by simpa using h.neg.has_fderiv_within_at_nonpos hf.neg hy

/-- If `f` has a local min on `s` at `a` and `y` belongs to the positive tangent cone
of `s` at `a`, then `0 ≤ f' y`. -/
lemma is_local_min_on.fderiv_within_nonneg {s : set E} (h : is_local_min_on f s a)
  {y} (hy : y ∈ pos_tangent_cone_at s a) :
  (0:ℝ) ≤ (fderiv_within ℝ f s a : E → ℝ) y :=
if hf : differentiable_within_at ℝ f s a
then h.has_fderiv_within_at_nonneg hf.has_fderiv_within_at hy
else by { rw [fderiv_within_zero_of_not_differentiable_within_at hf], refl }

/-- If `f` has a local max on `s` at `a`, `f'` is a derivative of `f` at `a` within `s`, and
both `y` and `-y` belong to the positive tangent cone of `s` at `a`, then `f' y ≤ 0`. -/
lemma is_local_min_on.has_fderiv_within_at_eq_zero {s : set E} (h : is_local_min_on f s a)
  (hf : has_fderiv_within_at f f' s a) {y} (hy : y ∈ pos_tangent_cone_at s a)
  (hy' : -y ∈ pos_tangent_cone_at s a) :
  f' y = 0 :=
by simpa using h.neg.has_fderiv_within_at_eq_zero hf.neg hy hy'

/-- If `f` has a local min on `s` at `a` and both `y` and `-y` belong to the positive tangent cone
of `s` at `a`, then `f' y = 0`. -/
lemma is_local_min_on.fderiv_within_eq_zero {s : set E} (h : is_local_min_on f s a)
  {y} (hy : y ∈ pos_tangent_cone_at s a) (hy' : -y ∈ pos_tangent_cone_at s a) :
  (fderiv_within ℝ f s a : E → ℝ) y = 0 :=
if hf : differentiable_within_at ℝ f s a
then h.has_fderiv_within_at_eq_zero hf.has_fderiv_within_at hy hy'
else by { rw fderiv_within_zero_of_not_differentiable_within_at hf, refl }

/-- Fermat's Theorem: the derivative of a function at a local minimum equals zero. -/
lemma is_local_min.has_fderiv_at_eq_zero (h : is_local_min f a) (hf : has_fderiv_at f f' a) :
  f' = 0 :=
begin
  ext y,
  apply (h.on univ).has_fderiv_within_at_eq_zero hf.has_fderiv_within_at;
    rw pos_tangent_cone_at_univ; apply mem_univ
end

/-- Fermat's Theorem: the derivative of a function at a local minimum equals zero. -/
lemma is_local_min.fderiv_eq_zero (h : is_local_min f a) : fderiv ℝ f a = 0 :=
if hf : differentiable_at ℝ f a then h.has_fderiv_at_eq_zero hf.has_fderiv_at
else fderiv_zero_of_not_differentiable_at hf

/-- Fermat's Theorem: the derivative of a function at a local maximum equals zero. -/
lemma is_local_max.has_fderiv_at_eq_zero (h : is_local_max f a) (hf : has_fderiv_at f f' a) :
  f' = 0 :=
neg_eq_zero.1 $ h.neg.has_fderiv_at_eq_zero hf.neg

/-- Fermat's Theorem: the derivative of a function at a local maximum equals zero. -/
lemma is_local_max.fderiv_eq_zero (h : is_local_max f a) : fderiv ℝ f a = 0 :=
if hf : differentiable_at ℝ f a then h.has_fderiv_at_eq_zero hf.has_fderiv_at
else fderiv_zero_of_not_differentiable_at hf

/-- Fermat's Theorem: the derivative of a function at a local extremum equals zero. -/
lemma is_local_extr.has_fderiv_at_eq_zero (h : is_local_extr f a) :
  has_fderiv_at f f' a → f' = 0 :=
h.elim is_local_min.has_fderiv_at_eq_zero is_local_max.has_fderiv_at_eq_zero

/-- Fermat's Theorem: the derivative of a function at a local extremum equals zero. -/
lemma is_local_extr.fderiv_eq_zero (h : is_local_extr f a) : fderiv ℝ f a = 0 :=
h.elim is_local_min.fderiv_eq_zero is_local_max.fderiv_eq_zero

end module

section real

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

/-- Fermat's Theorem: the derivative of a function at a local minimum equals zero. -/
lemma is_local_min.has_deriv_at_eq_zero (h : is_local_min f a) (hf : has_deriv_at f f' a) :
  f' = 0 :=
by simpa using continuous_linear_map.ext_iff.1
  (h.has_fderiv_at_eq_zero (has_deriv_at_iff_has_fderiv_at.1 hf)) 1

/-- Fermat's Theorem: the derivative of a function at a local minimum equals zero. -/
lemma is_local_min.deriv_eq_zero (h : is_local_min f a) : deriv f a = 0 :=
if hf : differentiable_at ℝ f a then h.has_deriv_at_eq_zero hf.has_deriv_at
else deriv_zero_of_not_differentiable_at hf

/-- Fermat's Theorem: the derivative of a function at a local maximum equals zero. -/
lemma is_local_max.has_deriv_at_eq_zero (h : is_local_max f a) (hf : has_deriv_at f f' a) :
  f' = 0 :=
neg_eq_zero.1 $ h.neg.has_deriv_at_eq_zero hf.neg

/-- Fermat's Theorem: the derivative of a function at a local maximum equals zero. -/
lemma is_local_max.deriv_eq_zero (h : is_local_max f a) : deriv f a = 0 :=
if hf : differentiable_at ℝ f a then h.has_deriv_at_eq_zero hf.has_deriv_at
else deriv_zero_of_not_differentiable_at hf

/-- Fermat's Theorem: the derivative of a function at a local extremum equals zero. -/
lemma is_local_extr.has_deriv_at_eq_zero (h : is_local_extr f a) :
  has_deriv_at f f' a → f' = 0 :=
h.elim is_local_min.has_deriv_at_eq_zero is_local_max.has_deriv_at_eq_zero

/-- Fermat's Theorem: the derivative of a function at a local extremum equals zero. -/
lemma is_local_extr.deriv_eq_zero (h : is_local_extr f a) : deriv f a = 0 :=
h.elim is_local_min.deriv_eq_zero is_local_max.deriv_eq_zero

end real

section Rolle

variables (f f' : ℝ → ℝ) {a b : ℝ}

/-- A continuous function on a closed interval with `f a = f b` takes either its maximum
or its minimum value at a point in the interior of the interval. -/
lemma exists_Ioo_extr_on_Icc (hab : a < b) (hfc : continuous_on f (Icc a b)) (hfI : f a = f b) :
  ∃ c ∈ Ioo a b, is_extr_on f (Icc a b) c :=
begin
  have ne : (Icc a b).nonempty, from nonempty_Icc.2 (le_of_lt hab),
  -- Consider absolute min and max points
  obtain ⟨c, cmem, cle⟩ : ∃ c ∈ Icc a b, ∀ x ∈ Icc a b, f c ≤ f x,
    from compact_Icc.exists_forall_le ne hfc,
  obtain ⟨C, Cmem, Cge⟩ : ∃ C ∈ Icc a b, ∀ x ∈ Icc a b, f x ≤ f C,
    from compact_Icc.exists_forall_ge ne hfc,
  by_cases hc : f c = f a,
  { by_cases hC : f C = f a,
    { have : ∀ x ∈ Icc a b, f x = f a,
        from λ x hx, le_antisymm (hC ▸ Cge x hx) (hc ▸ cle x hx),
      -- `f` is a constant, so we can take any point in `Ioo a b`
      rcases exists_between hab with ⟨c', hc'⟩,
      refine ⟨c', hc', or.inl _⟩,
      assume x hx,
      rw [mem_set_of_eq, this x hx, ← hC],
      exact Cge c' ⟨le_of_lt hc'.1, le_of_lt hc'.2⟩ },
    { refine ⟨C, ⟨lt_of_le_of_ne Cmem.1 $ mt _ hC, lt_of_le_of_ne Cmem.2 $ mt _ hC⟩, or.inr Cge⟩,
      exacts [λ h, by rw h, λ h, by rw [h, hfI]] } },
  { refine ⟨c, ⟨lt_of_le_of_ne cmem.1 $ mt _ hc, lt_of_le_of_ne cmem.2 $ mt _ hc⟩, or.inl cle⟩,
      exacts [λ h, by rw h, λ h, by rw [h, hfI]] }
end

/-- A continuous function on a closed interval with `f a = f b` has a local extremum at some
point of the corresponding open interval. -/
lemma exists_local_extr_Ioo (hab : a < b) (hfc : continuous_on f (Icc a b)) (hfI : f a = f b) :
  ∃ c ∈ Ioo a b, is_local_extr f c :=
let ⟨c, cmem, hc⟩ := exists_Ioo_extr_on_Icc f hab hfc hfI
in ⟨c, cmem, hc.is_local_extr $ Icc_mem_nhds cmem.1 cmem.2⟩

/-- Rolle's Theorem `has_deriv_at` version -/
lemma exists_has_deriv_at_eq_zero (hab : a < b) (hfc : continuous_on f (Icc a b)) (hfI : f a = f b)
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) :
  ∃ c ∈ Ioo a b, f' c = 0 :=
let ⟨c, cmem, hc⟩ := exists_local_extr_Ioo f hab hfc hfI in
  ⟨c, cmem, hc.has_deriv_at_eq_zero $ hff' c cmem⟩

/-- Rolle's Theorem `deriv` version -/
lemma exists_deriv_eq_zero (hab : a < b) (hfc : continuous_on f (Icc a b)) (hfI : f a = f b) :
  ∃ c ∈ Ioo a b, deriv f c = 0 :=
let ⟨c, cmem, hc⟩ := exists_local_extr_Ioo f hab hfc hfI in
  ⟨c, cmem, hc.deriv_eq_zero⟩

variables {f f'} {l : ℝ}

/-- Rolle's Theorem, a version for a function on an open interval: if `f` has derivative `f'`
on `(a, b)` and has the same limit `l` at `𝓝[Ioi a] a` and `𝓝[Iio b] b`, then `f' c = 0`
for some `c ∈ (a, b)`.  -/
lemma exists_has_deriv_at_eq_zero' (hab : a < b)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 l)) (hfb : tendsto f (𝓝[Iio b] b) (𝓝 l))
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) :
  ∃ c ∈ Ioo a b, f' c = 0 :=
begin
  have : continuous_on f (Ioo a b) := λ x hx, (hff' x hx).continuous_at.continuous_within_at,
  have hcont := continuous_on_Icc_extend_from_Ioo hab this hfa hfb,
  obtain ⟨c, hc, hcextr⟩ : ∃ c ∈ Ioo a b, is_local_extr (extend_from (Ioo a b) f) c,
  { apply exists_local_extr_Ioo _ hab hcont,
    rw eq_lim_at_right_extend_from_Ioo hab hfb,
    exact eq_lim_at_left_extend_from_Ioo hab hfa },
  use [c, hc],
  apply (hcextr.congr _).has_deriv_at_eq_zero (hff' c hc),
  rw eventually_eq_iff_exists_mem,
  exact ⟨Ioo a b, Ioo_mem_nhds hc.1 hc.2, extend_from_extends this⟩
end

/-- Rolle's Theorem, a version for a function on an open interval: if `f` has the same limit `l` at
`𝓝[Ioi a] a` and `𝓝[Iio b] b`, then `deriv f c = 0` for some `c ∈ (a, b)`. This version does not
require differentiability of `f` because we define `deriv f c = 0` whenever `f` is not
differentiable at `c`. -/
lemma exists_deriv_eq_zero' (hab : a < b)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 l)) (hfb : tendsto f (𝓝[Iio b] b) (𝓝 l)) :
  ∃ c ∈ Ioo a b, deriv f c = 0 :=
classical.by_cases
  (assume h : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    show ∃ c ∈ Ioo a b, deriv f c = 0,
      from exists_has_deriv_at_eq_zero' hab hfa hfb (λ x hx, (h x hx).has_deriv_at))
  (assume h : ¬∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    have h : ∃ x, x ∈ Ioo a b ∧ ¬differentiable_at ℝ f x, by { push_neg at h, exact h },
      let ⟨c, hc, hcdiff⟩ := h in ⟨c, hc, deriv_zero_of_not_differentiable_at hcdiff⟩)

end Rolle


import Mathlib.Data.List.Sort
import Mathlib.Tactic.Linarith

section timedSort

universe u

variable {α : Type u} (r : α → α → Prop) [DecidableRel r]
local infixl:50 " ≼ " => r

@[simp] def merge : List α → List α → (List α × Nat)
  | [], l₂ => (l₂, 0)
  | l₁, [] => (l₁, 0)
  | (h₁ :: t₁), (h₂ :: t₂) =>
    if h₁ ≼ h₂
    then let (l₃, n) := merge t₁ (h₂ :: t₂)
         (h₁ :: l₃, n + 1)
    else let (l₃, n) := merge (h₁ :: t₁) t₂
         (h₂ :: l₃, n + 1)
  termination_by merge l₁ l₂ => List.length l₁ + List.length l₂

theorem merge_complexity : ∀ l₁ l₂ : List α,
  (merge r l₁ l₂).snd ≤ l₁.length + l₂.length
  | [], l₂ => by simp
  | (h₁ :: t₁), [] => by simp
  | (h₁ :: t₁), (h₂ :: t₂) => by
    unfold merge
    split_ifs with if_hyp
    { have ih := merge_complexity t₁ (h₂ :: t₂)
      cases e: merge r t₁ (h₂ :: t₂) with
      | mk l₁ l₂ =>
        rw [e] at ih
        simp at ih
        show l₂ + 1 ≤ t₁.length + 1 + t₂.length + 1
        simp
        have ih' : l₂ ≤ t₁.length + t₂.length + 1 := ih
        rw [Nat.add_assoc, add_comm t₂.length 1, ← Nat.add_assoc] at ih'
        exact ih'
    }
    { have ih := merge_complexity (h₁ :: t₁) t₂
      cases e: merge r (h₁ :: t₁) t₂ with
      | mk l₁ l₂ =>
        rw [e] at ih
        simp at ih
        show l₂ + 1 ≤ t₁.length + 1 + t₂.length + 1
        simp
        exact ih
    }
  termination_by merge_complexity l₁ l₂ => List.length l₁ + List.length l₂

theorem merge_equivalence : ∀ l₁ l₂ : List α,
  (merge r l₁ l₂).fst = List.merge r l₁ l₂
| [],       []           => by simp; rw [List.merge]
| [],       (h₂ :: t₂)   => by simp; rw [List.merge]
| (h₁ :: t₁), []         => by simp; rw [List.merge]; simp
| (h₁ :: t₁), (h₂ :: t₂) => by
  unfold merge
  split_ifs with if_hyp
  { have ih := merge_equivalence t₁ (h₂ :: t₂)
    cases e : merge r t₁ (h₂ :: t₂) with
    | mk l₁ l₂ =>
      unfold List.merge
      rw [e] at ih
      simp at ih
      split_ifs
      simp
      exact ih
  }
  { have ih := merge_equivalence (h₁ :: t₁) t₂
    cases e : merge r (h₁ :: t₁) t₂ with
    | mk l₁ l₂ =>
      unfold List.merge
      rw [e] at ih
      split_ifs
      simp
      exact ih
  }
  termination_by merge_equivalence l₁ l₂ => List.length l₁ + List.length l₂

end timedSort


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/

import algebra.module.pi
import algebra.ordered_pi
import algebra.module.prod
import algebra.ordered_field

/-!
# Ordered modules

In this file we define

* `ordered_module R M` : an ordered additive commutative monoid `M` is an `ordered_module`
  over an `ordered_semiring` `R` if the scalar product respects the order relation on the
  monoid and on the ring. There is a correspondence between this structure and convex cones,
  which is proven in `analysis/convex/cone.lean`.

## Implementation notes

* We choose to define `ordered_module` as a `Prop`-valued mixin, so that it can be
  used for both modules and algebras
  (the axioms for an "ordered algebra" are exactly that the algebra is ordered as a module).
* To get ordered modules and ordered vector spaces, it suffices to replace the
  `order_add_comm_monoid` and the `ordered_semiring` as desired.

## References

* https://en.wikipedia.org/wiki/Ordered_module

## Tags

ordered module, ordered module, ordered vector space
-/

/--
An ordered module is an ordered additive commutative monoid
with a partial order in which the scalar multiplication is compatible with the order.
-/
@[protect_proj]
class ordered_module (R M : Type*)
  [ordered_semiring R] [ordered_add_comm_monoid M] [module R M] : Prop :=
(smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, a < b → 0 < c → c • a < c • b)
(lt_of_smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, c • a < c • b → 0 < c → a < b)

section ordered_module

variables {R M : Type*}
  [ordered_semiring R] [ordered_add_comm_monoid M] [module R M] [ordered_module R M]
  {a b : M} {c : R}

lemma smul_lt_smul_of_pos : a < b → 0 < c → c • a < c • b := ordered_module.smul_lt_smul_of_pos

lemma smul_le_smul_of_nonneg (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c • a ≤ c • b :=
begin
  by_cases H₁ : c = 0,
  { simp [H₁, zero_smul] },
  { by_cases H₂ : a = b,
    { rw H₂ },
    { exact le_of_lt
        (smul_lt_smul_of_pos (lt_of_le_of_ne h₁ H₂) (lt_of_le_of_ne h₂ (ne.symm H₁))), } }
end

lemma eq_of_smul_eq_smul_of_pos_of_le (h₁ : c • a = c • b) (hc : 0 < c) (hle : a ≤ b) :
  a = b :=
hle.lt_or_eq.resolve_left $ λ hlt, (smul_lt_smul_of_pos hlt hc).ne h₁

lemma lt_of_smul_lt_smul_of_nonneg (h : c • a < c • b) (hc : 0 ≤ c) : a < b :=
hc.eq_or_lt.elim (λ hc, false.elim $ lt_irrefl (0:M) $ by rwa [← hc, zero_smul, zero_smul] at h)
  (ordered_module.lt_of_smul_lt_smul_of_pos h)

lemma smul_lt_smul_iff_of_pos (hc : 0 < c) : c • a < c • b ↔ a < b :=
⟨λ h, lt_of_smul_lt_smul_of_nonneg h hc.le, λ h, smul_lt_smul_of_pos h hc⟩

lemma smul_pos_iff_of_pos (hc : 0 < c) : 0 < c • a ↔ 0 < a :=
calc 0 < c • a ↔ c • 0 < c • a : by rw smul_zero
           ... ↔ 0 < a         : smul_lt_smul_iff_of_pos hc

end ordered_module

/-- If `R` is a linear ordered semifield, then it suffices to verify only the first axiom of
`ordered_module`. Moreover, it suffices to verify that `a < b` and `0 < c` imply
`c • a ≤ c • b`. We have no semifields in `mathlib`, so we use the assumption `∀ c ≠ 0, is_unit c`
instead. -/
lemma ordered_module.mk'' {R M : Type*} [linear_ordered_semiring R] [ordered_add_comm_monoid M]
  [module R M] (hR : ∀ {c : R}, c ≠ 0 → is_unit c)
  (hlt : ∀ ⦃a b : M⦄ ⦃c : R⦄, a < b → 0 < c → c • a ≤ c • b) :
  ordered_module R M :=
begin
  have hlt' : ∀ ⦃a b : M⦄ ⦃c : R⦄, a < b → 0 < c → c • a < c • b,
  { refine λ a b c hab hc, (hlt hab hc).lt_of_ne _,
    rw [ne.def, (hR hc.ne').smul_left_cancel],
    exact hab.ne },
  refine { smul_lt_smul_of_pos := hlt', .. },
  intros a b c h hc,
  rcases (hR hc.ne') with ⟨c, rfl⟩,
  rw [← c.inv_smul_smul a, ← c.inv_smul_smul b],
  refine hlt' h (pos_of_mul_pos_left _ hc.le),
  simp only [c.mul_inv, zero_lt_one]
end

/-- If `R` is a linear ordered field, then it suffices to verify only the first axiom of
`ordered_module`. -/
lemma ordered_module.mk' {k M : Type*} [linear_ordered_field k] [ordered_add_comm_monoid M]
  [module k M] (hlt : ∀ ⦃a b : M⦄ ⦃c : k⦄, a < b → 0 < c → c • a ≤ c • b) :
  ordered_module k M :=
ordered_module.mk'' (λ c hc, is_unit.mk0 _ hc) hlt

instance linear_ordered_semiring.to_ordered_module  {R : Type*} [linear_ordered_semiring R] :
  ordered_module R R :=
{ smul_lt_smul_of_pos        := ordered_semiring.mul_lt_mul_of_pos_left,
  lt_of_smul_lt_smul_of_pos  := λ _ _ _ h hc, lt_of_mul_lt_mul_left h hc.le }

section field

variables {k M N : Type*} [linear_ordered_field k]
  [ordered_add_comm_group M] [module k M] [ordered_module k M]
  [ordered_add_comm_group N] [module k N] [ordered_module k N]
  {a b : M} {c : k}

lemma smul_le_smul_iff_of_pos (hc : 0 < c) : c • a ≤ c • b ↔ a ≤ b :=
⟨λ h, inv_smul_smul' hc.ne' a ▸ inv_smul_smul' hc.ne' b ▸
  smul_le_smul_of_nonneg h (inv_nonneg.2 hc.le),
  λ h, smul_le_smul_of_nonneg h hc.le⟩

lemma smul_le_smul_iff_of_neg (hc : c < 0) : c • a ≤ c • b ↔ b ≤ a :=
begin
  rw [← neg_neg c, neg_smul, neg_smul (-c), neg_le_neg_iff, smul_le_smul_iff_of_pos (neg_pos.2 hc)],
  apply_instance,
end

lemma smul_lt_iff_of_pos (hc : 0 < c) : c • a < b ↔ a < c⁻¹ • b :=
calc c • a < b ↔ c • a < c • c⁻¹ • b : by rw [smul_inv_smul' hc.ne']
... ↔ a < c⁻¹ • b : smul_lt_smul_iff_of_pos hc

lemma smul_le_iff_of_pos (hc : 0 < c) : c • a ≤ b ↔ a ≤ c⁻¹ • b :=
calc c • a ≤ b ↔ c • a ≤ c • c⁻¹ • b : by rw [smul_inv_smul' hc.ne']
... ↔ a ≤ c⁻¹ • b : smul_le_smul_iff_of_pos hc

lemma le_smul_iff_of_pos (hc : 0 < c) : a ≤ c • b ↔ c⁻¹ • a ≤ b :=
calc a ≤ c • b ↔ c • c⁻¹ • a ≤ c • b : by rw [smul_inv_smul' hc.ne']
... ↔ c⁻¹ • a ≤ b : smul_le_smul_iff_of_pos hc

instance prod.ordered_module : ordered_module k (M × N) :=
ordered_module.mk' $ λ v u c h hc,
  ⟨smul_le_smul_of_nonneg h.1.1 hc.le, smul_le_smul_of_nonneg h.1.2 hc.le⟩

instance pi.ordered_module {ι : Type*} {M : ι → Type*} [Π i, ordered_add_comm_group (M i)]
  [Π i, module k (M i)] [∀ i, ordered_module k (M i)] :
  ordered_module k (Π i : ι, M i) :=
begin
  refine (ordered_module.mk' $ λ v u c h hc i, _),
  change c • v i ≤ c • u i,
  exact smul_le_smul_of_nonneg (h.le i) hc.le,
end

-- Sometimes Lean fails to apply the dependent version to non-dependent functions,
-- so we define another instance
instance pi.ordered_module' {ι : Type*} {M : Type*} [ordered_add_comm_group M]
  [module k M] [ordered_module k M] :
  ordered_module k (ι → M) :=
pi.ordered_module

end field

section order_dual

variables {R M : Type*}

instance [semiring R] [ordered_add_comm_monoid M] [module R M] : has_scalar R (order_dual M) :=
{ smul := @has_scalar.smul R M _ }

instance [semiring R] [ordered_add_comm_monoid M] [module R M] : mul_action R (order_dual M) :=
{ one_smul := @mul_action.one_smul R M _ _,
  mul_smul := @mul_action.mul_smul R M _ _ }

instance [semiring R] [ordered_add_comm_monoid M] [module R M] :
  distrib_mul_action R (order_dual M) :=
{ smul_add := @distrib_mul_action.smul_add R M _ _ _,
  smul_zero := @distrib_mul_action.smul_zero R M _ _ _ }

instance [semiring R] [ordered_add_comm_monoid M] [module R M] : module R (order_dual M) :=
{ add_smul := @module.add_smul R M _ _ _,
  zero_smul := @module.zero_smul R M _ _ _ }

instance [ordered_semiring R] [ordered_add_comm_monoid M] [module R M]
  [ordered_module R M] :
  ordered_module R (order_dual M) :=
{ smul_lt_smul_of_pos := λ a b, @ordered_module.smul_lt_smul_of_pos R M _ _ _ _ b a,
  lt_of_smul_lt_smul_of_pos := λ a b,
    @ordered_module.lt_of_smul_lt_smul_of_pos R M _ _ _ _ b a }

end order_dual


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import linear_algebra.affine_space.midpoint
import algebra.module.ordered
import tactic.field_simp

/-!
# Ordered modules as affine spaces

In this file we define the slope of a function `f : k → PE` taking values in an affine space over
`k` and prove some theorems about `slope` and `line_map` in the case when `PE` is an ordered
module over `k`. The `slope` function naturally appears in the Mean Value Theorem, and in the
proof of the fact that a function with nonnegative second derivative on an interval is convex on
this interval. In the third part of this file we prove inequalities that will be used in
`analysis.convex.basic` to link convexity of a function on an interval to monotonicity of the slope,
see section docstring below for details.

## Implementation notes

We do not introduce the notion of ordered affine spaces (yet?). Instead, we prove various theorems
for an ordered module interpreted as an affine space.

## Tags

affine space, ordered module, slope
-/

open affine_map

variables {k E PE : Type*}

/-!
### Definition of `slope` and basic properties

In this section we define `slope f a b` and prove some properties that do not require order on the
codomain.  -/

section no_order

variables [field k] [add_comm_group E] [module k E] [add_torsor E PE]

include E

/-- `slope f a b = (b - a)⁻¹ • (f b -ᵥ f a)` is the slope of a function `f` on the interval
`[a, b]`. Note that `slope f a a = 0`, not the derivative of `f` at `a`. -/
def slope (f : k → PE) (a b : k) : E := (b - a)⁻¹ • (f b -ᵥ f a)

omit E

lemma slope_def_field (f : k → k) (a b : k) : slope f a b = (f b - f a) / (b - a) :=
div_eq_inv_mul.symm

@[simp] lemma slope_same (f : k → PE) (a : k) : (slope f a a : E) = 0 :=
by rw [slope, sub_self, inv_zero, zero_smul]

include E

lemma eq_of_slope_eq_zero {f : k → PE} {a b : k} (h : slope f a b = (0:E)) : f a = f b :=
begin
  rw [slope, smul_eq_zero, inv_eq_zero, sub_eq_zero, vsub_eq_zero_iff_eq] at h,
  exact h.elim (λ h, h ▸ rfl) eq.symm
end

lemma slope_comm (f : k → PE) (a b : k) : slope f a b = slope f b a :=
by rw [slope, slope, ← neg_vsub_eq_vsub_rev, smul_neg, ← neg_smul, neg_inv, neg_sub]

/-- `slope f a c` is a linear combination of `slope f a b` and `slope f b c`. This version
explicitly provides coefficients. If `a ≠ c`, then the sum of the coefficients is `1`, so it is
actually an affine combination, see `line_map_slope_slope_sub_div_sub`. -/
lemma sub_div_sub_smul_slope_add_sub_div_sub_smul_slope (f : k → PE) (a b c : k) :
  ((b - a) / (c - a)) • slope f a b + ((c - b) / (c - a)) • slope f b c = slope f a c :=
begin
  by_cases hab : a = b,
  { subst hab,
    rw [sub_self, zero_div, zero_smul, zero_add],
    by_cases hac : a = c,
    { simp [hac] },
    { rw [div_self (sub_ne_zero.2 $ ne.symm hac), one_smul] } },
  by_cases hbc : b = c, { subst hbc, simp [sub_ne_zero.2 (ne.symm hab)] },
  rw [add_comm],
  simp_rw [slope, div_eq_inv_mul, mul_smul, ← smul_add,
    smul_inv_smul' (sub_ne_zero.2 $ ne.symm hab), smul_inv_smul' (sub_ne_zero.2 $ ne.symm hbc),
    vsub_add_vsub_cancel],
end

/-- `slope f a c` is an affine combination of `slope f a b` and `slope f b c`. This version uses
`line_map` to express this property. -/
lemma line_map_slope_slope_sub_div_sub (f : k → PE) (a b c : k) (h : a ≠ c) :
  line_map (slope f a b) (slope f b c) ((c - b) / (c - a)) = slope f a c :=
by  field_simp [sub_ne_zero.2 h.symm, ← sub_div_sub_smul_slope_add_sub_div_sub_smul_slope f a b c,
  line_map_apply_module]

/-- `slope f a b` is an affine combination of `slope f a (line_map a b r)` and
`slope f (line_map a b r) b`. We use `line_map` to express this property. -/
lemma line_map_slope_line_map_slope_line_map (f : k → PE) (a b r : k) :
  line_map (slope f (line_map a b r) b) (slope f a (line_map a b r)) r = slope f a b :=
begin
  obtain (rfl|hab) : a = b ∨ a ≠ b := classical.em _, { simp },
  rw [slope_comm _ a, slope_comm _ a, slope_comm _ _ b],
  convert line_map_slope_slope_sub_div_sub f b (line_map a b r) a hab.symm using 2,
  rw [line_map_apply_ring, eq_div_iff (sub_ne_zero.2 hab), sub_mul, one_mul, mul_sub, ← sub_sub,
    sub_sub_cancel]
end

end no_order

/-!
### Monotonicity of `line_map`

In this section we prove that `line_map a b r` is monotone (strictly or not) in its arguments if
other arguments belong to specific domains.
-/

section ordered_ring

variables [ordered_ring k] [ordered_add_comm_group E] [module k E] [ordered_module k E]

variables {a a' b b' : E} {r r' : k}

lemma line_map_mono_left (ha : a ≤ a') (hr : r ≤ 1) :
  line_map a b r ≤ line_map a' b r :=
begin
  simp only [line_map_apply_module],
  exact add_le_add_right (smul_le_smul_of_nonneg ha (sub_nonneg.2 hr)) _
end

lemma line_map_strict_mono_left (ha : a < a') (hr : r < 1) :
  line_map a b r < line_map a' b r :=
begin
  simp only [line_map_apply_module],
  exact add_lt_add_right (smul_lt_smul_of_pos ha (sub_pos.2 hr)) _
end

lemma line_map_mono_right (hb : b ≤ b') (hr : 0 ≤ r) :
  line_map a b r ≤ line_map a b' r :=
begin
  simp only [line_map_apply_module],
  exact add_le_add_left (smul_le_smul_of_nonneg hb hr) _
end

lemma line_map_strict_mono_right (hb : b < b') (hr : 0 < r) :
  line_map a b r < line_map a b' r :=
begin
  simp only [line_map_apply_module],
  exact add_lt_add_left (smul_lt_smul_of_pos hb hr) _
end

lemma line_map_mono_endpoints (ha : a ≤ a') (hb : b ≤ b') (h₀ : 0 ≤ r) (h₁ : r ≤ 1) :
  line_map a b r ≤ line_map a' b' r :=
(line_map_mono_left ha h₁).trans (line_map_mono_right hb h₀)

lemma line_map_strict_mono_endpoints (ha : a < a') (hb : b < b') (h₀ : 0 ≤ r) (h₁ : r ≤ 1) :
  line_map a b r < line_map a' b' r :=
begin
  rcases h₀.eq_or_lt with (rfl|h₀), { simpa },
  exact (line_map_mono_left ha.le h₁).trans_lt (line_map_strict_mono_right hb h₀)
end

lemma line_map_lt_line_map_iff_of_lt (h : r < r') :
  line_map a b r < line_map a b r' ↔ a < b :=
begin
  simp only [line_map_apply_module],
  rw [← lt_sub_iff_add_lt, add_sub_assoc, ← sub_lt_iff_lt_add', ← sub_smul, ← sub_smul,
    sub_sub_sub_cancel_left, smul_lt_smul_iff_of_pos (sub_pos.2 h)],
  apply_instance,
end

lemma left_lt_line_map_iff_lt (h : 0 < r) : a < line_map a b r ↔ a < b :=
iff.trans (by rw line_map_apply_zero) (line_map_lt_line_map_iff_of_lt h)

lemma line_map_lt_left_iff_lt (h : 0 < r) : line_map a b r < a ↔ b < a :=
@left_lt_line_map_iff_lt k (order_dual E) _ _ _ _ _ _ _ h

lemma line_map_lt_right_iff_lt (h : r < 1) : line_map a b r < b ↔ a < b :=
iff.trans (by rw line_map_apply_one) (line_map_lt_line_map_iff_of_lt h)

lemma right_lt_line_map_iff_lt (h : r < 1) : b < line_map a b r ↔ b < a :=
@line_map_lt_right_iff_lt k (order_dual E) _ _ _ _ _ _ _ h

end ordered_ring

section linear_ordered_ring

variables [linear_ordered_ring k] [ordered_add_comm_group E] [module k E]
  [ordered_module k E] [invertible (2:k)] {a a' b b' : E} {r r' : k}

lemma midpoint_le_midpoint (ha : a ≤ a') (hb : b ≤ b') :
  midpoint k a b ≤ midpoint k a' b' :=
line_map_mono_endpoints ha hb (inv_of_nonneg.2 zero_le_two) $
  inv_of_le_one one_le_two

end linear_ordered_ring

section linear_ordered_field

variables [linear_ordered_field k] [ordered_add_comm_group E]
variables [module k E] [ordered_module k E]

section

variables {a b : E} {r r' : k}

lemma line_map_le_line_map_iff_of_lt (h : r < r') :
  line_map a b r ≤ line_map a b r' ↔ a ≤ b :=
begin
  simp only [line_map_apply_module],
  rw [← le_sub_iff_add_le, add_sub_assoc, ← sub_le_iff_le_add', ← sub_smul, ← sub_smul,
    sub_sub_sub_cancel_left, smul_le_smul_iff_of_pos (sub_pos.2 h)],
  apply_instance,
end

lemma left_le_line_map_iff_le (h : 0 < r) : a ≤ line_map a b r ↔ a ≤ b :=
iff.trans (by rw line_map_apply_zero) (line_map_le_line_map_iff_of_lt h)

@[simp] lemma left_le_midpoint : a ≤ midpoint k a b ↔ a ≤ b :=
left_le_line_map_iff_le $ inv_pos.2 zero_lt_two

lemma line_map_le_left_iff_le (h : 0 < r) : line_map a b r ≤ a ↔ b ≤ a :=
@left_le_line_map_iff_le k (order_dual E) _ _ _ _ _ _ _ h

@[simp] lemma midpoint_le_left : midpoint k a b ≤ a ↔ b ≤ a :=
line_map_le_left_iff_le $ inv_pos.2 zero_lt_two

lemma line_map_le_right_iff_le (h : r < 1) : line_map a b r ≤ b ↔ a ≤ b :=
iff.trans (by rw line_map_apply_one) (line_map_le_line_map_iff_of_lt h)

@[simp] lemma midpoint_le_right : midpoint k a b ≤ b ↔ a ≤ b :=
line_map_le_right_iff_le $ inv_lt_one one_lt_two

lemma right_le_line_map_iff_le (h : r < 1) : b ≤ line_map a b r ↔ b ≤ a :=
@line_map_le_right_iff_le k (order_dual E) _ _ _ _ _ _ _ h

@[simp] lemma right_le_midpoint : b ≤ midpoint k a b ↔ b ≤ a :=
right_le_line_map_iff_le $ inv_lt_one one_lt_two

end

/-!
### Convexity and slope

Given an interval `[a, b]` and a point `c ∈ (a, b)`, `c = line_map a b r`, there are a few ways to
say that the point `(c, f c)` is above/below the segment `[(a, f a), (b, f b)]`:

* compare `f c` to `line_map (f a) (f b) r`;
* compare `slope f a c` to `slope `f a b`;
* compare `slope f c b` to `slope f a b`;
* compare `slope f a c` to `slope f c b`.

In this section we prove equivalence of these four approaches. In order to make the statements more
readable, we introduce local notation `c = line_map a b r`. Then we prove lemmas like

```
lemma map_le_line_map_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a c ≤ slope f a b :=
```

For each inequality between `f c` and `line_map (f a) (f b) r` we provide 3 lemmas:

* `*_left` relates it to an inequality on `slope f a c` and `slope f a b`;
* `*_right` relates it to an inequality on `slope f a b` and `slope f c b`;
* no-suffix version relates it to an inequality on `slope f a c` and `slope f c b`.

Later these inequalities will be used in to restate `convex_on` in terms of monotonicity of the
slope.
-/

variables {f : k → E} {a b r : k}

local notation `c` := line_map a b r

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c ≤ slope f a b`. -/
lemma map_le_line_map_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a c ≤ slope f a b :=
by simp_rw [line_map_apply, slope, vsub_eq_sub, vadd_eq_add, smul_eq_mul, add_sub_cancel, smul_sub,
  sub_le_iff_le_add, mul_inv_rev', mul_smul, ← smul_sub, ← smul_add, smul_smul, ← mul_inv_rev',
  smul_le_iff_of_pos (inv_pos.2 h), inv_inv', smul_smul,
  mul_inv_cancel_right' (right_ne_zero_of_mul h.ne'), smul_add,
  smul_inv_smul' (left_ne_zero_of_mul h.ne')]

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b ≤ slope f a c`. -/
lemma line_map_le_map_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
  line_map (f a) (f b) r ≤ f c ↔ slope f a b ≤ slope f a c :=
@map_le_line_map_iff_slope_le_slope_left k (order_dual E) _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c < slope f a b`. -/
lemma map_lt_line_map_iff_slope_lt_slope_left (h : 0 < r * (b - a)) :
  f c < line_map (f a) (f b) r ↔ slope f a c < slope f a b :=
lt_iff_lt_of_le_iff_le' (line_map_le_map_iff_slope_le_slope_left h)
  (map_le_line_map_iff_slope_le_slope_left h)

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b < slope f a c`. -/
lemma line_map_lt_map_iff_slope_lt_slope_left (h : 0 < r * (b - a)) :
  line_map (f a) (f b) r < f c ↔ slope f a b < slope f a c :=
@map_lt_line_map_iff_slope_lt_slope_left k (order_dual E) _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b ≤ slope f c b`. -/
lemma map_le_line_map_iff_slope_le_slope_right (h : 0 < (1 - r) * (b - a)) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a b ≤ slope f c b :=
begin
  rw [← line_map_apply_one_sub, ← line_map_apply_one_sub _ _ r],
  revert h, generalize : 1 - r = r', clear r, intro h,
  simp_rw [line_map_apply, slope, vsub_eq_sub, vadd_eq_add, smul_eq_mul],
  rw [sub_add_eq_sub_sub_swap, sub_self, zero_sub, le_smul_iff_of_pos, inv_inv', smul_smul,
    neg_mul_eq_mul_neg, neg_sub, mul_inv_cancel_right', le_sub, ← neg_sub (f b), smul_neg,
    neg_add_eq_sub],
  { exact right_ne_zero_of_mul h.ne' },
  { simpa [mul_sub] using h }
end

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b ≤ slope f a b`. -/
lemma line_map_le_map_iff_slope_le_slope_right (h : 0 < (1 - r) * (b - a)) :
  line_map (f a) (f b) r ≤ f c ↔ slope f c b ≤ slope f a b :=
@map_le_line_map_iff_slope_le_slope_right k (order_dual E) _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b < slope f c b`. -/
lemma map_lt_line_map_iff_slope_lt_slope_right (h : 0 < (1 - r) * (b - a)) :
  f c < line_map (f a) (f b) r ↔ slope f a b < slope f c b :=
lt_iff_lt_of_le_iff_le' (line_map_le_map_iff_slope_le_slope_right h)
  (map_le_line_map_iff_slope_le_slope_right h)

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b < slope f a b`. -/
lemma line_map_lt_map_iff_slope_lt_slope_right (h : 0 < (1 - r) * (b - a)) :
  line_map (f a) (f b) r < f c ↔ slope f c b < slope f a b :=
@map_lt_line_map_iff_slope_lt_slope_right k (order_dual E) _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c ≤ slope f c b`. -/
lemma map_le_line_map_iff_slope_le_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a c ≤ slope f c b :=
begin
  rw [map_le_line_map_iff_slope_le_slope_left (mul_pos h₀ (sub_pos.2 hab)),
    ← line_map_slope_line_map_slope_line_map f a b r, right_le_line_map_iff_le h₁],
  apply_instance,
  apply_instance,
end

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b ≤ slope f a c`. -/
lemma line_map_le_map_iff_slope_le_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  line_map (f a) (f b) r ≤ f c ↔ slope f c b ≤ slope f a c :=
@map_le_line_map_iff_slope_le_slope k (order_dual E) _ _ _ _ _ _ _ _ hab h₀ h₁

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c < slope f c b`. -/
lemma map_lt_line_map_iff_slope_lt_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  f c < line_map (f a) (f b) r ↔ slope f a c < slope f c b :=
lt_iff_lt_of_le_iff_le' (line_map_le_map_iff_slope_le_slope hab h₀ h₁)
  (map_le_line_map_iff_slope_le_slope hab h₀ h₁)

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b < slope f a c`. -/
lemma line_map_lt_map_iff_slope_lt_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  line_map (f a) (f b) r < f c ↔ slope f c b < slope f a c :=
@map_lt_line_map_iff_slope_lt_slope k (order_dual E) _ _ _ _ _ _ _ _ hab h₀ h₁

end linear_ordered_field


import ring_theory.algebra_operations linear_algebra.dimension ring_theory.noetherian

universes u v w
section
variables {α : Type*} {β : Type*} [comm_ring α] [comm_ring β] [algebra α β]
variables {γ : Type w} [add_comm_group γ] [module α γ] [module β γ]
open submodule
#print nat.to_digits
lemma span_subset_span {s : set γ} : (span α s : set γ) ⊆ span β s :=
λ x hx, span_induction hx
  (λ _ h, subset_span h)
  (zero_mem (span β s))
  (λ _ _, add_mem (span β s))
  (λ x y h, begin
    have : algebra_map β x • y = x • y, from _,
    simp at this,
  end)

lemma span_subset_ideal_span {s : set β} : (span α s).carrier ⊆ (ideal.span s).carrier :=
λ x hx, span_induction hx
  (λ _ h, ideal.subset_span h)
  (ideal.zero_mem (ideal.span s))
  (λ _ _, ideal.add_mem (ideal.span s))
  (λ x y h, by rw algebra.smul_def;
    exact ideal.mul_mem_left (ideal.span s) h)

open vector_space submodule
-- set_option trace.class_instances true
-- set_option class.instance_max_depth 40
#print span_smul_span

lemma tower_law (s : set β) (t : set γ) (hs : span α s = ⊤) (ht : span β t = ⊤) :
  span α (⋃ (x ∈ s) (y ∈ t), {x • y} : set γ) = ⊤ :=
have h : ideal.span s = ⊤, from (ideal.eq_top_iff_one _).2
  (span_subset_ideal_span (eq_top_iff'.1 hs _)),
calc span α (⋃ (x ∈ s) (y ∈ t), {x • y} : set γ) =
  span α (span β (⋃ (x ∈ s) (y ∈ t), {x • y} : set γ)) :
le_antisymm (span_mono subset_span)
  (λ y hy, _)
... = span α
    ((ideal.span s • span β t) : submodule β γ) :
  by rw span_smul_span
... = _ : _

end


import mynat.mul

lemma zero_mul (m : mynat) : 0 * m = 0 :=
begin
induction m with h hd,
rw mul_zero,
refl,
rw mul_succ,
rw add_zero,
rw hd,
refl,
end


import subgroup_world.subgroup_one -- hide

variables {G : Type} [group G] {H : set G} -- hide

/-
## The inverse of an element is in the group

In this easy lemma you have to prove that the inverse of an element in a subgroup is in the
subgroup as well.
-/
/- Lemma:
If $H\leq G$, and $x \in H$, then $x^{-1} \in H$.
-/
lemma subgroup.inv_mem' [h : subgroup H] {x : G} (hx : x ∈ H) : x⁻¹ ∈ H :=
begin
  have h2 := h.2 (1 : G) x subgroup.one_mem hx,
  rw show (x⁻¹ = 1 * x⁻¹), by group,
  assumption,

end


/- Tactic : exact

## Summary

If the goal is `⊢ X` then `exact x` will close the goal if
and only if `x` is a term of type `X`.

## Details

Say $P$, $Q$ and $R$ are types (i.e., what a mathematician
might think of as either sets or propositions),
and the local context looks like this:

```
p : P,
h : P → Q,
j : Q → R
⊢ R
```

If you can spot how to make a term of type `R`, then you
can just make it and say you're done using the `exact` tactic
together with the formula you have spotted. For example the
above goal could be solved with

`exact j(h(p)),`

because $j(h(p))$ is easily checked to be a term of type $R$
(i.e., an element of the set $R$, or a proof of the proposition $R$).

-/

/-
In this level we learn the tactic `exact`, which solves a goal that is exactly one of the hypotheses.
-/

/- Hint : Click here for a hint, in case you get stuck.
By doing a `rw` you will get the goal to look exactly like one of the hypotheses...
-/

variables {X : Type} -- hide

/- Lemma : no-side-bar
If A and B are sets and x ∈ A and A = B, then x ∈ B.
-/
lemma example_on_exact (A B : set X) (x : X) (h1 : x ∈ A) (h2 : A = B) : x ∈ B :=
begin
  rw ← h2,
  exact h1,

end


import data.fintype data.set.finite data.equiv.basic xenalib.Ellen_Arlt_matrix_rings algebra.big_operators data.set.finite group_theory.coset algebra.group
import group_theory.perm
open fintype

instance (n:ℕ) :(group (equiv.perm (fin n))) :=

begin
  apply_instance,
end

noncomputable instance bij_fintype {n : ℕ} : fintype {f : fin n→ fin n // function.bijective f}  :=
set_fintype _

noncomputable instance equiv_perm_fin_finite {n:ℕ}: fintype (equiv.perm(fin n)):=
fintype.of_surjective (λ (f : {f : fin n → fin n // function.bijective f}), equiv.of_bijective f.2)
begin
  unfold function.surjective,
  simp,
  intro b,
  let f:{f : fin n → fin n // function.bijective f}:=  ⟨ b.1,b.bijective⟩,
  existsi f.1,
  existsi  f.2,
  apply equiv.ext,
  intro x,
  rw equiv.of_bijective_to_fun,
  refl
end

def e {n:ℕ} {R:Type} [comm_ring R] (σ :  equiv.perm (fin n)) : R:= ((equiv.perm.sign σ : ℤ ): R)

theorem sig_eq_inv {n:ℕ} (π: equiv.perm (fin n))  : equiv.perm.sign(π ) = equiv.perm.sign(π.symm ) :=
begin
  {rw[eq_comm],
  show equiv.perm.sign (π⁻¹) = equiv.perm.sign π,
  rw[ is_group_hom.inv equiv.perm.sign] ,
  swap,
  apply_instance,
  have h1: ∀ i: units ℤ ,  i⁻¹ = i,
  exact dec_trivial,
  rw[h1],}
end

theorem e_eq_inv {n:ℕ} {R:Type} [comm_ring R] (π: equiv.perm (fin n))  :  @e n R _ (π ) =  @e n R _ (π.symm ) :=
begin
  unfold e,
  rw sig_eq_inv
end

theorem e_mul  {n:ℕ} {R:Type} [comm_ring R] (σ π :equiv.perm (fin n)) : @e n R _  (σ * π )= (@e n R _  σ ) *  @e n R _   π  :=
begin
  unfold e,
  rw[← int.cast_mul, ← units.mul_coe, ← is_group_hom.mul equiv.perm.sign],
  apply_instance
end

theorem e_swap  {n:ℕ} {R:Type} [comm_ring R] {i j : fin n} (h : i ≠ j) : e (equiv.swap i j) = (-1 :R) :=
begin
  unfold e,
  rw[equiv.perm.sign_swap],
  simp,
  exact h
end


import .defs
import .sequences

import data.set
import topology.algebra.ordered
open espace_metrique

section extra
variables {X: Type} [espace_metrique X]
/-- bornee => bounded (range x) -/
lemma bornee_est_bounded (x: ℕ → X): bornee x → ∃ M > 0, bounded (λ x y, d x y ≤ M) (set.range x) :=
begin
intro Hb,
have h: set.nonempty (set.range x) := range_nonempty_iff_nonempty.2 nonempty_of_inhabited,
obtain ⟨ y, hy ⟩ := h,
obtain ⟨ M, ⟨ hm, hbdd⟩ ⟩ := Hb y,
use M,
split,
exact hm,
use y,
intros x hx,
simp at hx,
obtain ⟨ n, hn ⟩ := hx,
rw ← hn,
exact hbdd n,
end

/-- bounded (range x) => bornee -/
-- niveau: moyen
lemma bounded_est_bornee (x: ℕ → X): ∃ M > 0, bounded (λ x y, d x y ≤ M) (set.range x) → bornee x := sorry

end extra


#print notation ::
#print notation [

-- = append (rev a) b
definition rev_append {α : Type} : list α → list α → list α
| [] a := a
| (x::L₁) L₂ := rev_append L₁ (x::L₂)

definition tr_rev {α : Type} (l : list α) : list α :=
  rev_append l []

def rev {α : Type} : list α → list α
| [] := []
| (n::L) := append (rev L) [n]

--set_option pp.notation false

theorem ap {α : Type} (a : α) (A : list α) :
a :: A = [a] ++ A := by refl

theorem b {α : Type} (A : list α) : ∀ B C : list α,
rev_append A (C++B) = (rev_append A C) ++ B :=
begin
induction A with mem A₂ H,
{
    intros B C,
    refl
},
{
    unfold rev_append,
    intros B C,
    have Hr := ap mem (C++B),
    --have Hr : mem :: (C ++ B) = [mem] ++ C ++ B,refl,
    rw Hr, clear Hr,
    have Hr₂ := ap mem C,
    rw Hr₂, clear Hr₂,

    rw H,

    rw H C [mem],

    exact (list.append_assoc (rev_append A₂ [mem]) C B).symm
}
end

theorem a {α : Type} ( L : list α ) : tr_rev L = rev L := begin
unfold tr_rev,
induction L with mem L₂ H,refl,
{
    unfold rev,
    rw ←H,
    unfold rev_append,
    clear H,

    exact (list.nil_append [mem]) ▸ b L₂ [mem] list.nil,
    --have H₂ := b L₂ [mem] list.nil,
    --rw list.nil_append [mem] at H₂,
    --exact H₂
}
end

-- rev_append L₂ [mem] = ()
-- list.append (rev_append L₂ list.nil) [mem]
#reduce rev_append [5,2,3] [10]
#reduce list.append (rev_append [5,2,3] list.nil) [10]


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem induction_ineq_nsqlefactn
  (n : ℕ)
  (h₀ : 4 ≤ n) :
  n^2 ≤ n! :=
begin
  simp only [sq],
  casesI n with n,
  exact dec_trivial,
  simp,
  apply nat.succ_le_of_lt,
  apply nat.lt_factorial_self,
  exact nat.succ_le_succ_iff.mp h₀,
end


variables a b c d e : Prop
variable p : Prop → Prop

theorem thm₁ (h : a ↔ b) : (c ∧ a ∧ d → e) ↔ (c ∧ b ∧ d → e) :=
propext h ▸ iff.refl _

theorem thm₂ (h : a ↔ b) (h₁ : p a) : p b :=
propext h ▸ h₁

-- BEGIN
#print axioms thm₁  -- propext
#print axioms thm₂  -- propext
-- END

#check propext
#check thm₂

theorem pe_from_thm₂ {a b: Prop}: (a ↔ b) -> a = b := begin
intro h,
let P: Prop -> Prop := λ x, a = x,
have: implies (a = a)  (a = b), from @thm₂ a b P h,
from this rfl,
end


import analysis.topology.topological_space data.set

structure ring_morphism {α : Type*} {β : Type*} [Ra : comm_ring α] [Rb : comm_ring β] (f : α → β) :=
(f_zero : f 0 = 0)
(f_one : f 1 = 1)
(f_add : ∀ {a₁ a₂ : α}, f (a₁ + a₂) = f a₁ + f a₂)
(f_mul : ∀ {a₁ a₂ : α}, f (a₁ * a₂) = f a₁ * f a₂)

local attribute [class] topological_space.is_open

structure presheaf_of_rings (α : Type*) [T : topological_space α]
  (F : Π U : set α, T.is_open U → Type*) :=
[Fring : ∀ U O, comm_ring (F U O)]
(res : ∀ (U V : set α) [OU : T.is_open U] [OV : T.is_open V] (H : V ⊆ U),
  (F U OU) → (F V OV))
(res_is_ring_morphism : ∀ (U V : set α) [OU : T.is_open U] [OV : T.is_open V] (H : V ⊆ U),
ring_morphism (res U V H))
(Hid : ∀ (U : set α) [OU : T.is_open U], (res U U (set.subset.refl _)) = id)
(Hcomp : ∀ (U V W : set α) [OU : T.is_open U] [OV : T.is_open V] [OW : T.is_open W]
  (HUV : V ⊆ U) (HVW : W ⊆ V),
  (res U W (set.subset.trans HVW HUV)) = (res V W HVW) ∘ (res U V HUV) )

attribute [class] presheaf_of_rings
--attribute [instance] presheaf_of_rings.Fring
--local attribute [instance] topological_space.is_open_inter

def res_to_inter_left {α : Type*} [T : topological_space α]
  (F : Π U : set α, T.is_open U → Type*)
  [FP : presheaf_of_rings α F]
  (U V : set α) [OU : T.is_open U] [OV : T.is_open V] :
    (F U OU) → (F (U ∩ V) (T.is_open_inter U V OU OV)) :=
begin
--let W := U ∩ V,
have OW : T.is_open (U ∩ V) := T.is_open_inter U V OU OV,
exact (FP.res U (U ∩ V) (set.inter_subset_left U V)),
end

def res_to_inter_right {α : Type*} [T : topological_space α]
  (F : Π U : set α, T.is_open U → Type)
  [FP : presheaf_of_rings α F]
  (U V : set α) [OU : T.is_open U] [OV : T.is_open V] :
    (F V OV) → (F (U ∩ V) (T.is_open_inter U V OU OV)) :=
begin
have OW : T.is_open (U ∩ V) := T.is_open_inter U V OU OV,
exact (FP.res V (U ∩ V) (set.inter_subset_right U V))
end

def gluing {α : Type*} [T : topological_space α] (F : Π U : set α, T.is_open U → Type*)
  [FP : presheaf_of_rings α F]
  (U :  set α)
  [UO : T.is_open U]
  {γ : Type*} (Ui : γ → set α)
  [UiO : ∀ i : γ, T.is_open (Ui i)]
  (Hcov : (⋃ (x : γ), (Ui x)) = U) :
  (F U UO) → {a : (Π (x : γ), (F (Ui x) _)) | ∀ (x y : γ),
    (res_to_inter_left F (Ui x) (Ui y)) (a x) =
    (res_to_inter_right F (Ui x) (Ui y)) (a y)} :=
begin
intro r,
existsi (λ x,(FP.res U (Ui x) (Hcov ▸ set.subset_Union Ui x) r)),
intros x₁ y₁,
have : T.is_open ((Ui x₁) ∩ (Ui y₁)) := (T.is_open_inter _ _ (UiO x₁) (UiO y₁)),
show ((presheaf_of_rings.res FP (Ui x₁) ((Ui x₁) ∩ (Ui y₁)) _) ∘
      (presheaf_of_rings.res FP U (Ui x₁) _)) r =
    ((presheaf_of_rings.res FP (Ui y₁) ((Ui x₁) ∩ (Ui y₁)) _) ∘
      (presheaf_of_rings.res FP U (Ui y₁) _)) r,
rw [←FP.Hcomp,←FP.Hcomp]
end

structure sheaf_of_rings (α : Type*) [T : topological_space α]
  (F : Π U : set α, T.is_open U → Type*) :=

(FP : presheaf_of_rings α F)
(Fsheaf : ∀ (U : set α) [OU : T.is_open U]
          {γ : Type*} (Ui : γ → set α)
          [UiO : ∀ x : γ, T.is_open (Ui x)]
          (Hcov : (⋃ (x : γ), (Ui x)) = U),
        function.bijective (gluing F U Ui Hcov)
)

/-
structure ideal (R : Type u) [RR : comm_ring R] :=
(I_set : set R)
(I_zero : RR.zero ∈ I_set)
(I_ab_group : ∀ a b : R, a ∈ I_set → b ∈ I_set → a-b ∈ I_set)
(I_module : ∀ (r : R) (i ∈ I_set), r*i ∈ I_set)

-/

/-

Re: ideal, you should have a is_subgroup predicate for asserting that I is closed under group operations for this
It should be similar to is_submodule in algebra/module

Whenever you are trying to make a typeclass instance solvable, you need
 to add an instance keyed
 to the form of the thing being inferred.
 If it's FP.F then this is easy, just have a theorem like
 instance : comm_ring (FP.F U O) or whatever
If it's a parameter, the comm_ring part will also need to be a parameter,
 so it shows up in the local context of all such theorems (or else it is
 derivable from something in the context that only depends on F)

I might also suggest removing the is_open parameter from F entirely, but I don't
know if that will interfere with some construction or another since that's not an
isomorphic modification (seeing as how partial functions are not nice to work
with in practice)

-/


import topology.basic
import topology.constructions
import topology.bases
import topology.metric_space.basic
import data.real.basic
import data.set.countable

open_locale classical
open set

theorem munkres_2_13_1 (X : Type*) [topological_space X] (A : set X)
  (h1 : ∀ x ∈ A, ∃ U : set X, x ∈ U ∧ is_open U ∧ U ⊆ A) :
  is_open A :=
begin
  have : A = ⋃ x, ⋃ h : x ∈ A, (classical.some (h1 x h)),
  { ext x, simp, split,
    { intro xA,
      use [x, xA],
      exact (classical.some_spec (h1 x xA)).1},
    { rintros ⟨y, yA, yspec⟩,
      have h := classical.some_spec (h1 y yA),
      exact h.2.2 yspec }, },
  rw this,
  apply is_open_Union,
  intro x,
  apply is_open_Union,
  intro xA,
  have h := classical.some_spec (h1 x xA),
  exact h.2.1
end

theorem munkres_2_13_8a :
  topological_space.is_topological_basis {S : set ℝ | ∃ a b : ℚ, a < b ∧ S = Ioo a b} :=
begin
  sorry,
end

theorem munkres_2_17_4 (X : Type*) [topological_space X] (U A : set X) (hU : is_open U)
  (hA : is_closed A) :
  is_open (U \ A) :=
begin
  sorry,
end

theorem munkres_2_21_4 (n : ℕ) (x : ℝ) (hx : 0 ≤ x ∧ x ≤ 1) :
  ∀ ε > 0, ∃ N : ℕ, ∀ m ≥ N, abs (x ^ m - x ^ n) ≥ ε
:=
begin
  sorry,
end

theorem munkres_2_22_1
  (X Y : Type*) [topological_space X] [topological_space Y]
  (p : X → Y)
  (f : Y → X)
  (hf : continuous f)
  (hpf : ∀ y : Y, p (f y) = y)
  : quotient_map p
:=
begin
  sorry,
end

theorem munkres_2_22_2a (X Y : Type*) [topological_space X] [topological_space Y] (p : X → Y)
  (f : Y → X) (hf : continuous f) (hpf : ∀ y : Y, p (f y) = y) :
  quotient_map p :=
begin
  sorry,
end


/-
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, Sébastien Gouëzel, Yury Kudryashov

! This file was ported from Lean 3 source module measure_theory.measure.lebesgue
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Dynamics.Ergodic.MeasurePreserving
import Mathbin.LinearAlgebra.Determinant
import Mathbin.LinearAlgebra.Matrix.Diagonal
import Mathbin.LinearAlgebra.Matrix.Transvection
import Mathbin.MeasureTheory.Constructions.Pi
import Mathbin.MeasureTheory.Measure.Stieltjes
import Mathbin.MeasureTheory.Measure.HaarOfBasis

/-!
# Lebesgue measure on the real line and on `ℝⁿ`

We show that the Lebesgue measure on the real line (constructed as a particular case of additive
Haar measure on inner product spaces) coincides with the Stieltjes measure associated
to the function `x ↦ x`. We deduce properties of this measure on `ℝ`, and then of the product
Lebesgue measure on `ℝⁿ`. In particular, we prove that they are translation invariant.

We show that, on `ℝⁿ`, a linear map acts on Lebesgue measure by rescaling it through the absolute
value of its determinant, in `real.map_linear_map_volume_pi_eq_smul_volume_pi`.

More properties of the Lebesgue measure are deduced from this in `haar_lebesgue.lean`, where they
are proved more generally for any additive Haar measure on a finite-dimensional real vector space.
-/

noncomputable section

open Classical Set Filter MeasureTheory MeasureTheory.Measure TopologicalSpace

open ENNReal (ofReal)

open BigOperators ENNReal NNReal Topology

/-!
### Definition of the Lebesgue measure and lengths of intervals
-/

namespace Real

variable {ι : Type _} [Fintype ι]

/-- The volume on the real line (as a particular case of the volume on a finite-dimensional
inner product space) coincides with the Stieltjes measure coming from the identity function. -/
theorem volume_eq_stieltjes_id : (volume : Measure ℝ) = StieltjesFunction.id.Measure :=
  by
  haveI : is_add_left_invariant stieltjes_function.id.measure :=
    ⟨fun a =>
      Eq.symm <|
        Real.measure_ext_Ioo_rat fun p q => by
          simp only [measure.map_apply (measurable_const_add a) measurableSet_Ioo,
            sub_sub_sub_cancel_right, StieltjesFunction.measure_Ioo, StieltjesFunction.id_leftLim,
            StieltjesFunction.id_apply, id.def, preimage_const_add_Ioo]⟩
  have A : stieltjes_function.id.measure (stdOrthonormalBasis ℝ ℝ).toBasis.parallelepiped = 1 :=
    by
    change stieltjes_function.id.measure (parallelepiped (stdOrthonormalBasis ℝ ℝ)) = 1
    rcases parallelepiped_orthonormalBasis_one_dim (stdOrthonormalBasis ℝ ℝ) with (H | H) <;>
      simp only [H, StieltjesFunction.measure_Icc, StieltjesFunction.id_apply, id.def, tsub_zero,
        StieltjesFunction.id_leftLim, sub_neg_eq_add, zero_add, ENNReal.ofReal_one]
  conv_rhs =>
    rw [add_haar_measure_unique stieltjes_function.id.measure
        (stdOrthonormalBasis ℝ ℝ).toBasis.parallelepiped,
      A]
  simp only [volume, Basis.addHaar, one_smul]
#align real.volume_eq_stieltjes_id Real.volume_eq_stieltjes_id

theorem volume_val (s) : volume s = StieltjesFunction.id.Measure s := by
  simp [volume_eq_stieltjes_id]
#align real.volume_val Real.volume_val

@[simp]
theorem volume_Ico {a b : ℝ} : volume (Ico a b) = ofReal (b - a) := by simp [volume_val]
#align real.volume_Ico Real.volume_Ico

@[simp]
theorem volume_Icc {a b : ℝ} : volume (Icc a b) = ofReal (b - a) := by simp [volume_val]
#align real.volume_Icc Real.volume_Icc

@[simp]
theorem volume_Ioo {a b : ℝ} : volume (Ioo a b) = ofReal (b - a) := by simp [volume_val]
#align real.volume_Ioo Real.volume_Ioo

@[simp]
theorem volume_Ioc {a b : ℝ} : volume (Ioc a b) = ofReal (b - a) := by simp [volume_val]
#align real.volume_Ioc Real.volume_Ioc

@[simp]
theorem volume_singleton {a : ℝ} : volume ({a} : Set ℝ) = 0 := by simp [volume_val]
#align real.volume_singleton Real.volume_singleton

@[simp]
theorem volume_univ : volume (univ : Set ℝ) = ∞ :=
  ENNReal.eq_top_of_forall_nnreal_le fun r =>
    calc
      (r : ℝ≥0∞) = volume (Icc (0 : ℝ) r) := by simp
      _ ≤ volume univ := measure_mono (subset_univ _)

#align real.volume_univ Real.volume_univ

@[simp]
theorem volume_ball (a r : ℝ) : volume (Metric.ball a r) = ofReal (2 * r) := by
  rw [ball_eq_Ioo, volume_Ioo, ← sub_add, add_sub_cancel', two_mul]
#align real.volume_ball Real.volume_ball

@[simp]
theorem volume_closedBall (a r : ℝ) : volume (Metric.closedBall a r) = ofReal (2 * r) := by
  rw [closed_ball_eq_Icc, volume_Icc, ← sub_add, add_sub_cancel', two_mul]
#align real.volume_closed_ball Real.volume_closedBall

@[simp]
theorem volume_emetric_ball (a : ℝ) (r : ℝ≥0∞) : volume (EMetric.ball a r) = 2 * r :=
  by
  rcases eq_or_ne r ∞ with (rfl | hr)
  · rw [Metric.emetric_ball_top, volume_univ, two_mul, _root_.top_add]
  · lift r to ℝ≥0 using hr
    rw [Metric.emetric_ball_nnreal, volume_ball, two_mul, ← NNReal.coe_add,
      ENNReal.ofReal_coe_nnreal, ENNReal.coe_add, two_mul]
#align real.volume_emetric_ball Real.volume_emetric_ball

@[simp]
theorem volume_emetric_closedBall (a : ℝ) (r : ℝ≥0∞) : volume (EMetric.closedBall a r) = 2 * r :=
  by
  rcases eq_or_ne r ∞ with (rfl | hr)
  · rw [EMetric.closedBall_top, volume_univ, two_mul, _root_.top_add]
  · lift r to ℝ≥0 using hr
    rw [Metric.emetric_closedBall_nnreal, volume_closed_ball, two_mul, ← NNReal.coe_add,
      ENNReal.ofReal_coe_nnreal, ENNReal.coe_add, two_mul]
#align real.volume_emetric_closed_ball Real.volume_emetric_closedBall

instance hasNoAtomsVolume : HasNoAtoms (volume : Measure ℝ) :=
  ⟨fun x => volume_singleton⟩
#align real.has_no_atoms_volume Real.hasNoAtomsVolume

@[simp]
theorem volume_interval {a b : ℝ} : volume (uIcc a b) = ofReal (|b - a|) := by
  rw [← Icc_min_max, volume_Icc, max_sub_min_eq_abs]
#align real.volume_interval Real.volume_interval

@[simp]
theorem volume_Ioi {a : ℝ} : volume (Ioi a) = ∞ :=
  top_unique <|
    le_of_tendsto' ENNReal.tendsto_nat_nhds_top fun n =>
      calc
        (n : ℝ≥0∞) = volume (Ioo a (a + n)) := by simp
        _ ≤ volume (Ioi a) := measure_mono Ioo_subset_Ioi_self

#align real.volume_Ioi Real.volume_Ioi

@[simp]
theorem volume_Ici {a : ℝ} : volume (Ici a) = ∞ := by simp [← measure_congr Ioi_ae_eq_Ici]
#align real.volume_Ici Real.volume_Ici

@[simp]
theorem volume_Iio {a : ℝ} : volume (Iio a) = ∞ :=
  top_unique <|
    le_of_tendsto' ENNReal.tendsto_nat_nhds_top fun n =>
      calc
        (n : ℝ≥0∞) = volume (Ioo (a - n) a) := by simp
        _ ≤ volume (Iio a) := measure_mono Ioo_subset_Iio_self

#align real.volume_Iio Real.volume_Iio

@[simp]
theorem volume_Iic {a : ℝ} : volume (Iic a) = ∞ := by simp [← measure_congr Iio_ae_eq_Iic]
#align real.volume_Iic Real.volume_Iic

instance locallyFiniteVolume : IsLocallyFiniteMeasure (volume : Measure ℝ) :=
  ⟨fun x =>
    ⟨Ioo (x - 1) (x + 1),
      IsOpen.mem_nhds isOpen_Ioo ⟨sub_lt_self _ zero_lt_one, lt_add_of_pos_right _ zero_lt_one⟩, by
      simp only [Real.volume_Ioo, ENNReal.ofReal_lt_top]⟩⟩
#align real.locally_finite_volume Real.locallyFiniteVolume

instance isFiniteMeasureRestrictIcc (x y : ℝ) : IsFiniteMeasure (volume.restrict (Icc x y)) :=
  ⟨by simp⟩
#align real.is_finite_measure_restrict_Icc Real.isFiniteMeasureRestrictIcc

instance isFiniteMeasureRestrictIco (x y : ℝ) : IsFiniteMeasure (volume.restrict (Ico x y)) :=
  ⟨by simp⟩
#align real.is_finite_measure_restrict_Ico Real.isFiniteMeasureRestrictIco

instance isFiniteMeasureRestrictIoc (x y : ℝ) : IsFiniteMeasure (volume.restrict (Ioc x y)) :=
  ⟨by simp⟩
#align real.is_finite_measure_restrict_Ioc Real.isFiniteMeasureRestrictIoc

instance isFiniteMeasureRestrictIoo (x y : ℝ) : IsFiniteMeasure (volume.restrict (Ioo x y)) :=
  ⟨by simp⟩
#align real.is_finite_measure_restrict_Ioo Real.isFiniteMeasureRestrictIoo

theorem volume_le_diam (s : Set ℝ) : volume s ≤ EMetric.diam s :=
  by
  by_cases hs : Metric.Bounded s
  · rw [Real.ediam_eq hs, ← volume_Icc]
    exact volume.mono (Real.subset_Icc_infₛ_supₛ_of_bounded hs)
  · rw [Metric.ediam_of_unbounded hs]
    exact le_top
#align real.volume_le_diam Real.volume_le_diam

theorem Filter.Eventually.volume_pos_of_nhds_real {p : ℝ → Prop} {a : ℝ} (h : ∀ᶠ x in 𝓝 a, p x) :
    (0 : ℝ≥0∞) < volume { x | p x } :=
  by
  rcases h.exists_Ioo_subset with ⟨l, u, hx, hs⟩
  refine' lt_of_lt_of_le _ (measure_mono hs)
  simpa [-mem_Ioo] using hx.1.trans hx.2
#align filter.eventually.volume_pos_of_nhds_real Filter.Eventually.volume_pos_of_nhds_real

/-!
### Volume of a box in `ℝⁿ`
-/

theorem volume_Icc_pi {a b : ι → ℝ} : volume (Icc a b) = ∏ i, ENNReal.ofReal (b i - a i) :=
  by
  rw [← pi_univ_Icc, volume_pi_pi]
  simp only [Real.volume_Icc]
#align real.volume_Icc_pi Real.volume_Icc_pi

@[simp]
theorem volume_Icc_pi_toReal {a b : ι → ℝ} (h : a ≤ b) :
    (volume (Icc a b)).toReal = ∏ i, b i - a i := by
  simp only [volume_Icc_pi, ENNReal.toReal_prod, ENNReal.toReal_ofReal (sub_nonneg.2 (h _))]
#align real.volume_Icc_pi_to_real Real.volume_Icc_pi_toReal

theorem volume_pi_Ioo {a b : ι → ℝ} :
    volume (pi univ fun i => Ioo (a i) (b i)) = ∏ i, ENNReal.ofReal (b i - a i) :=
  (measure_congr Measure.univ_pi_Ioo_ae_eq_Icc).trans volume_Icc_pi
#align real.volume_pi_Ioo Real.volume_pi_Ioo

@[simp]
theorem volume_pi_Ioo_toReal {a b : ι → ℝ} (h : a ≤ b) :
    (volume (pi univ fun i => Ioo (a i) (b i))).toReal = ∏ i, b i - a i := by
  simp only [volume_pi_Ioo, ENNReal.toReal_prod, ENNReal.toReal_ofReal (sub_nonneg.2 (h _))]
#align real.volume_pi_Ioo_to_real Real.volume_pi_Ioo_toReal

theorem volume_pi_Ioc {a b : ι → ℝ} :
    volume (pi univ fun i => Ioc (a i) (b i)) = ∏ i, ENNReal.ofReal (b i - a i) :=
  (measure_congr Measure.univ_pi_Ioc_ae_eq_Icc).trans volume_Icc_pi
#align real.volume_pi_Ioc Real.volume_pi_Ioc

@[simp]
theorem volume_pi_Ioc_toReal {a b : ι → ℝ} (h : a ≤ b) :
    (volume (pi univ fun i => Ioc (a i) (b i))).toReal = ∏ i, b i - a i := by
  simp only [volume_pi_Ioc, ENNReal.toReal_prod, ENNReal.toReal_ofReal (sub_nonneg.2 (h _))]
#align real.volume_pi_Ioc_to_real Real.volume_pi_Ioc_toReal

theorem volume_pi_Ico {a b : ι → ℝ} :
    volume (pi univ fun i => Ico (a i) (b i)) = ∏ i, ENNReal.ofReal (b i - a i) :=
  (measure_congr Measure.univ_pi_Ico_ae_eq_Icc).trans volume_Icc_pi
#align real.volume_pi_Ico Real.volume_pi_Ico

@[simp]
theorem volume_pi_Ico_toReal {a b : ι → ℝ} (h : a ≤ b) :
    (volume (pi univ fun i => Ico (a i) (b i))).toReal = ∏ i, b i - a i := by
  simp only [volume_pi_Ico, ENNReal.toReal_prod, ENNReal.toReal_ofReal (sub_nonneg.2 (h _))]
#align real.volume_pi_Ico_to_real Real.volume_pi_Ico_toReal

@[simp]
theorem volume_pi_ball (a : ι → ℝ) {r : ℝ} (hr : 0 < r) :
    volume (Metric.ball a r) = ENNReal.ofReal ((2 * r) ^ Fintype.card ι) :=
  by
  simp only [volume_pi_ball a hr, volume_ball, Finset.prod_const]
  exact (ENNReal.ofReal_pow (mul_nonneg zero_le_two hr.le) _).symm
#align real.volume_pi_ball Real.volume_pi_ball

@[simp]
theorem volume_pi_closedBall (a : ι → ℝ) {r : ℝ} (hr : 0 ≤ r) :
    volume (Metric.closedBall a r) = ENNReal.ofReal ((2 * r) ^ Fintype.card ι) :=
  by
  simp only [volume_pi_closed_ball a hr, volume_closed_ball, Finset.prod_const]
  exact (ENNReal.ofReal_pow (mul_nonneg zero_le_two hr) _).symm
#align real.volume_pi_closed_ball Real.volume_pi_closedBall

theorem volume_pi_le_prod_diam (s : Set (ι → ℝ)) :
    volume s ≤ ∏ i : ι, EMetric.diam (Function.eval i '' s) :=
  calc
    volume s ≤ volume (pi univ fun i => closure (Function.eval i '' s)) :=
      volume.mono <|
        Subset.trans (subset_pi_eval_image univ s) <| pi_mono fun i hi => subset_closure
    _ = ∏ i, volume (closure <| Function.eval i '' s) := (volume_pi_pi _)
    _ ≤ ∏ i : ι, EMetric.diam (Function.eval i '' s) :=
      Finset.prod_le_prod' fun i hi => (volume_le_diam _).trans_eq (EMetric.diam_closure _)

#align real.volume_pi_le_prod_diam Real.volume_pi_le_prod_diam

theorem volume_pi_le_diam_pow (s : Set (ι → ℝ)) : volume s ≤ EMetric.diam s ^ Fintype.card ι :=
  calc
    volume s ≤ ∏ i : ι, EMetric.diam (Function.eval i '' s) := volume_pi_le_prod_diam s
    _ ≤ ∏ i : ι, (1 : ℝ≥0) * EMetric.diam s :=
      (Finset.prod_le_prod' fun i hi => (LipschitzWith.eval i).ediam_image_le s)
    _ = EMetric.diam s ^ Fintype.card ι := by
      simp only [ENNReal.coe_one, one_mul, Finset.prod_const, Fintype.card]

#align real.volume_pi_le_diam_pow Real.volume_pi_le_diam_pow

/-!
### Images of the Lebesgue measure under multiplication in ℝ
-/

theorem smul_map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
    ENNReal.ofReal (|a|) • Measure.map ((· * ·) a) volume = volume :=
  by
  refine' (Real.measure_ext_Ioo_rat fun p q => _).symm
  cases' lt_or_gt_of_ne h with h h
  ·
    simp only [Real.volume_Ioo, measure.smul_apply, ← ENNReal.ofReal_mul (le_of_lt <| neg_pos.2 h),
      measure.map_apply (measurable_const_mul a) measurableSet_Ioo, neg_sub_neg, neg_mul,
      preimage_const_mul_Ioo_of_neg _ _ h, abs_of_neg h, mul_sub, smul_eq_mul,
      mul_div_cancel' _ (ne_of_lt h)]
  ·
    simp only [Real.volume_Ioo, measure.smul_apply, ← ENNReal.ofReal_mul (le_of_lt h),
      measure.map_apply (measurable_const_mul a) measurableSet_Ioo, preimage_const_mul_Ioo _ _ h,
      abs_of_pos h, mul_sub, mul_div_cancel' _ (ne_of_gt h), smul_eq_mul]
#align real.smul_map_volume_mul_left Real.smul_map_volume_mul_left

theorem map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
    Measure.map ((· * ·) a) volume = ENNReal.ofReal (|a⁻¹|) • volume := by
  conv_rhs =>
    rw [← Real.smul_map_volume_mul_left h, smul_smul, ← ENNReal.ofReal_mul (abs_nonneg _), ←
      abs_mul, inv_mul_cancel h, abs_one, ENNReal.ofReal_one, one_smul]
#align real.map_volume_mul_left Real.map_volume_mul_left

@[simp]
theorem volume_preimage_mul_left {a : ℝ} (h : a ≠ 0) (s : Set ℝ) :
    volume ((· * ·) a ⁻¹' s) = ENNReal.ofReal (abs a⁻¹) * volume s :=
  calc
    volume ((· * ·) a ⁻¹' s) = Measure.map ((· * ·) a) volume s :=
      ((Homeomorph.mulLeft₀ a h).toMeasurableEquiv.map_apply s).symm
    _ = ENNReal.ofReal (abs a⁻¹) * volume s :=
      by
      rw [map_volume_mul_left h]
      rfl

#align real.volume_preimage_mul_left Real.volume_preimage_mul_left

theorem smul_map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
    ENNReal.ofReal (|a|) • Measure.map (· * a) volume = volume := by
  simpa only [mul_comm] using Real.smul_map_volume_mul_left h
#align real.smul_map_volume_mul_right Real.smul_map_volume_mul_right

theorem map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
    Measure.map (· * a) volume = ENNReal.ofReal (|a⁻¹|) • volume := by
  simpa only [mul_comm] using Real.map_volume_mul_left h
#align real.map_volume_mul_right Real.map_volume_mul_right

@[simp]
theorem volume_preimage_mul_right {a : ℝ} (h : a ≠ 0) (s : Set ℝ) :
    volume ((· * a) ⁻¹' s) = ENNReal.ofReal (abs a⁻¹) * volume s :=
  calc
    volume ((· * a) ⁻¹' s) = Measure.map (· * a) volume s :=
      ((Homeomorph.mulRight₀ a h).toMeasurableEquiv.map_apply s).symm
    _ = ENNReal.ofReal (abs a⁻¹) * volume s :=
      by
      rw [map_volume_mul_right h]
      rfl

#align real.volume_preimage_mul_right Real.volume_preimage_mul_right

/-!
### Images of the Lebesgue measure under translation/linear maps in ℝⁿ
-/

open Matrix

/-- A diagonal matrix rescales Lebesgue according to its determinant. This is a special case of
`real.map_matrix_volume_pi_eq_smul_volume_pi`, that one should use instead (and whose proof
uses this particular case). -/
theorem smul_map_diagonal_volume_pi [DecidableEq ι] {D : ι → ℝ} (h : det (diagonal D) ≠ 0) :
    ENNReal.ofReal (abs (det (diagonal D))) • Measure.map (diagonal D).toLin' volume = volume :=
  by
  refine' (measure.pi_eq fun s hs => _).symm
  simp only [det_diagonal, measure.coe_smul, Algebra.id.smul_eq_mul, Pi.smul_apply]
  rw [measure.map_apply _ (MeasurableSet.univ_pi hs)]
  swap
  · exact Continuous.measurable (LinearMap.continuous_on_pi _)
  have :
    (Matrix.toLin' (diagonal D) ⁻¹' Set.pi Set.univ fun i : ι => s i) =
      Set.pi Set.univ fun i : ι => (· * ·) (D i) ⁻¹' s i :=
    by
    ext f
    simp only [LinearMap.coe_proj, Algebra.id.smul_eq_mul, LinearMap.smul_apply, mem_univ_pi,
      mem_preimage, LinearMap.pi_apply, diagonal_to_lin']
  have B : ∀ i, of_real (abs (D i)) * volume (Mul.mul (D i) ⁻¹' s i) = volume (s i) :=
    by
    intro i
    have A : D i ≠ 0 := by
      simp only [det_diagonal, Ne.def] at h
      exact Finset.prod_ne_zero_iff.1 h i (Finset.mem_univ i)
    rw [volume_preimage_mul_left A, ← mul_assoc, ← ENNReal.ofReal_mul (abs_nonneg _), ← abs_mul,
      mul_inv_cancel A, abs_one, ENNReal.ofReal_one, one_mul]
  rw [this, volume_pi_pi, Finset.abs_prod,
    ENNReal.ofReal_prod_of_nonneg fun i hi => abs_nonneg (D i), ← Finset.prod_mul_distrib]
  simp only [B]
#align real.smul_map_diagonal_volume_pi Real.smul_map_diagonal_volume_pi

/-- A transvection preserves Lebesgue measure. -/
theorem volumePreservingTransvectionStruct [DecidableEq ι] (t : TransvectionStruct ι ℝ) :
    MeasurePreserving t.toMatrix.toLin' :=
  by
  /- We separate the coordinate along which there is a shearing from the other ones, and apply
    Fubini. Along this coordinate (and when all the other coordinates are fixed), it acts like a
    translation, and therefore preserves Lebesgue. -/
  let p : ι → Prop := fun i => i ≠ t.i
  let α : Type _ := { x // p x }
  let β : Type _ := { x // ¬p x }
  let g : (α → ℝ) → (β → ℝ) → β → ℝ := fun a b => (fun x => t.c * a ⟨t.j, t.hij.symm⟩) + b
  let F : (α → ℝ) × (β → ℝ) → (α → ℝ) × (β → ℝ) := fun p => (id p.1, g p.1 p.2)
  let e : (ι → ℝ) ≃ᵐ (α → ℝ) × (β → ℝ) := MeasurableEquiv.piEquivPiSubtypeProd (fun i : ι => ℝ) p
  have : (t.to_matrix.to_lin' : (ι → ℝ) → ι → ℝ) = e.symm ∘ F ∘ e :=
    by
    cases t
    ext (f k)
    simp only [LinearEquiv.map_smul, dite_eq_ite, LinearMap.id_coe, p, ite_not,
      Algebra.id.smul_eq_mul, one_mul, dot_product, std_basis_matrix,
      MeasurableEquiv.piEquivPiSubtypeProd_symm_apply, id.def, transvection, Pi.add_apply,
      MulZeroClass.zero_mul, LinearMap.smul_apply, Function.comp_apply,
      MeasurableEquiv.piEquivPiSubtypeProd_apply, Matrix.TransvectionStruct.toMatrix_mk,
      Matrix.mulVec, LinearEquiv.map_add, ite_mul, e, Matrix.toLin'_apply, Pi.smul_apply,
      Subtype.coe_mk, g, LinearMap.add_apply, Finset.sum_congr, Matrix.toLin'_one]
    by_cases h : t_i = k
    ·
      simp only [h, true_and_iff, Finset.mem_univ, if_true, eq_self_iff_true, Finset.sum_ite_eq,
        one_apply, boole_mul, add_comm]
    ·
      simp only [h, Ne.symm h, add_zero, if_false, Finset.sum_const_zero, false_and_iff,
        MulZeroClass.mul_zero]
  rw [this]
  have A : measure_preserving e := by
    convert volume_preserving_pi_equiv_pi_subtype_prod (fun i : ι => ℝ) p
  have B : measure_preserving F :=
    haveI g_meas : Measurable (Function.uncurry g) :=
      by
      have : Measurable fun c : α → ℝ => c ⟨t.j, t.hij.symm⟩ :=
        measurable_pi_apply ⟨t.j, t.hij.symm⟩
      refine' (measurable_pi_lambda _ fun i => Measurable.const_mul _ _).add measurable_snd
      exact this.comp measurable_fst
    (measure_preserving.id _).skewProduct g_meas
      (eventually_of_forall fun a => map_add_left_eq_self _ _)
  exact ((A.symm e).comp B).comp A
#align real.volume_preserving_transvection_struct Real.volumePreservingTransvectionStruct

/-- Any invertible matrix rescales Lebesgue measure through the absolute value of its
determinant. -/
theorem map_matrix_volume_pi_eq_smul_volume_pi [DecidableEq ι] {M : Matrix ι ι ℝ} (hM : det M ≠ 0) :
    Measure.map M.toLin' volume = ENNReal.ofReal (abs (det M)⁻¹) • volume :=
  by
  -- This follows from the cases we have already proved, of diagonal matrices and transvections,
  -- as these matrices generate all invertible matrices.
  apply
    diagonal_transvection_induction_of_det_ne_zero _ M hM (fun D hD => _) (fun t => _)
      fun A B hA hB IHA IHB => _
  · conv_rhs => rw [← smul_map_diagonal_volume_pi hD]
    rw [smul_smul, ← ENNReal.ofReal_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel hD, abs_one,
      ENNReal.ofReal_one, one_smul]
  ·
    simp only [Matrix.TransvectionStruct.det, ENNReal.ofReal_one,
      (volume_preserving_transvection_struct _).map_eq, one_smul, _root_.inv_one, abs_one]
  · rw [to_lin'_mul, det_mul, LinearMap.coe_comp, ← measure.map_map, IHB, measure.map_smul, IHA,
      smul_smul, ← ENNReal.ofReal_mul (abs_nonneg _), ← abs_mul, mul_comm, mul_inv]
    · apply Continuous.measurable
      apply LinearMap.continuous_on_pi
    · apply Continuous.measurable
      apply LinearMap.continuous_on_pi
#align real.map_matrix_volume_pi_eq_smul_volume_pi Real.map_matrix_volume_pi_eq_smul_volume_pi

/-- Any invertible linear map rescales Lebesgue measure through the absolute value of its
determinant. -/
theorem map_linearMap_volume_pi_eq_smul_volume_pi {f : (ι → ℝ) →ₗ[ℝ] ι → ℝ} (hf : f.det ≠ 0) :
    Measure.map f volume = ENNReal.ofReal (abs f.det⁻¹) • volume := by
  classical
    -- this is deduced from the matrix case
    let M := f.to_matrix'
    have A : f.det = det M := by simp only [LinearMap.det_toMatrix']
    have B : f = M.to_lin' := by simp only [to_lin'_to_matrix']
    rw [A, B]
    apply map_matrix_volume_pi_eq_smul_volume_pi
    rwa [A] at hf
#align real.map_linear_map_volume_pi_eq_smul_volume_pi Real.map_linearMap_volume_pi_eq_smul_volume_pi

end Real

section regionBetween

variable {α : Type _}

/-- The region between two real-valued functions on an arbitrary set. -/
def regionBetween (f g : α → ℝ) (s : Set α) : Set (α × ℝ) :=
  { p : α × ℝ | p.1 ∈ s ∧ p.2 ∈ Ioo (f p.1) (g p.1) }
#align region_between regionBetween

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem regionBetween_subset (f g : α → ℝ) (s : Set α) : regionBetween f g s ⊆ s ×ˢ univ := by
  simpa only [prod_univ, regionBetween, Set.preimage, set_of_subset_set_of] using fun a => And.left
#align region_between_subset regionBetween_subset

variable [MeasurableSpace α] {μ : Measure α} {f g : α → ℝ} {s : Set α}

/-- The region between two measurable functions on a measurable set is measurable. -/
theorem measurableSet_regionBetween (hf : Measurable f) (hg : Measurable g) (hs : MeasurableSet s) :
    MeasurableSet (regionBetween f g s) :=
  by
  dsimp only [regionBetween, Ioo, mem_set_of_eq, set_of_and]
  refine'
    MeasurableSet.inter _
      ((measurableSet_lt (hf.comp measurable_fst) measurable_snd).inter
        (measurableSet_lt measurable_snd (hg.comp measurable_fst)))
  exact measurable_fst hs
#align measurable_set_region_between measurableSet_regionBetween

/-- The region between two measurable functions on a measurable set is measurable;
a version for the region together with the graph of the upper function. -/
theorem measurableSet_region_between_oc (hf : Measurable f) (hg : Measurable g)
    (hs : MeasurableSet s) :
    MeasurableSet { p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Ioc (f p.fst) (g p.fst) } :=
  by
  dsimp only [regionBetween, Ioc, mem_set_of_eq, set_of_and]
  refine'
    MeasurableSet.inter _
      ((measurableSet_lt (hf.comp measurable_fst) measurable_snd).inter
        (measurableSet_le measurable_snd (hg.comp measurable_fst)))
  exact measurable_fst hs
#align measurable_set_region_between_oc measurableSet_region_between_oc

/-- The region between two measurable functions on a measurable set is measurable;
a version for the region together with the graph of the lower function. -/
theorem measurableSet_region_between_co (hf : Measurable f) (hg : Measurable g)
    (hs : MeasurableSet s) :
    MeasurableSet { p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Ico (f p.fst) (g p.fst) } :=
  by
  dsimp only [regionBetween, Ico, mem_set_of_eq, set_of_and]
  refine'
    MeasurableSet.inter _
      ((measurableSet_le (hf.comp measurable_fst) measurable_snd).inter
        (measurableSet_lt measurable_snd (hg.comp measurable_fst)))
  exact measurable_fst hs
#align measurable_set_region_between_co measurableSet_region_between_co

/-- The region between two measurable functions on a measurable set is measurable;
a version for the region together with the graphs of both functions. -/
theorem measurableSet_region_between_cc (hf : Measurable f) (hg : Measurable g)
    (hs : MeasurableSet s) :
    MeasurableSet { p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Icc (f p.fst) (g p.fst) } :=
  by
  dsimp only [regionBetween, Icc, mem_set_of_eq, set_of_and]
  refine'
    MeasurableSet.inter _
      ((measurableSet_le (hf.comp measurable_fst) measurable_snd).inter
        (measurableSet_le measurable_snd (hg.comp measurable_fst)))
  exact measurable_fst hs
#align measurable_set_region_between_cc measurableSet_region_between_cc

/-- The graph of a measurable function is a measurable set. -/
theorem measurableSet_graph (hf : Measurable f) : MeasurableSet { p : α × ℝ | p.snd = f p.fst } :=
  by simpa using measurableSet_region_between_cc hf hf MeasurableSet.univ
#align measurable_set_graph measurableSet_graph

theorem volume_regionBetween_eq_lintegral' (hf : Measurable f) (hg : Measurable g)
    (hs : MeasurableSet s) :
    μ.Prod volume (regionBetween f g s) = ∫⁻ y in s, ENNReal.ofReal ((g - f) y) ∂μ := by
  classical
    rw [measure.prod_apply]
    · have h :
        (fun x => volume { a | x ∈ s ∧ a ∈ Ioo (f x) (g x) }) =
          s.indicator fun x => ENNReal.ofReal (g x - f x) :=
        by
        funext x
        rw [indicator_apply]
        split_ifs
        · have hx : { a | x ∈ s ∧ a ∈ Ioo (f x) (g x) } = Ioo (f x) (g x) := by simp [h, Ioo]
          simp only [hx, Real.volume_Ioo, sub_zero]
        · have hx : { a | x ∈ s ∧ a ∈ Ioo (f x) (g x) } = ∅ := by simp [h]
          simp only [hx, measure_empty]
      dsimp only [regionBetween, preimage_set_of_eq]
      rw [h, lintegral_indicator] <;> simp only [hs, Pi.sub_apply]
    · exact measurableSet_regionBetween hf hg hs
#align volume_region_between_eq_lintegral' volume_regionBetween_eq_lintegral'

/-- The volume of the region between two almost everywhere measurable functions on a measurable set
    can be represented as a Lebesgue integral. -/
theorem volume_regionBetween_eq_lintegral [SigmaFinite μ] (hf : AeMeasurable f (μ.restrict s))
    (hg : AeMeasurable g (μ.restrict s)) (hs : MeasurableSet s) :
    μ.Prod volume (regionBetween f g s) = ∫⁻ y in s, ENNReal.ofReal ((g - f) y) ∂μ :=
  by
  have h₁ :
    (fun y => ENNReal.ofReal ((g - f) y)) =ᵐ[μ.restrict s] fun y =>
      ENNReal.ofReal ((AeMeasurable.mk g hg - AeMeasurable.mk f hf) y) :=
    (hg.ae_eq_mk.sub hf.ae_eq_mk).fun_comp _
  have h₂ :
    (μ.restrict s).Prod volume (regionBetween f g s) =
      (μ.restrict s).Prod volume (regionBetween (AeMeasurable.mk f hf) (AeMeasurable.mk g hg) s) :=
    by
    apply measure_congr
    apply eventually_eq.rfl.inter
    exact
      ((quasi_measure_preserving_fst.ae_eq_comp hf.ae_eq_mk).comp₂ _ eventually_eq.rfl).inter
        (eventually_eq.rfl.comp₂ _ <| quasi_measure_preserving_fst.ae_eq_comp hg.ae_eq_mk)
  rw [lintegral_congr_ae h₁, ←
    volume_regionBetween_eq_lintegral' hf.measurable_mk hg.measurable_mk hs]
  convert h₂ using 1
  · rw [measure.restrict_prod_eq_prod_univ]
    exact (measure.restrict_eq_self _ (regionBetween_subset f g s)).symm
  · rw [measure.restrict_prod_eq_prod_univ]
    exact
      (measure.restrict_eq_self _
          (regionBetween_subset (AeMeasurable.mk f hf) (AeMeasurable.mk g hg) s)).symm
#align volume_region_between_eq_lintegral volume_regionBetween_eq_lintegral

theorem volume_regionBetween_eq_integral' [SigmaFinite μ] (f_int : IntegrableOn f s μ)
    (g_int : IntegrableOn g s μ) (hs : MeasurableSet s) (hfg : f ≤ᵐ[μ.restrict s] g) :
    μ.Prod volume (regionBetween f g s) = ENNReal.ofReal (∫ y in s, (g - f) y ∂μ) :=
  by
  have h : g - f =ᵐ[μ.restrict s] fun x => Real.toNNReal (g x - f x) :=
    hfg.mono fun x hx => (Real.coe_toNNReal _ <| sub_nonneg.2 hx).symm
  rw [volume_regionBetween_eq_lintegral f_int.ae_measurable g_int.ae_measurable hs,
    integral_congr_ae h, lintegral_congr_ae,
    lintegral_coe_eq_integral _ ((integrable_congr h).mp (g_int.sub f_int))]
  simpa only
#align volume_region_between_eq_integral' volume_regionBetween_eq_integral'

/-- If two functions are integrable on a measurable set, and one function is less than
    or equal to the other on that set, then the volume of the region
    between the two functions can be represented as an integral. -/
theorem volume_regionBetween_eq_integral [SigmaFinite μ] (f_int : IntegrableOn f s μ)
    (g_int : IntegrableOn g s μ) (hs : MeasurableSet s) (hfg : ∀ x ∈ s, f x ≤ g x) :
    μ.Prod volume (regionBetween f g s) = ENNReal.ofReal (∫ y in s, (g - f) y ∂μ) :=
  volume_regionBetween_eq_integral' f_int g_int hs
    ((ae_restrict_iff' hs).mpr (eventually_of_forall hfg))
#align volume_region_between_eq_integral volume_regionBetween_eq_integral

end regionBetween

/-- Consider a real set `s`. If a property is true almost everywhere in `s ∩ (a, b)` for
all `a, b ∈ s`, then it is true almost everywhere in `s`. Formulated with `μ.restrict`.
See also `ae_of_mem_of_ae_of_mem_inter_Ioo`. -/
theorem ae_restrict_of_ae_restrict_inter_Ioo {μ : Measure ℝ} [HasNoAtoms μ] {s : Set ℝ}
    {p : ℝ → Prop} (h : ∀ a b, a ∈ s → b ∈ s → a < b → ∀ᵐ x ∂μ.restrict (s ∩ Ioo a b), p x) :
    ∀ᵐ x ∂μ.restrict s, p x :=
  by
  /- By second-countability, we cover `s` by countably many intervals `(a, b)` (except maybe for
    two endpoints, which don't matter since `μ` does not have any atom). -/
  let T : s × s → Set ℝ := fun p => Ioo p.1 p.2
  let u := ⋃ i : ↥s × ↥s, T i
  have hfinite : (s \ u).Finite := s.finite_diff_Union_Ioo'
  obtain ⟨A, A_count, hA⟩ :
    ∃ A : Set (↥s × ↥s), A.Countable ∧ (⋃ i ∈ A, T i) = ⋃ i : ↥s × ↥s, T i :=
    is_open_Union_countable _ fun p => isOpen_Ioo
  have : s ⊆ s \ u ∪ ⋃ p ∈ A, s ∩ T p := by
    intro x hx
    by_cases h'x : x ∈ ⋃ i : ↥s × ↥s, T i
    · rw [← hA] at h'x
      obtain ⟨p, pA, xp⟩ : ∃ p : ↥s × ↥s, p ∈ A ∧ x ∈ T p := by
        simpa only [mem_Union, exists_prop, SetCoe.exists, exists_and_right] using h'x
      right
      exact mem_bUnion pA ⟨hx, xp⟩
    · exact Or.inl ⟨hx, h'x⟩
  apply ae_restrict_of_ae_restrict_of_subset this
  rw [ae_restrict_union_iff, ae_restrict_bUnion_iff _ A_count]
  constructor
  · have : μ.restrict (s \ u) = 0 := by simp only [restrict_eq_zero, hfinite.measure_zero]
    simp only [this, ae_zero]
  · rintro ⟨⟨a, as⟩, ⟨b, bs⟩⟩ -
    dsimp [T]
    rcases le_or_lt b a with (hba | hab)
    · simp only [Ioo_eq_empty_of_le hba, inter_empty, restrict_empty, ae_zero]
    · exact h a b as bs hab
#align ae_restrict_of_ae_restrict_inter_Ioo ae_restrict_of_ae_restrict_inter_Ioo

/-- Consider a real set `s`. If a property is true almost everywhere in `s ∩ (a, b)` for
all `a, b ∈ s`, then it is true almost everywhere in `s`. Formulated with bare membership.
See also `ae_restrict_of_ae_restrict_inter_Ioo`. -/
theorem ae_of_mem_of_ae_of_mem_inter_Ioo {μ : Measure ℝ} [HasNoAtoms μ] {s : Set ℝ} {p : ℝ → Prop}
    (h : ∀ a b, a ∈ s → b ∈ s → a < b → ∀ᵐ x ∂μ, x ∈ s ∩ Ioo a b → p x) : ∀ᵐ x ∂μ, x ∈ s → p x :=
  by
  /- By second-countability, we cover `s` by countably many intervals `(a, b)` (except maybe for
    two endpoints, which don't matter since `μ` does not have any atom). -/
  let T : s × s → Set ℝ := fun p => Ioo p.1 p.2
  let u := ⋃ i : ↥s × ↥s, T i
  have hfinite : (s \ u).Finite := s.finite_diff_Union_Ioo'
  obtain ⟨A, A_count, hA⟩ :
    ∃ A : Set (↥s × ↥s), A.Countable ∧ (⋃ i ∈ A, T i) = ⋃ i : ↥s × ↥s, T i :=
    is_open_Union_countable _ fun p => isOpen_Ioo
  have M : ∀ᵐ x ∂μ, x ∉ s \ u := hfinite.countable.ae_not_mem _
  have M' : ∀ᵐ x ∂μ, ∀ (i : ↥s × ↥s) (H : i ∈ A), x ∈ s ∩ T i → p x :=
    by
    rw [ae_ball_iff A_count]
    rintro ⟨⟨a, as⟩, ⟨b, bs⟩⟩ -
    change ∀ᵐ x : ℝ ∂μ, x ∈ s ∩ Ioo a b → p x
    rcases le_or_lt b a with (hba | hab)
    ·
      simp only [Ioo_eq_empty_of_le hba, inter_empty, IsEmpty.forall_iff, eventually_true,
        mem_empty_iff_false]
    · exact h a b as bs hab
  filter_upwards [M, M']with x hx h'x
  intro xs
  by_cases Hx : x ∈ ⋃ i : ↥s × ↥s, T i
  · rw [← hA] at Hx
    obtain ⟨p, pA, xp⟩ : ∃ p : ↥s × ↥s, p ∈ A ∧ x ∈ T p := by
      simpa only [mem_Union, exists_prop, SetCoe.exists, exists_and_right] using Hx
    apply h'x p pA ⟨xs, xp⟩
  · exact False.elim (hx ⟨xs, Hx⟩)
#align ae_of_mem_of_ae_of_mem_inter_Ioo ae_of_mem_of_ae_of_mem_inter_Ioo

section SummableNormIcc

open ContinuousMap

/- The following lemma is a minor variation on `integrable_of_summable_norm_restrict` in
`measure_theory.integral.set_integral`, but it is placed here because it needs to know that
`Icc a b` has volume `b - a`. -/
/-- If the sequence with `n`-th term the the sup norm of `λ x, f (x + n)` on the interval `Icc 0 1`,
for `n ∈ ℤ`, is summable, then `f` is integrable on `ℝ`. -/
theorem Real.integrableOfSummableNormIcc {E : Type _} [NormedAddCommGroup E] {f : C(ℝ, E)}
    (hf : Summable fun n : ℤ => ‖(f.comp <| ContinuousMap.addRight n).restrict (Icc 0 1)‖) :
    Integrable f :=
  by
  refine'
    integrable_of_summable_norm_restrict
      (summable_of_nonneg_of_le
        (fun n : ℤ =>
          mul_nonneg (norm_nonneg (f.restrict (⟨Icc n (n + 1), is_compact_Icc⟩ : compacts ℝ)))
            ENNReal.toReal_nonneg)
        (fun n => _) hf)
      (unionᵢ_Icc_int_cast ℝ)
  simp only [compacts.coe_mk, Real.volume_Icc, add_sub_cancel', ENNReal.toReal_ofReal zero_le_one,
    mul_one, norm_le _ (norm_nonneg _)]
  intro x
  have :=
    ((f.comp <| ContinuousMap.addRight n).restrict (Icc 0 1)).norm_coe_le_norm
      ⟨x - n, ⟨sub_nonneg.mpr x.2.1, sub_le_iff_le_add'.mpr x.2.2⟩⟩
  simpa only [ContinuousMap.restrict_apply, comp_apply, coe_add_right, Subtype.coe_mk,
    sub_add_cancel] using this
#align real.integrable_of_summable_norm_Icc Real.integrableOfSummableNormIcc

end SummableNormIcc