/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.extr
import Mathlib.topology.continuous_on
import Mathlib.PostPort

universes u v w x

namespace Mathlib

/-!
# Local extrema of functions on topological spaces

## Main definitions

This file defines special versions of `is_*_filter f a l`, `*=min/max/extr`,
from `order/filter/extr` for two kinds of filters: `nhds_within` and `nhds`.
These versions are called `is_local_*_on` and `is_local_*`, respectively.

## Main statements

Many lemmas in this file restate those from `order/filter/extr`, and you can find
a detailed documentation there. These convenience lemmas are provided only to make the dot notation
return propositions of expected types, not just `is_*_filter`.

Here is the list of statements specific to these two types of filters:

* `is_local_*.on`, `is_local_*_on.on_subset`: restrict to a subset;
* `is_local_*_on.inter` : intersect the set with another one;
* `is_*_on.localize` : a global extremum is a local extremum too.
* `is_[local_]*_on.is_local_*` : if we have `is_local_*_on f s a` and `s ∈ 𝓝 a`,
  then we have `is_local_* f a`.

-/

/-- `is_local_min_on f s a` means that `f a ≤ f x` for all `x ∈ s` in some neighborhood of `a`. -/
def is_local_min_on {α : Type u} {β : Type v} [topological_space α] [preorder β] (f : α → β) (s : set α) (a : α) :=
  is_min_filter f (nhds_within a s) a

/-- `is_local_max_on f s a` means that `f x ≤ f a` for all `x ∈ s` in some neighborhood of `a`. -/
def is_local_max_on {α : Type u} {β : Type v} [topological_space α] [preorder β] (f : α → β) (s : set α) (a : α) :=
  is_max_filter f (nhds_within a s) a

/-- `is_local_extr_on f s a` means `is_local_min_on f s a ∨ is_local_max_on f s a`. -/
def is_local_extr_on {α : Type u} {β : Type v} [topological_space α] [preorder β] (f : α → β) (s : set α) (a : α) :=
  is_extr_filter f (nhds_within a s) a

/-- `is_local_min f a` means that `f a ≤ f x` for all `x` in some neighborhood of `a`. -/
def is_local_min {α : Type u} {β : Type v} [topological_space α] [preorder β] (f : α → β) (a : α) :=
  is_min_filter f (nhds a) a

/-- `is_local_max f a` means that `f x ≤ f a` for all `x ∈ s` in some neighborhood of `a`. -/
def is_local_max {α : Type u} {β : Type v} [topological_space α] [preorder β] (f : α → β) (a : α) :=
  is_max_filter f (nhds a) a

/-- `is_local_extr_on f s a` means `is_local_min_on f s a ∨ is_local_max_on f s a`. -/
def is_local_extr {α : Type u} {β : Type v} [topological_space α] [preorder β] (f : α → β) (a : α) :=
  is_extr_filter f (nhds a) a

theorem is_local_extr_on.elim {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} {p : Prop} : is_local_extr_on f s a → (is_local_min_on f s a → p) → (is_local_max_on f s a → p) → p :=
  or.elim

theorem is_local_extr.elim {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {a : α} {p : Prop} : is_local_extr f a → (is_local_min f a → p) → (is_local_max f a → p) → p :=
  or.elim

/-! ### Restriction to (sub)sets -/

theorem is_local_min.on {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {a : α} (h : is_local_min f a) (s : set α) : is_local_min_on f s a :=
  is_min_filter.filter_inf h (filter.principal s)

theorem is_local_max.on {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {a : α} (h : is_local_max f a) (s : set α) : is_local_max_on f s a :=
  is_max_filter.filter_inf h (filter.principal s)

theorem is_local_extr.on {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {a : α} (h : is_local_extr f a) (s : set α) : is_local_extr_on f s a :=
  is_extr_filter.filter_inf h (filter.principal s)

theorem is_local_min_on.on_subset {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} {t : set α} (hf : is_local_min_on f t a) (h : s ⊆ t) : is_local_min_on f s a :=
  is_min_filter.filter_mono hf (nhds_within_mono a h)

theorem is_local_max_on.on_subset {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} {t : set α} (hf : is_local_max_on f t a) (h : s ⊆ t) : is_local_max_on f s a :=
  is_max_filter.filter_mono hf (nhds_within_mono a h)

theorem is_local_extr_on.on_subset {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} {t : set α} (hf : is_local_extr_on f t a) (h : s ⊆ t) : is_local_extr_on f s a :=
  is_extr_filter.filter_mono hf (nhds_within_mono a h)

theorem is_local_min_on.inter {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_local_min_on f s a) (t : set α) : is_local_min_on f (s ∩ t) a :=
  is_local_min_on.on_subset hf (set.inter_subset_left s t)

theorem is_local_max_on.inter {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_local_max_on f s a) (t : set α) : is_local_max_on f (s ∩ t) a :=
  is_local_max_on.on_subset hf (set.inter_subset_left s t)

theorem is_local_extr_on.inter {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_local_extr_on f s a) (t : set α) : is_local_extr_on f (s ∩ t) a :=
  is_local_extr_on.on_subset hf (set.inter_subset_left s t)

theorem is_min_on.localize {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_min_on f s a) : is_local_min_on f s a :=
  is_min_filter.filter_mono hf inf_le_right

theorem is_max_on.localize {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_max_on f s a) : is_local_max_on f s a :=
  is_max_filter.filter_mono hf inf_le_right

theorem is_extr_on.localize {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_extr_on f s a) : is_local_extr_on f s a :=
  is_extr_filter.filter_mono hf inf_le_right

theorem is_local_min_on.is_local_min {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_local_min_on f s a) (hs : s ∈ nhds a) : is_local_min f a :=
  (fun (this : nhds a ≤ filter.principal s) => is_min_filter.filter_mono hf (le_inf (le_refl (nhds a)) this))
    (iff.mpr filter.le_principal_iff hs)

theorem is_local_max_on.is_local_max {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_local_max_on f s a) (hs : s ∈ nhds a) : is_local_max f a :=
  (fun (this : nhds a ≤ filter.principal s) => is_max_filter.filter_mono hf (le_inf (le_refl (nhds a)) this))
    (iff.mpr filter.le_principal_iff hs)

theorem is_local_extr_on.is_local_extr {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_local_extr_on f s a) (hs : s ∈ nhds a) : is_local_extr f a :=
  is_local_extr_on.elim hf
    (fun (hf : is_local_min_on f s a) => is_min_filter.is_extr (is_local_min_on.is_local_min hf hs))
    fun (hf : is_local_max_on f s a) => is_max_filter.is_extr (is_local_max_on.is_local_max hf hs)

theorem is_min_on.is_local_min {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_min_on f s a) (hs : s ∈ nhds a) : is_local_min f a :=
  is_local_min_on.is_local_min (is_min_on.localize hf) hs

theorem is_max_on.is_local_max {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_max_on f s a) (hs : s ∈ nhds a) : is_local_max f a :=
  is_local_max_on.is_local_max (is_max_on.localize hf) hs

theorem is_extr_on.is_local_extr {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_extr_on f s a) (hs : s ∈ nhds a) : is_local_extr f a :=
  is_local_extr_on.is_local_extr (is_extr_on.localize hf) hs

/-! ### Constant -/

theorem is_local_min_on_const {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {a : α} {b : β} : is_local_min_on (fun (_x : α) => b) s a :=
  is_min_filter_const

theorem is_local_max_on_const {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {a : α} {b : β} : is_local_max_on (fun (_x : α) => b) s a :=
  is_max_filter_const

theorem is_local_extr_on_const {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {a : α} {b : β} : is_local_extr_on (fun (_x : α) => b) s a :=
  is_extr_filter_const

theorem is_local_min_const {α : Type u} {β : Type v} [topological_space α] [preorder β] {a : α} {b : β} : is_local_min (fun (_x : α) => b) a :=
  is_min_filter_const

theorem is_local_max_const {α : Type u} {β : Type v} [topological_space α] [preorder β] {a : α} {b : β} : is_local_max (fun (_x : α) => b) a :=
  is_max_filter_const

theorem is_local_extr_const {α : Type u} {β : Type v} [topological_space α] [preorder β] {a : α} {b : β} : is_local_extr (fun (_x : α) => b) a :=
  is_extr_filter_const

/-! ### Composition with (anti)monotone functions -/

theorem is_local_min.comp_mono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} (hf : is_local_min f a) {g : β → γ} (hg : monotone g) : is_local_min (g ∘ f) a :=
  is_min_filter.comp_mono hf hg

theorem is_local_max.comp_mono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} (hf : is_local_max f a) {g : β → γ} (hg : monotone g) : is_local_max (g ∘ f) a :=
  is_max_filter.comp_mono hf hg

theorem is_local_extr.comp_mono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} (hf : is_local_extr f a) {g : β → γ} (hg : monotone g) : is_local_extr (g ∘ f) a :=
  is_extr_filter.comp_mono hf hg

theorem is_local_min.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} (hf : is_local_min f a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_local_max (g ∘ f) a :=
  is_min_filter.comp_antimono hf hg

theorem is_local_max.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} (hf : is_local_max f a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_local_min (g ∘ f) a :=
  is_max_filter.comp_antimono hf hg

theorem is_local_extr.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} (hf : is_local_extr f a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_local_extr (g ∘ f) a :=
  is_extr_filter.comp_antimono hf hg

theorem is_local_min_on.comp_mono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_local_min_on f s a) {g : β → γ} (hg : monotone g) : is_local_min_on (g ∘ f) s a :=
  is_min_filter.comp_mono hf hg

theorem is_local_max_on.comp_mono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_local_max_on f s a) {g : β → γ} (hg : monotone g) : is_local_max_on (g ∘ f) s a :=
  is_max_filter.comp_mono hf hg

theorem is_local_extr_on.comp_mono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_local_extr_on f s a) {g : β → γ} (hg : monotone g) : is_local_extr_on (g ∘ f) s a :=
  is_extr_filter.comp_mono hf hg

theorem is_local_min_on.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_local_min_on f s a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_local_max_on (g ∘ f) s a :=
  is_min_filter.comp_antimono hf hg

theorem is_local_max_on.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_local_max_on f s a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_local_min_on (g ∘ f) s a :=
  is_max_filter.comp_antimono hf hg

theorem is_local_extr_on.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_local_extr_on f s a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_local_extr_on (g ∘ f) s a :=
  is_extr_filter.comp_antimono hf hg

theorem is_local_min.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_local_min f a) {g : α → γ} (hg : is_local_min g a) : is_local_min (fun (x : α) => op (f x) (g x)) a :=
  is_min_filter.bicomp_mono hop hf hg

theorem is_local_max.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [preorder β] [preorder γ] {f : α → β} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_local_max f a) {g : α → γ} (hg : is_local_max g a) : is_local_max (fun (x : α) => op (f x) (g x)) a :=
  is_max_filter.bicomp_mono hop hf hg

-- No `extr` version because we need `hf` and `hg` to be of the same kind

theorem is_local_min_on.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_local_min_on f s a) {g : α → γ} (hg : is_local_min_on g s a) : is_local_min_on (fun (x : α) => op (f x) (g x)) s a :=
  is_min_filter.bicomp_mono hop hf hg

theorem is_local_max_on.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_local_max_on f s a) {g : α → γ} (hg : is_local_max_on g s a) : is_local_max_on (fun (x : α) => op (f x) (g x)) s a :=
  is_max_filter.bicomp_mono hop hf hg

/-! ### Composition with `continuous_at` -/

theorem is_local_min.comp_continuous {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {g : δ → α} {b : δ} (hf : is_local_min f (g b)) (hg : continuous_at g b) : is_local_min (f ∘ g) b :=
  hg hf

theorem is_local_max.comp_continuous {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {g : δ → α} {b : δ} (hf : is_local_max f (g b)) (hg : continuous_at g b) : is_local_max (f ∘ g) b :=
  hg hf

theorem is_local_extr.comp_continuous {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {g : δ → α} {b : δ} (hf : is_local_extr f (g b)) (hg : continuous_at g b) : is_local_extr (f ∘ g) b :=
  is_extr_filter.comp_tendsto hf hg

theorem is_local_min.comp_continuous_on {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {s : set δ} {g : δ → α} {b : δ} (hf : is_local_min f (g b)) (hg : continuous_on g s) (hb : b ∈ s) : is_local_min_on (f ∘ g) s b :=
  is_min_filter.comp_tendsto hf (hg b hb)

theorem is_local_max.comp_continuous_on {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {s : set δ} {g : δ → α} {b : δ} (hf : is_local_max f (g b)) (hg : continuous_on g s) (hb : b ∈ s) : is_local_max_on (f ∘ g) s b :=
  is_max_filter.comp_tendsto hf (hg b hb)

theorem is_local_extr.comp_continuous_on {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {s : set δ} (g : δ → α) {b : δ} (hf : is_local_extr f (g b)) (hg : continuous_on g s) (hb : b ∈ s) : is_local_extr_on (f ∘ g) s b :=
  is_local_extr.elim hf
    (fun (hf : is_local_min f (g b)) => is_min_filter.is_extr (is_local_min.comp_continuous_on hf hg hb))
    fun (hf : is_local_max f (g b)) => is_max_filter.is_extr (is_local_max.comp_continuous_on hf hg hb)

theorem is_local_min_on.comp_continuous_on {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {t : set α} {s : set δ} {g : δ → α} {b : δ} (hf : is_local_min_on f t (g b)) (hst : s ⊆ g ⁻¹' t) (hg : continuous_on g s) (hb : b ∈ s) : is_local_min_on (f ∘ g) s b :=
  is_min_filter.comp_tendsto hf
    (tendsto_nhds_within_mono_right (iff.mpr set.image_subset_iff hst)
      (continuous_within_at.tendsto_nhds_within_image (hg b hb)))

theorem is_local_max_on.comp_continuous_on {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {t : set α} {s : set δ} {g : δ → α} {b : δ} (hf : is_local_max_on f t (g b)) (hst : s ⊆ g ⁻¹' t) (hg : continuous_on g s) (hb : b ∈ s) : is_local_max_on (f ∘ g) s b :=
  is_max_filter.comp_tendsto hf
    (tendsto_nhds_within_mono_right (iff.mpr set.image_subset_iff hst)
      (continuous_within_at.tendsto_nhds_within_image (hg b hb)))

theorem is_local_extr_on.comp_continuous_on {α : Type u} {β : Type v} {δ : Type x} [topological_space α] [preorder β] {f : α → β} [topological_space δ] {t : set α} {s : set δ} (g : δ → α) {b : δ} (hf : is_local_extr_on f t (g b)) (hst : s ⊆ g ⁻¹' t) (hg : continuous_on g s) (hb : b ∈ s) : is_local_extr_on (f ∘ g) s b :=
  is_local_extr_on.elim hf
    (fun (hf : is_local_min_on f t (g b)) => is_min_filter.is_extr (is_local_min_on.comp_continuous_on hf hst hg hb))
    fun (hf : is_local_max_on f t (g b)) => is_max_filter.is_extr (is_local_max_on.comp_continuous_on hf hst hg hb)

/-! ### Pointwise addition -/

theorem is_local_min.add {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} (hf : is_local_min f a) (hg : is_local_min g a) : is_local_min (fun (x : α) => f x + g x) a :=
  is_min_filter.add hf hg

theorem is_local_max.add {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} (hf : is_local_max f a) (hg : is_local_max g a) : is_local_max (fun (x : α) => f x + g x) a :=
  is_max_filter.add hf hg

theorem is_local_min_on.add {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_min_on f s a) (hg : is_local_min_on g s a) : is_local_min_on (fun (x : α) => f x + g x) s a :=
  is_min_filter.add hf hg

theorem is_local_max_on.add {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_max_on f s a) (hg : is_local_max_on g s a) : is_local_max_on (fun (x : α) => f x + g x) s a :=
  is_max_filter.add hf hg

/-! ### Pointwise negation and subtraction -/

theorem is_local_min.neg {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {a : α} (hf : is_local_min f a) : is_local_max (fun (x : α) => -f x) a :=
  is_min_filter.neg hf

theorem is_local_max.neg {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {a : α} (hf : is_local_max f a) : is_local_min (fun (x : α) => -f x) a :=
  is_max_filter.neg hf

theorem is_local_extr.neg {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {a : α} (hf : is_local_extr f a) : is_local_extr (fun (x : α) => -f x) a :=
  is_extr_filter.neg hf

theorem is_local_min_on.neg {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {a : α} {s : set α} (hf : is_local_min_on f s a) : is_local_max_on (fun (x : α) => -f x) s a :=
  is_min_filter.neg hf

theorem is_local_max_on.neg {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {a : α} {s : set α} (hf : is_local_max_on f s a) : is_local_min_on (fun (x : α) => -f x) s a :=
  is_max_filter.neg hf

theorem is_local_extr_on.neg {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {a : α} {s : set α} (hf : is_local_extr_on f s a) : is_local_extr_on (fun (x : α) => -f x) s a :=
  is_extr_filter.neg hf

theorem is_local_min.sub {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} (hf : is_local_min f a) (hg : is_local_max g a) : is_local_min (fun (x : α) => f x - g x) a :=
  is_min_filter.sub hf hg

theorem is_local_max.sub {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} (hf : is_local_max f a) (hg : is_local_min g a) : is_local_max (fun (x : α) => f x - g x) a :=
  is_max_filter.sub hf hg

theorem is_local_min_on.sub {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_min_on f s a) (hg : is_local_max_on g s a) : is_local_min_on (fun (x : α) => f x - g x) s a :=
  is_min_filter.sub hf hg

theorem is_local_max_on.sub {α : Type u} {β : Type v} [topological_space α] [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_max_on f s a) (hg : is_local_min_on g s a) : is_local_max_on (fun (x : α) => f x - g x) s a :=
  is_max_filter.sub hf hg

/-! ### Pointwise `sup`/`inf` -/

theorem is_local_min.sup {α : Type u} {β : Type v} [topological_space α] [semilattice_sup β] {f : α → β} {g : α → β} {a : α} (hf : is_local_min f a) (hg : is_local_min g a) : is_local_min (fun (x : α) => f x ⊔ g x) a :=
  is_min_filter.sup hf hg

theorem is_local_max.sup {α : Type u} {β : Type v} [topological_space α] [semilattice_sup β] {f : α → β} {g : α → β} {a : α} (hf : is_local_max f a) (hg : is_local_max g a) : is_local_max (fun (x : α) => f x ⊔ g x) a :=
  is_max_filter.sup hf hg

theorem is_local_min_on.sup {α : Type u} {β : Type v} [topological_space α] [semilattice_sup β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_min_on f s a) (hg : is_local_min_on g s a) : is_local_min_on (fun (x : α) => f x ⊔ g x) s a :=
  is_min_filter.sup hf hg

theorem is_local_max_on.sup {α : Type u} {β : Type v} [topological_space α] [semilattice_sup β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_max_on f s a) (hg : is_local_max_on g s a) : is_local_max_on (fun (x : α) => f x ⊔ g x) s a :=
  is_max_filter.sup hf hg

theorem is_local_min.inf {α : Type u} {β : Type v} [topological_space α] [semilattice_inf β] {f : α → β} {g : α → β} {a : α} (hf : is_local_min f a) (hg : is_local_min g a) : is_local_min (fun (x : α) => f x ⊓ g x) a :=
  is_min_filter.inf hf hg

theorem is_local_max.inf {α : Type u} {β : Type v} [topological_space α] [semilattice_inf β] {f : α → β} {g : α → β} {a : α} (hf : is_local_max f a) (hg : is_local_max g a) : is_local_max (fun (x : α) => f x ⊓ g x) a :=
  is_max_filter.inf hf hg

theorem is_local_min_on.inf {α : Type u} {β : Type v} [topological_space α] [semilattice_inf β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_min_on f s a) (hg : is_local_min_on g s a) : is_local_min_on (fun (x : α) => f x ⊓ g x) s a :=
  is_min_filter.inf hf hg

theorem is_local_max_on.inf {α : Type u} {β : Type v} [topological_space α] [semilattice_inf β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_max_on f s a) (hg : is_local_max_on g s a) : is_local_max_on (fun (x : α) => f x ⊓ g x) s a :=
  is_max_filter.inf hf hg

/-! ### Pointwise `min`/`max` -/

theorem is_local_min.min {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} (hf : is_local_min f a) (hg : is_local_min g a) : is_local_min (fun (x : α) => min (f x) (g x)) a :=
  is_min_filter.min hf hg

theorem is_local_max.min {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} (hf : is_local_max f a) (hg : is_local_max g a) : is_local_max (fun (x : α) => min (f x) (g x)) a :=
  is_max_filter.min hf hg

theorem is_local_min_on.min {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_min_on f s a) (hg : is_local_min_on g s a) : is_local_min_on (fun (x : α) => min (f x) (g x)) s a :=
  is_min_filter.min hf hg

theorem is_local_max_on.min {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_max_on f s a) (hg : is_local_max_on g s a) : is_local_max_on (fun (x : α) => min (f x) (g x)) s a :=
  is_max_filter.min hf hg

theorem is_local_min.max {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} (hf : is_local_min f a) (hg : is_local_min g a) : is_local_min (fun (x : α) => max (f x) (g x)) a :=
  is_min_filter.max hf hg

theorem is_local_max.max {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} (hf : is_local_max f a) (hg : is_local_max g a) : is_local_max (fun (x : α) => max (f x) (g x)) a :=
  is_max_filter.max hf hg

theorem is_local_min_on.max {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_min_on f s a) (hg : is_local_min_on g s a) : is_local_min_on (fun (x : α) => max (f x) (g x)) s a :=
  is_min_filter.max hf hg

theorem is_local_max_on.max {α : Type u} {β : Type v} [topological_space α] [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_local_max_on f s a) (hg : is_local_max_on g s a) : is_local_max_on (fun (x : α) => max (f x) (g x)) s a :=
  is_max_filter.max hf hg

/-! ### Relation with `eventually` comparisons of two functions -/

theorem filter.eventually_le.is_local_max_on {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (hle : filter.eventually_le (nhds_within a s) g f) (hfga : f a = g a) (h : is_local_max_on f s a) : is_local_max_on g s a :=
  filter.eventually_le.is_max_filter hle hfga h

theorem is_local_max_on.congr {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (h : is_local_max_on f s a) (heq : filter.eventually_eq (nhds_within a s) f g) (hmem : a ∈ s) : is_local_max_on g s a :=
  is_max_filter.congr h heq (filter.eventually_eq.eq_of_nhds_within heq hmem)

theorem filter.eventually_eq.is_local_max_on_iff {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (heq : filter.eventually_eq (nhds_within a s) f g) (hmem : a ∈ s) : is_local_max_on f s a ↔ is_local_max_on g s a :=
  filter.eventually_eq.is_max_filter_iff heq (filter.eventually_eq.eq_of_nhds_within heq hmem)

theorem filter.eventually_le.is_local_min_on {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (hle : filter.eventually_le (nhds_within a s) f g) (hfga : f a = g a) (h : is_local_min_on f s a) : is_local_min_on g s a :=
  filter.eventually_le.is_min_filter hle hfga h

theorem is_local_min_on.congr {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (h : is_local_min_on f s a) (heq : filter.eventually_eq (nhds_within a s) f g) (hmem : a ∈ s) : is_local_min_on g s a :=
  is_min_filter.congr h heq (filter.eventually_eq.eq_of_nhds_within heq hmem)

theorem filter.eventually_eq.is_local_min_on_iff {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (heq : filter.eventually_eq (nhds_within a s) f g) (hmem : a ∈ s) : is_local_min_on f s a ↔ is_local_min_on g s a :=
  filter.eventually_eq.is_min_filter_iff heq (filter.eventually_eq.eq_of_nhds_within heq hmem)

theorem is_local_extr_on.congr {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (h : is_local_extr_on f s a) (heq : filter.eventually_eq (nhds_within a s) f g) (hmem : a ∈ s) : is_local_extr_on g s a :=
  is_extr_filter.congr h heq (filter.eventually_eq.eq_of_nhds_within heq hmem)

theorem filter.eventually_eq.is_local_extr_on_iff {α : Type u} {β : Type v} [topological_space α] [preorder β] {s : set α} {f : α → β} {g : α → β} {a : α} (heq : filter.eventually_eq (nhds_within a s) f g) (hmem : a ∈ s) : is_local_extr_on f s a ↔ is_local_extr_on g s a :=
  filter.eventually_eq.is_extr_filter_iff heq (filter.eventually_eq.eq_of_nhds_within heq hmem)

theorem filter.eventually_le.is_local_max {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (hle : filter.eventually_le (nhds a) g f) (hfga : f a = g a) (h : is_local_max f a) : is_local_max g a :=
  filter.eventually_le.is_max_filter hle hfga h

theorem is_local_max.congr {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (h : is_local_max f a) (heq : filter.eventually_eq (nhds a) f g) : is_local_max g a :=
  is_max_filter.congr h heq (filter.eventually_eq.eq_of_nhds heq)

theorem filter.eventually_eq.is_local_max_iff {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (heq : filter.eventually_eq (nhds a) f g) : is_local_max f a ↔ is_local_max g a :=
  filter.eventually_eq.is_max_filter_iff heq (filter.eventually_eq.eq_of_nhds heq)

theorem filter.eventually_le.is_local_min {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (hle : filter.eventually_le (nhds a) f g) (hfga : f a = g a) (h : is_local_min f a) : is_local_min g a :=
  filter.eventually_le.is_min_filter hle hfga h

theorem is_local_min.congr {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (h : is_local_min f a) (heq : filter.eventually_eq (nhds a) f g) : is_local_min g a :=
  is_min_filter.congr h heq (filter.eventually_eq.eq_of_nhds heq)

theorem filter.eventually_eq.is_local_min_iff {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (heq : filter.eventually_eq (nhds a) f g) : is_local_min f a ↔ is_local_min g a :=
  filter.eventually_eq.is_min_filter_iff heq (filter.eventually_eq.eq_of_nhds heq)

theorem is_local_extr.congr {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (h : is_local_extr f a) (heq : filter.eventually_eq (nhds a) f g) : is_local_extr g a :=
  is_extr_filter.congr h heq (filter.eventually_eq.eq_of_nhds heq)

theorem filter.eventually_eq.is_local_extr_iff {α : Type u} {β : Type v} [topological_space α] [preorder β] {f : α → β} {g : α → β} {a : α} (heq : filter.eventually_eq (nhds a) f g) : is_local_extr f a ↔ is_local_extr g a :=
  filter.eventually_eq.is_extr_filter_iff heq (filter.eventually_eq.eq_of_nhds heq)


import mynat.definition
import mynat.add
import world8.level4

namespace mynat

theorem ne_succ_self (n : mynat) : n ≠ succ(n) :=
begin [nat_num_game]
    induction n with d hd,
    {
        exact zero_ne_succ 0,
    },
    {
        intro h,
        apply hd,
        apply succ_inj,
        exact h,
    },
end

-- theorem ne_succ_self (n : mynat) : n ≠ succ(n) :=
-- begin [nat_num_game]
--     induction n with d hd,
--     {
--         exact zero_ne_succ 0,
--     },
--     {
--         rw ne_from_not_eq at hd,
--         rw ← eq_iff_succ_eq_succ at hd,
--         rw ← ne_from_not_eq at hd,
--         exact hd,
--     },
-- end

end mynat


import data.real.irrational

theorem t001 : irrational (real.sqrt 2) :=
irr_sqrt_two

#print t001


/-

# Advanced proposition world.

## Level 4: `iff_trans`.

The mathematical statement $P\iff Q$ is equivalent to $(P\implies Q)\land(Q\implies P)$. The `cases`
and `split` tactics work on hypotheses and goals (respectively) of the form `P ↔ Q`. If you need
to write an `↔` arrow you can do so by typing `\iff`, but you shouldn't need to. After an initial
`intro h,` you can type `cases h with hpq hqp` to break `h : P ↔ Q` into its constituent parts.
-/

/- Lemma
If $P$, $Q$ and $R$ are true/false statements, then
$P\iff Q$ and $Q\iff R$ together imply $P\iff R$.
-/
lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intro hpq,
  intro hqr,
  cases hpq with hpq hqp,
  cases hqr with hqr hrq,
  split,
  cc,cc,

end


/-
Copyright (c) 2020 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang
-/
import ring_theory.polynomial.basic
import ring_theory.polynomial.symmetric

/-!
# Vieta's Formula

The main result is `vieta.prod_X_add_C_eq_sum_esymm`, which shows that the product of linear terms
`λ + X i` is equal to a linear combination of the symmetric polynomials `esymm σ R j`.

## Implementation Notes:

We first take the viewpoint where the "roots" `X i` are variables. This means we work over
`polynomial (mv_polynomial σ R)`, which enables us to talk about linear combinations of
`esymm σ R j`. We then derive Vieta's formula in `polynomial R` by giving a
valuation from each `X i` to `r i`.

-/

universes u
open_locale big_operators

open finset polynomial fintype

namespace mv_polynomial

variables {R : Type u} [comm_semiring R]
variables (σ : Type u) [fintype σ]

/-- A sum version of Vieta's formula. Viewing `X i` as variables,
the product of linear terms `λ + X i` is equal to a linear combination of
the symmetric polynomials `esymm σ R j`. -/
lemma prod_X_add_C_eq_sum_esymm :
  (∏ i : σ, (polynomial.C (X i) + polynomial.X) : polynomial (mv_polynomial σ R) )=
  ∑ j in range (card σ + 1),
    (polynomial.C (esymm σ R j) * polynomial.X ^ (card σ - j)) :=
begin
  classical,
  rw [prod_add, sum_powerset],
  refine sum_congr begin congr end (λ j hj, _),
  rw [esymm, polynomial.C.map_sum, sum_mul],
  refine sum_congr rfl (λ t ht, _),
  have h : (univ \ t).card = card σ - j :=
  by { rw card_sdiff (mem_powerset_len.mp ht).1, congr, exact (mem_powerset_len.mp ht).2 },
  rw [(polynomial.C : mv_polynomial σ R →+* polynomial _).map_prod, prod_const, ← h],
  congr,
end

/-- A fully expanded sum version of Vieta's formula, evaluated at the roots.
The product of linear terms `X + r i` is equal to `∑ j in range (n + 1), e_j * X ^ (n - j)`,
where `e_j` is the `j`th symmetric polynomial of the constant terms `r i`. -/
lemma prod_X_add_C_eval (r : σ → R) : ∏ i : σ, (polynomial.C (r i) + polynomial.X) =
  ∑ i in range (card σ + 1), (∑ t in powerset_len i (univ : finset σ),
    ∏ i in t, polynomial.C (r i)) * polynomial.X ^ (card σ - i) :=
begin
  classical,
  have h := @prod_X_add_C_eq_sum_esymm _ _ σ _,
  apply_fun (polynomial.map (eval r)) at h,
  rw [map_prod, map_sum] at h,
  convert h,
  simp only [eval_X, polynomial.map_add, polynomial.map_C, polynomial.map_X, eq_self_iff_true],
  funext,
  simp only [function.funext_iff, esymm, polynomial.map_C, map_sum, polynomial.C.map_sum,
    polynomial.map_C, map_pow, polynomial.map_X, polynomial.map_mul],
  congr,
  funext,
  simp only [eval_prod, eval_X, (polynomial.C : R →+* polynomial R).map_prod],
end

lemma esymm_to_sum (r : σ → R) (j : ℕ) : polynomial.C (eval r (esymm σ R j)) =
  ∑ t in powerset_len j (univ : finset σ), ∏ i in t, polynomial.C (r i) :=
by simp only [esymm, eval_sum, eval_prod, eval_X, polynomial.C.map_sum,
  (polynomial.C : R →+* polynomial _).map_prod]

/-- Vieta's formula for the coefficients of the product of linear terms `X + r i`,
The `k`th coefficient is `∑ t in powerset_len (card σ - k) (univ : finset σ), ∏ i in t, r i`,
i.e. the symmetric polynomial `esymm σ R (card σ - k)` of the constant terms `r i`. -/

end mv_polynomial


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Module.abelian
import category_theory.limits.shapes.images

/-!
# The category of R-modules has images.

Note that we don't need to register any of the constructions here as instances, because we get them
from the fact that `Module R` is an abelian category.
-/

open category_theory
open category_theory.limits

universes u v

namespace Module

variables {R : Type u} [comm_ring R]

variables {G H : Module.{v} R} (f : G ⟶ H)

local attribute [ext] subtype.ext_val

section -- implementation details of `has_image` for Module; use the API, not these
/-- The image of a morphism in `Module R` is just the bundling of `linear_map.range f` -/
def image : Module R := Module.of R (linear_map.range f)

/-- The inclusion of `image f` into the target -/
def image.ι : image f ⟶ H := f.range.subtype

instance : mono (image.ι f) := concrete_category.mono_of_injective (image.ι f) subtype.val_injective

/-- The corestriction map to the image -/
def factor_thru_image : G ⟶ image f := f.range_restrict

lemma image.fac : factor_thru_image f ≫ image.ι f = f :=
by { ext, refl, }

local attribute [simp] image.fac

variables {f}
/-- The universal property for the image factorisation -/
noncomputable def image.lift (F' : mono_factorisation f) : image f ⟶ F'.I :=
{ to_fun :=
  (λ x, F'.e (classical.indefinite_description _ x.2).1 : image f → F'.I),
  map_add' :=
  begin
    intros x y,
    haveI := F'.m_mono,
    apply (mono_iff_injective F'.m).1, apply_instance,
    rw [linear_map.map_add],
    change (F'.e ≫ F'.m) _ = (F'.e ≫ F'.m) _ + (F'.e ≫ F'.m) _,
    rw [F'.fac],
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    refl,
  end,
  map_smul' := λ c x,
  begin
    haveI := F'.m_mono,
    apply (mono_iff_injective F'.m).1, apply_instance,
    rw [linear_map.map_smul],
    change (F'.e ≫ F'.m) _ = _ • (F'.e ≫ F'.m) _,
    rw [F'.fac],
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    refl,
  end }

lemma image.lift_fac (F' : mono_factorisation f) : image.lift F' ≫ F'.m = image.ι f :=
begin
  ext x,
  change (F'.e ≫ F'.m) _ = _,
  rw [F'.fac, (classical.indefinite_description _ x.2).2],
  refl,
end
end

/-- The factorisation of any morphism in `Module R` through a mono. -/
def mono_factorisation : mono_factorisation f :=
{ I := image f,
  m := image.ι f,
  e := factor_thru_image f }

/-- The factorisation of any morphism in `Module R` through a mono has the universal property of
the image. -/
noncomputable def is_image : is_image (mono_factorisation f) :=
{ lift := image.lift,
  lift_fac' := image.lift_fac }

/--
The categorical image of a morphism in `Module R`
agrees with the linear algebraic range.
-/
noncomputable def image_iso_range {G H : Module.{v} R} (f : G ⟶ H) :
  limits.image f ≅ Module.of R f.range :=
is_image.iso_ext (image.is_image f) (is_image f)

@[simp, reassoc, elementwise]
lemma image_iso_range_inv_image_ι {G H : Module.{v} R} (f : G ⟶ H) :
  (image_iso_range f).inv ≫ limits.image.ι f = Module.of_hom f.range.subtype :=
is_image.iso_ext_inv_m _ _

@[simp, reassoc, elementwise]
lemma image_iso_range_hom_subtype {G H : Module.{v} R} (f : G ⟶ H) :
  (image_iso_range f).hom ≫ Module.of_hom f.range.subtype = limits.image.ι f :=
by erw [←image_iso_range_inv_image_ι f, iso.hom_inv_id_assoc]

end Module


/-
This file contains a formal computer proof of O(1/k) convergence of gradient descent with
constant stepsize for convex functions of scalar-valued inputs. It is self-contained
other than using properties of real and natural numbers defined in mathlib.
I define the properties of convexity and Lipschitz continuous gradient here
and do not rely on the mathlib-defined gradient. This means that a user
would have to ensure that their function is convex and the gradient is correct.
While not ideal, this simplified the proofs.

We closely follow the proof of
http://www.seas.ucla.edu/~vandenbe/236C/lectures/gradient.pdf
-/

import data.real.basic

-- The method under study
-- This is a polymorphic definition in that it works for any Type α that has
-- a subtraction operation and a multiplication operation.
-- This allows us to reason about behavior for the case α = ℝ but also
-- run it when α = float. We will only prove theorems for α = ℝ.
def grad_descent {α : Type}
            [has_sub α]
            [has_mul α]
            (η : α) (x0 : α) (gradf : α → α): (ℕ → α)
| 0      := x0
| (n+1)  := grad_descent(n) - η*gradf(grad_descent(n))

-- Definition of a convex function and it's gradient.
def is_convex (f: ℝ → ℝ) (gradf : ℝ → ℝ) : Prop :=
  ∀ (x y : ℝ), f(y) ≥  f(x) + gradf(x)*(y-x)

-- (Working) Definition of Lipschitz-continuous gradient
def is_lip_grad (f: ℝ → ℝ) (gradf : ℝ → ℝ) (L : ℝ) : Prop :=
  ∀ (x y : ℝ), f(y) ≤ f(x) + gradf(x)*(y-x) + 0.5*L*(y-x)^2

-- A basic descent lemma for gradient descent
lemma basic_grad_step (x : ℝ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hlip : is_lip_grad f gradf L)
                      :
  f(x-η*gradf x) ≤ f(x) - η*(1-L*η/2)*(gradf x)^2
  :=
begin
  have hLip := hlip x (x-η*gradf x),

  rw mul_comm η (gradf x) at hLip,

  have h1 : x - gradf x * η - x = - gradf x * η := by linarith,
  rw h1 at hLip,
  have h2 : 1 / 2 * L * (-gradf x * η) ^ 2 = 1 / 2 * L * (gradf x)^2 * η^2
  := by ring,
  rw h2 at hLip,
  have h3 : gradf x * (-gradf x * η) = - η*(gradf x)^2 := by ring,
  rw h3 at hLip,
  have h4 : 1 / 2 * L * gradf x ^ 2 * η ^ 2 = (1 / 2)*(η ^ 2) * L * gradf x^2
  := by ring,
  rw h4 at hLip,
  have h5 :f x + -η * gradf x ^ 2 + 1 / 2 * η ^ 2 * L * gradf x ^ 2
            = f x -η*(1 -  η * L/2) * gradf x^2
            := by linarith,

  rw h5 at hLip,
  rw mul_comm (gradf x) η at hLip,
  rw mul_comm η L at hLip,
  exact hLip,

end

-- an algebraic manipulation lemma
lemma complete_square (a b t : ℝ) (ht : t > 0):
  a*b - (t/2)*a^2 = (1/(2*t))*(b^2 - (b-t*a)^2)
  :=
begin
  have h1 : (b-t*a)^2 = b^2 - 2*b*t*a + (t*a)^2,
  {
    rw sub_sq,
    ring,
  },
  rw h1,
  have h2 :b ^ 2 - (b ^ 2 - 2 * b * t * a + (t * a) ^ 2) =
      2 * b * t * a - (t * a) ^ 2 := by linarith,
  rw h2,
  have h3 : 1 / (2 * t) * (2 * b * t * a - (t * a) ^ 2) =
            1 / (2 * t) * 2 * b * t * a - 1 / (2 * t)*(t * a) ^ 2
          := by ring,
  rw h3,
  simp,
  have h4 : (2*t)⁻¹ = 2⁻¹*t⁻¹ := mul_inv₀,
  rw h4,
  rw pow_two (t*a),
  have h5 :  2⁻¹ * t⁻¹ * (t * a * (t * a)) = 2⁻¹ * (t⁻¹ * t) * a * (t * a)
    := by ring,
  rw h5,
  have ht2 : t ≠ 0 := by linarith,
  rw mul_comm t⁻¹ t,

  rw mul_inv_cancel ht2,
  rw mul_one,

  have h6 : 2⁻¹ * t⁻¹ * 2 * b * t * a = 2⁻¹ * 2 * (t⁻¹ * t) * b  * a := by ring,
  rw h6,
  rw mul_comm t⁻¹ t,
  rw mul_inv_cancel ht2,
  rw mul_one,
  have h7 : 2⁻¹ * 2 * b * a = b*a := by ring,
  rw h7,

  have h8 : 2⁻¹ * a * (t * a) = 2⁻¹ * t * a * a := by ring,
  rw h8,
  rw div_eq_inv_mul,
  ring,

end

-- a stepsize technicality
lemma stepsz_upper (t L : ℝ) (hL : L ≥ 0) (h : t≤1/L): t*L ≤ 1 :=
begin

  cases lt_or_ge 0 L,

  exact (le_div_iff h_1).mp h,

  have h2 : L=0 := by linarith,
  rw h2,
  linarith,

end

-- further refinement of the descent properties of the algorithm
lemma basic_grad_step_v2 (x : ℝ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hL : L ≥ 0)
                      (hη_low : η ≥ 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      :
    f(x-η*gradf x) ≤ f(x) -(η/2)*(gradf x)^2
  :=
  begin
    have hbas := basic_grad_step x η L f gradf hlip,
    have hgradPos : gradf x ^2 ≥ 0 := by exact sq_nonneg (gradf x),

    have hCoefPos : η*(1-L*η/2) ≥ η/2,
    {

      have h3 : η*L ≤ 1 := by exact stepsz_upper η L hL hη2,

      have h4 : L*η≤ 1 := by linarith,
      have h5 : L*η/2 ≤ 1/2 := by linarith,
      have h6 : -L*η/2 ≥  -1/2 := by linarith,
      have h7 : 1-L*η/2 ≥  1/2 := by linarith,
      have h8 : η*(1-L*η/2) ≥  η*(1/2)
              := by exact mul_le_mul_of_nonneg_left h7 hη_low,
      linarith,
    },

    have h9 : η*(1-L*η/2)*(gradf x)^2 ≥ (η/2)*(gradf x)^2 :=
      mul_mono_nonneg hgradPos hCoefPos,

    linarith,

  end

-- formally stating that the algorithm decreases function values
lemma descent (x : ℝ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hL : L ≥ 0)
                      (hη_low : η ≥ 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      :
    f(x-η*gradf x) ≤ f(x)
  :=
begin
  have hbas := basic_grad_step_v2 x η L f gradf hL hη_low hη2 hlip,
  have hgradPos : gradf x ^2 ≥ 0 := by exact sq_nonneg (gradf x),
  have h2 : η / 2 ≥ 0 := by linarith,
  have h3 : (η / 2)*(gradf x)^2 ≥ 0 := mul_nonneg h2 hgradPos,
  linarith,
end

lemma prepare_to_telescope (x y: ℝ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    f(x-η*gradf x) - f y ≤ (1/(2*η))*((x-y)^2 - (x-η*gradf x - y)^2)
    :=
begin

  have hη_low2 : η ≥ 0 := by linarith,

  have h1 := basic_grad_step_v2  x η L f gradf hL hη_low2 hη2 hlip,

  have h2 :  f (x - η * gradf x) -f y ≤ f x - f y - η / 2 * gradf x ^ 2
    := by linarith,

  have h3 := hconv x y,

  have h4 :  f x - f y ≤ - gradf x * (y - x) := by linarith,
  have h5 : - gradf x * (y - x) = gradf x * (x - y) := by linarith,
  rw h5 at h4,
  have h6 : f (x - η * gradf x) - f y ≤
    gradf x * (x - y)- η / 2 * gradf x ^ 2 := by linarith,

  have h7 : gradf x * (x - y) - η / 2 * gradf x ^ 2
    = (1/(2*η))*((x-y)^2 - (x-y - η*gradf x)^2)
    := by exact complete_square  (gradf x) (x-y) (η) (hη_low),

  rw h7 at h6,
  linarith,

end

-- rewrite the telescoping more favorably
lemma prepare_to_telescope2 (x0 y: ℝ) (n : ℕ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    f(grad_descent η x0 gradf (n+1)) - f y ≤
    (1/(2*η))*((grad_descent η x0 gradf n-y)^2 - (grad_descent η x0 gradf (n+1) - y)^2)
    :=
begin

  have h1 : grad_descent η x0 gradf (n+1) =
            grad_descent η x0 gradf (n) - η*gradf(grad_descent η x0 gradf (n))
          := by refl,
  rw h1,

  exact prepare_to_telescope (grad_descent η x0 gradf (n)) y η L f gradf hL hη_low hη2 hlip hconv,

end

-- sum_f is just the sum of function values evaluated at the points
-- generated by the algorithm (again defined recursively)
def sum_f (y x0 : ℝ) (f : ℝ → ℝ) (η : ℝ) (gradf : ℝ → ℝ): (ℕ → ℝ)
| 0      := 0
| (n+1)  := sum_f(n) + f(grad_descent η x0 gradf (n+1)) - f y

-- the all important telescoping result
lemma telescope (x0 y: ℝ) (n : ℕ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    sum_f y x0 f η gradf (n) ≤ (1/(2*η))*((x0-y)^2 - (grad_descent η x0 gradf n  - y)^2)
    :=
begin
  induction n with k hk,

  have h1 : grad_descent η x0 gradf 0 = x0 := by refl,
  rw h1,

  have h2 : 1 / (2 * η) * ((x0 - y) ^ 2 - (x0 - y) ^ 2) = 0 := by linarith,
  rw h2,
  refl,

  have h3 : sum_f y x0 f η gradf k.succ = sum_f y x0 f η gradf k +
       f(grad_descent η x0 gradf (k+1)) - f y := by refl,
  rw h3,

  have h4 := prepare_to_telescope2 x0 y k η L f gradf hL hη_low hη2 hlip hconv,

  linarith,

end

-- a simple upper bound derived from telescoping
lemma from_telescope (x0 y: ℝ) (n : ℕ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    sum_f y x0 f η gradf (n) ≤ (1/(2*η))*(x0-y)^2
    :=
begin
  have h := telescope x0 y n η L f gradf hL hη_low hη2 hlip hconv,

  have h1 : (grad_descent η x0 gradf n - y) ^ 2 ≥ 0
    := sq_nonneg (grad_descent η x0 gradf n - y),

  have h2 : 1 / (2 * η) * ((x0 - y) ^ 2 - (grad_descent η x0 gradf n - y) ^ 2)
          =  1 / (2 * η)*(x0 - y) ^ 2 - 1 / (2 * η) *(grad_descent η x0 gradf n - y) ^ 2
    := mul_sub (1 / (2 * η)) ((x0 - y) ^ 2) ((grad_descent η x0 gradf n - y) ^ 2),

  rw h2 at h,

  have h3 : 1 / (2 * η) ≥ 0,
  {
    have h4 : 2 * η ≥ 0 := by linarith,
    exact one_div_nonneg.mpr h4,
  },
  have h5 : 1 / (2 * η) * (grad_descent η x0 gradf n - y) ^ 2 ≥ 0
    := mul_nonneg h3 h1,
  linarith,
end

-- since func values are decreasing, the sum of func vals provides
-- a bound on the last function value as follows
lemma last_less_than_av (x0 y: ℝ) (n : ℕ) (η L : ℝ) (f gradf : ℝ → ℝ)
                      (hL : L ≥ 0)
                      (hη_low : η > 0)
                      (hη2 : η ≤ 1/L)
                      (hlip : is_lip_grad f gradf L)
                      (hconv : is_convex f gradf)
                      :
    sum_f y x0 f η gradf (n) ≥ n*(f(grad_descent η x0 gradf n) - f y)
    :=
begin
  induction n with k hk,
  have h : ↑0 = (0:ℝ):= nat.cast_zero,
  rw h,
  rw zero_mul,
  have h1 : sum_f y x0 f η gradf 0 = 0 := by refl,
  rw h1,
  exact rfl.ge,

  have h2 : sum_f y x0 f η gradf k.succ = sum_f y x0 f η gradf (k) + f(grad_descent η x0 gradf (k+1)) - f y
    := by refl,

  rw h2,

  rw nat.succ_eq_add_one,
  have h3 : ↑(k+1) = (k+1 : ℝ):= nat.cast_succ k,
  rw h3,
  have h4 : (↑k + 1) * (f (grad_descent η x0 gradf (k + 1)) - f y)
            = ↑k*(f (grad_descent η x0 gradf (k + 1)) - f y)
              + f (grad_descent η x0 gradf (k + 1)) - f y
          := by linarith,
  rw h4,

  have hη_low2 : η ≥ 0 := by linarith,

  have hdesc := descent (grad_descent η x0 gradf k) η L f gradf hL hη_low2 hη2 hlip,

  have h5 : grad_descent η x0 gradf (k+1) =
        grad_descent η x0 gradf k - η * gradf (grad_descent η x0 gradf k)
    := by refl,

  rw ← h5 at hdesc,

  have h6 : ↑k * f (grad_descent η x0 gradf (k + 1)) ≤ ↑k * f (grad_descent η x0 gradf k),
  {
    have hupk : (0:ℝ) ≤ (↑k)  := nat.cast_nonneg k,

    exact mul_le_mul_of_nonneg_left hdesc hupk,

  },

  linarith,

end

-- Main convergence rate result
-- Note that y is an arbitrary point but it is customarily taken to
-- be one of the minimizers (assuming minimizers exist)
theorem grad_descent_convergence_rate (n : ℕ) (η L : ℝ) (x0 y : ℝ) (f gradf : ℝ → ℝ)
                        (hn : n ≥ 1)
                        (hη_low : η > 0)
                        (hη_up : η ≤ 1/L)
                        (hL : L ≥ 0)
                        (hconv : is_convex f gradf)
                        (hlip : is_lip_grad f gradf L)
                        :
      f(grad_descent η x0 gradf n) - f(y)≤ (1/(2*η*n))*(x0-y)^2
   :=
begin

  have h0 := from_telescope x0 y n η L f gradf hL hη_low hη_up hlip hconv,

  have h1 := last_less_than_av x0 y n η L f gradf hL hη_low hη_up hlip hconv,

  have h2 : ↑n * (f (grad_descent η x0 gradf n) - f y) ≤ 1 / (2 * η) * (x0 - y) ^ 2
   := by linarith,

  have h3 :  (f (grad_descent η x0 gradf n) - f y) ≤ 1 / (2 * η) * (x0 - y) ^ 2 / ↑n,
  {
    have h4 : ↑n≥ (1:ℝ) := nat.one_le_cast.mpr hn,

    have h5 : ↑n > (0:ℝ) := by linarith,

    exact (le_div_iff' h5).mpr h2,
  },

  have h6 : 1 / (2 * η) * (x0 - y) ^ 2 / ↑n = (1/↑n)*1 / (2 * η) * (x0 - y) ^ 2
    := by ring,

  have h7 : (1/↑n)*1 / (2 * η)
            = 1 / (2 * η * ↑n),
  {
    ring,
    exact mul_inv₀.symm,
  },
  rw h6 at h3,
  rw h7 at h3,
  exact h3,

end


def List.foldl_wf [SizeOf β] (bs : List β) (init : α) (f : α → (b : β) → sizeOf b < sizeOf bs → α) : α :=
  go init bs (Nat.le_refl ..)
where
  go (a : α) (cs : List β) (h : sizeOf cs ≤ sizeOf bs) : α :=
    match cs with
    | [] => a
    | c :: cs =>
      have : sizeOf c < sizeOf (c :: cs) := by simp_arith
      -- TODO: simplify using linarith
      have h₁ : sizeOf c < sizeOf bs := Nat.lt_of_lt_of_le this h
      have : sizeOf cs + (sizeOf c + 1) = sizeOf c + sizeOf cs + 1 := by simp_arith
      have : sizeOf cs ≤ sizeOf c + sizeOf cs + 1 := by rw [← this]; apply Nat.le_add_right
      have h₂ : sizeOf cs ≤ sizeOf bs := by simp_arith at h; apply Nat.le_trans this h
      go (f a c h₁) cs h₂

theorem List.foldl_wf_eq [SizeOf β] (bs : List β) (init : α) (f : α → β → α) : bs.foldl_wf init (fun a b _ => f a b) = bs.foldl f init := by
  simp [List.foldl_wf]
  have : (a : α) → (cs : List β) → (h : sizeOf cs ≤ sizeOf bs) → foldl_wf.go bs (fun a b _ => f a b) a cs h = cs.foldl f a := by
    intro a cs h
    induction cs generalizing a with simp [List.foldl_wf.go, List.foldl]
    | cons c cs ih => simp [ih]
  exact this init bs (Nat.le_refl ..)

inductive Expr where
  | app (f : String) (args : List Expr)
  | var (n : String)

-- TODO: `WF.lean` should replace `List.foldl` with `List.foldl_wf`, and then apply `List.foldl_wf_eq` when proving equation theorems.
@[simp] def Expr.numVars : Expr → Nat
  | app f args => args.foldl_wf 0 fun sum arg h =>
    -- TODO: linarith should prove the following proposition
    -- TODO: decreasing_tactic should invoke `linarith`
    have : sizeOf arg < 1 + sizeOf f + sizeOf args := Nat.lt_of_lt_of_le h (Nat.le_add_left ..)
    sum + numVars arg
  | var _ => 1

/-
  TODO: we should have a new attribute for registering theorems such as `List.foldl_wf_eq` and `List.map_foldl_wf_eq`
  Here is the steps missing in the `WF` module.
  1- Replace functions such as `List.foldl` with their `_wf` version. Note that the new hypothesis is unused.
  2- Use the current `WF` implementation. The `decreasing_tactic` must invoke `linarith` to be able to discharge the goals.
  3- When generating equation lemmas, we first prove that the defined function is equal to the RHS containing the `_wf` function,
     and then apply `_wf_eq` simp theorem to simplify.
-/

-- Example for step 3
theorem Expr.numVars_app_eq (f : String) (args : List Expr) : (Expr.app f args).numVars = args.foldl (fun sum arg => sum + arg.numVars) 0 := by
  simp [numVars, List.foldl_wf_eq]

#eval Expr.app "f" [Expr.var "a", Expr.app "g" [Expr.var "b", Expr.var "c"]] |>.numVars

def List.map_wf [SizeOf α] (as : List α) (f : (a : α) → sizeOf a < sizeOf as → β) : List β :=
  go as (Nat.le_refl ..)
where
  go (cs : List α) (h : sizeOf cs ≤ sizeOf as) : List β :=
    match cs with
    | [] => []
    | c :: cs =>
      have : sizeOf c < sizeOf (c :: cs) := by simp_arith
      -- TODO: simplify using linarith
      have h₁ : sizeOf c < sizeOf as := Nat.lt_of_lt_of_le this h
      have : sizeOf cs + (sizeOf c + 1) = sizeOf c + sizeOf cs + 1 := by simp_arith
      have : sizeOf cs ≤ sizeOf c + sizeOf cs + 1 := by rw [← this]; apply Nat.le_add_right
      have h₂ : sizeOf cs ≤ sizeOf as := by simp_arith at h; apply Nat.le_trans this h
      f c h₁ :: go cs h₂

theorem List.map_wf_eq [SizeOf α] (as : List α) (f : α → β) : as.map_wf (fun a _ => f a) = as.map f := by
  simp [List.map_wf]
  have : (cs : List α) → (h : sizeOf cs ≤ sizeOf as) → map_wf.go as (fun a _ => f a) cs h = cs.map f := by
    intro cs h
    induction cs with simp [List.map_wf.go, List.map]
    | cons c cs ih => simp [ih]
  exact this as (Nat.le_refl ..)


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import order.lattice

/-!
# `max` and `min`

This file proves basic properties about maxima and minima on a `linear_order`.

## Tags

min, max
-/

universes u v
variables {α : Type u} {β : Type v}

attribute [simp] max_eq_left max_eq_right min_eq_left min_eq_right

section
variables [linear_order α] [linear_order β] {f : α → β} {s : set α} {a b c d : α}

-- translate from lattices to linear orders (sup → max, inf → min)
@[simp] lemma le_min_iff : c ≤ min a b ↔ c ≤ a ∧ c ≤ b := le_inf_iff
@[simp] lemma le_max_iff : a ≤ max b c ↔ a ≤ b ∨ a ≤ c := le_sup_iff
@[simp] lemma min_le_iff : min a b ≤ c ↔ a ≤ c ∨ b ≤ c := inf_le_iff
@[simp] lemma max_le_iff : max a b ≤ c ↔ a ≤ c ∧ b ≤ c := sup_le_iff
@[simp] lemma lt_min_iff : a < min b c ↔ a < b ∧ a < c := lt_inf_iff
@[simp] lemma lt_max_iff : a < max b c ↔ a < b ∨ a < c := lt_sup_iff
@[simp] lemma min_lt_iff : min a b < c ↔ a < c ∨ b < c := inf_lt_iff
@[simp] lemma max_lt_iff : max a b < c ↔ a < c ∧ b < c := sup_lt_iff
lemma max_le_max : a ≤ c → b ≤ d → max a b ≤ max c d := sup_le_sup
lemma min_le_min : a ≤ c → b ≤ d → min a b ≤ min c d := inf_le_inf
lemma le_max_of_le_left : a ≤ b → a ≤ max b c := le_sup_of_le_left
lemma le_max_of_le_right : a ≤ c → a ≤ max b c := le_sup_of_le_right
lemma lt_max_of_lt_left (h : a < b) : a < max b c := h.trans_le (le_max_left b c)
lemma lt_max_of_lt_right (h : a < c) : a < max b c := h.trans_le (le_max_right b c)
lemma min_le_of_left_le : a ≤ c → min a b ≤ c := inf_le_of_left_le
lemma min_le_of_right_le : b ≤ c → min a b ≤ c := inf_le_of_right_le
lemma min_lt_of_left_lt (h : a < c) : min a b < c := (min_le_left a b).trans_lt h
lemma min_lt_of_right_lt (h : b < c) : min a b < c := (min_le_right a b).trans_lt h
lemma max_min_distrib_left : max a (min b c) = min (max a b) (max a c) := sup_inf_left
lemma max_min_distrib_right : max (min a b) c = min (max a c) (max b c) := sup_inf_right
lemma min_max_distrib_left : min a (max b c) = max (min a b) (min a c) := inf_sup_left
lemma min_max_distrib_right : min (max a b) c = max (min a c) (min b c) := inf_sup_right
lemma min_le_max : min a b ≤ max a b := le_trans (min_le_left a b) (le_max_left a b)

@[simp] lemma min_eq_left_iff : min a b = a ↔ a ≤ b := inf_eq_left
@[simp] lemma min_eq_right_iff : min a b = b ↔ b ≤ a := inf_eq_right
@[simp] lemma max_eq_left_iff : max a b = a ↔ b ≤ a := sup_eq_left
@[simp] lemma max_eq_right_iff : max a b = b ↔ a ≤ b := sup_eq_right

/-- For elements `a` and `b` of a linear order, either `min a b = a` and `a ≤ b`,
    or `min a b = b` and `b < a`.
    Use cases on this lemma to automate linarith in inequalities -/
lemma min_cases (a b : α) : min a b = a ∧ a ≤ b ∨ min a b = b ∧ b < a :=
begin
  by_cases a ≤ b,
  { left,
    exact ⟨min_eq_left h, h⟩ },
  { right,
    exact ⟨min_eq_right (le_of_lt (not_le.mp h)), (not_le.mp h)⟩ }
end

/-- For elements `a` and `b` of a linear order, either `max a b = a` and `b ≤ a`,
    or `max a b = b` and `a < b`.
    Use cases on this lemma to automate linarith in inequalities -/
lemma max_cases (a b : α) : max a b = a ∧ b ≤ a ∨ max a b = b ∧ a < b := @min_cases αᵒᵈ _ a b

lemma min_eq_iff : min a b = c ↔ a = c ∧ a ≤ b ∨ b = c ∧ b ≤ a :=
begin
  split,
  { intro h,
    refine or.imp (λ h', _) (λ h', _) (le_total a b);
    exact ⟨by simpa [h'] using h, h'⟩ },
  { rintro (⟨rfl, h⟩|⟨rfl, h⟩);
    simp [h] }
end

lemma max_eq_iff : max a b = c ↔ a = c ∧ b ≤ a ∨ b = c ∧ a ≤ b := @min_eq_iff αᵒᵈ _ a b c

lemma min_lt_min_left_iff : min a c < min b c ↔ a < b ∧ a < c :=
by { simp_rw [lt_min_iff, min_lt_iff, or_iff_left (lt_irrefl _)],
  exact and_congr_left (λ h, or_iff_left_of_imp h.trans) }

lemma min_lt_min_right_iff : min a b < min a c ↔ b < c ∧ b < a :=
by simp_rw [min_comm a, min_lt_min_left_iff]

lemma max_lt_max_left_iff : max a c < max b c ↔ a < b ∧ c < b := @min_lt_min_left_iff αᵒᵈ _ _ _ _
lemma max_lt_max_right_iff : max a b < max a c ↔ b < c ∧ a < c := @min_lt_min_right_iff αᵒᵈ _ _ _ _

/-- An instance asserting that `max a a = a` -/
instance max_idem : is_idempotent α max := by apply_instance -- short-circuit type class inference

/-- An instance asserting that `min a a = a` -/
instance min_idem : is_idempotent α min := by apply_instance -- short-circuit type class inference

lemma min_lt_max : min a b < max a b ↔ a ≠ b := inf_lt_sup

lemma max_lt_max (h₁ : a < c) (h₂ : b < d) : max a b < max c d :=
by simp [lt_max_iff, max_lt_iff, *]

lemma min_lt_min (h₁ : a < c) (h₂ : b < d) : min a b < min c d := @max_lt_max αᵒᵈ _ _ _ _ _ h₁ h₂

theorem min_right_comm (a b c : α) : min (min a b) c = min (min a c) b :=
right_comm min min_comm min_assoc a b c

theorem max.left_comm (a b c : α) : max a (max b c) = max b (max a c) :=
left_comm max max_comm max_assoc a b c

theorem max.right_comm (a b c : α) : max (max a b) c = max (max a c) b :=
right_comm max max_comm max_assoc a b c

lemma monotone_on.map_max (hf : monotone_on f s) (ha : a ∈ s) (hb : b ∈ s) :
  f (max a b) = max (f a) (f b) :=
by cases le_total a b; simp only [max_eq_right, max_eq_left, hf ha hb, hf hb ha, h]

lemma monotone_on.map_min (hf : monotone_on f s) (ha : a ∈ s) (hb : b ∈ s) :
  f (min a b) = min (f a) (f b) :=
hf.dual.map_max ha hb

lemma antitone_on.map_max (hf : antitone_on f s) (ha : a ∈ s) (hb : b ∈ s) :
  f (max a b) = min (f a) (f b) :=
hf.dual_right.map_max ha hb

lemma antitone_on.map_min (hf : antitone_on f s) (ha : a ∈ s) (hb : b ∈ s) :
  f (min a b) = max (f a) (f b) :=
hf.dual.map_max ha hb

lemma monotone.map_max (hf : monotone f) : f (max a b) = max (f a) (f b) :=
by cases le_total a b; simp [h, hf h]

lemma monotone.map_min (hf : monotone f) : f (min a b) = min (f a) (f b) :=
hf.dual.map_max

lemma antitone.map_max (hf : antitone f) : f (max a b) = min (f a) (f b) :=
by cases le_total a b; simp [h, hf h]

lemma antitone.map_min (hf : antitone f) : f (min a b) = max (f a) (f b) :=
hf.dual.map_max

lemma min_rec {p : α → Prop} {x y : α} (hx : x ≤ y → p x) (hy : y ≤ x → p y) : p (min x y) :=
(le_total x y).rec (λ h, (min_eq_left h).symm.subst (hx h))
  (λ h, (min_eq_right h).symm.subst (hy h))

lemma max_rec {p : α → Prop} {x y : α} (hx : y ≤ x → p x) (hy : x ≤ y → p y) : p (max x y) :=
@min_rec αᵒᵈ _ _ _ _ hx hy

lemma min_rec' (p : α → Prop) {x y : α} (hx : p x) (hy : p y) : p (min x y) :=
min_rec (λ _, hx) (λ _, hy)

lemma max_rec' (p : α → Prop) {x y : α} (hx : p x) (hy : p y) : p (max x y) :=
max_rec (λ _, hx) (λ _, hy)

theorem min_choice (a b : α) : min a b = a ∨ min a b = b :=
by cases le_total a b; simp *

theorem max_choice (a b : α) : max a b = a ∨ max a b = b :=
@min_choice αᵒᵈ _ a b

lemma le_of_max_le_left {a b c : α} (h : max a b ≤ c) : a ≤ c :=
le_trans (le_max_left _ _) h

lemma le_of_max_le_right {a b c : α} (h : max a b ≤ c) : b ≤ c :=
le_trans (le_max_right _ _) h

lemma max_commutative : commutative (max : α → α → α) :=
max_comm

lemma max_associative : associative (max : α → α → α) :=
max_assoc

lemma max_left_commutative : left_commutative (max : α → α → α) :=
max_left_comm

lemma min_commutative : commutative (min : α → α → α) :=
min_comm

lemma min_associative : associative (min : α → α → α) :=
min_assoc

lemma min_left_commutative : left_commutative (min : α → α → α) :=
min_left_comm

end


-- Interseccion_con_su_union.lean
-- Intersección con su unión
-- José A. Alonso Jiménez
-- Sevilla, 26 de abril de 2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    s ∩ (s ∪ t) = s
-- ----------------------------------------------------------------------

import data.set.basic
import tactic
open set

variable {α : Type}
variables s t : set α

-- 1ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext x,
  split,
  { intros h,
    dsimp at h,
    exact h.1, },
  { intro xs,
    dsimp,
    split,
    { exact xs, },
    { left,
      exact xs, }},
end

-- 2ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext x,
  split,
  { intros h,
    exact h.1, },
  { intro xs,
    split,
    { exact xs, },
    { left,
      exact xs, }},
end

-- 3ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext x,
  split,
  { intros h,
    exact h.1, },
  { intro xs,
    split,
    { exact xs, },
    { exact (or.inl xs), }},
end

-- 4ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext,
  exact ⟨λ h, h.1,
         λ xs, ⟨xs, or.inl xs⟩⟩,
end

-- 5ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext,
  exact ⟨and.left,
         λ xs, ⟨xs, or.inl xs⟩⟩,
end

-- 6ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext x,
  split,
  { rintros ⟨xs, _⟩,
    exact xs },
  { intro xs,
    use xs,
    left,
    exact xs },
end

-- 7ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  apply subset_antisymm,
  { rintros x ⟨hxs,-⟩,
    exact hxs, },
  { intros x hxs,
    exact ⟨hxs, or.inl hxs⟩, },
end

-- 8ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
-- by suggest
inf_sup_self

-- 9ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
-- by hint
by finish


import data.finset
import data.fintype.basic
import data.set.finite
import tactic.derive_fintype

section intro

variable {α : Type*}
-- Конечность типа или множества представлена в mathlib тремя основными типами: `A : finset α`, `fintype A` и `finite A`

-- 1. finset - конструктивно конечное множество
-- `finset` = `multiset` + `nodup`
-- `multiset` = классы эквивалентности `list` по отношению "a - перестановка b"
-- Для того, чтобы применять большинство операций (добавление/объединение/...), нужен инстанс `decidable_eq α`: нужно уметь разрешимо сравнивать элементы (чтобы, например, знать `card`)

variable (A : finset α)

#check A.card
#reduce ({0,1,2,3} : finset ℕ).card
#check @finset.card_insert_of_mem

-- 2. fintype α - класс, говорящий о том, что α - конечный тип
-- fintype α = (elems [] : finset α) (complete : ∀ x : α, x ∈ elems)
-- Можно использовать @[derive fintype], для новосозданных `inductive`
-- https://github.com/leanprover-community/mathlib/pull/3772

variable [fintype α]

example : fintype bool := by show_term {apply_instance}
example : fintype (fin 10) := by show_term {apply_instance}

#check @finset.univ

@[derive fintype]
inductive test (α : Type) [fintype α] : Type
| c1 : bool → test
| c2 : (fin 2) → (fin 3) → test
| c3 : α × α → test

-- 3. finite B - доказательство конечности множества B
-- def finite (s : set α) : Prop := nonempty (fintype s)
-- `nonempty (fintype s)` - Prop-версия того, что существует элемент типа `fintype s`
-- `fintype s` - то же самое, что `fintype {x : α // x ∈ s}` или `fintype (subtype s)` - подтип `α` состоящий из пар `⟨x, h : x ∈ s⟩`
-- Удобно использовать тогда, когда в API `finset` нет того, что хочется делать с множествами, а в `set` есть

open set

variables (β : Type) (B : set β) (hB : finite B)

#check @finite.of_fintype
end intro

-- Докажем несколько лемм про `finset`
namespace finset

variables {α : Type} {A B : finset α} [decidable_eq α]

lemma card_erase_of_mem' {x} (h : x ∈ A) : (A.erase x).card + 1 = A.card :=
begin
  sorry,
end

end finset


/-
Copyright (c) 2023 Mark Andrew Gerads. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mark Andrew Gerads, Junyan Xu, Eric Wieser

! This file was ported from Lean 3 source module data.nat.hyperoperation
! leanprover-community/mathlib commit fac369018417f980cec5fcdafc766a69f88d8cfe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Ring
import Mathbin.Data.Nat.Parity

/-!
# Hyperoperation sequence

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines the Hyperoperation sequence.
`hyperoperation 0 m k = k + 1`
`hyperoperation 1 m k = m + k`
`hyperoperation 2 m k = m * k`
`hyperoperation 3 m k = m ^ k`
`hyperoperation (n + 3) m 0 = 1`
`hyperoperation (n + 1) m (k + 1) = hyperoperation n m (hyperoperation (n + 1) m k)`

## References

* <https://en.wikipedia.org/wiki/Hyperoperation>

## Tags

hyperoperation
-/

#print hyperoperation /-
/-- Implementation of the hyperoperation sequence
where `hyperoperation n m k` is the `n`th hyperoperation between `m` and `k`.
-/
def hyperoperation : ℕ → ℕ → ℕ → ℕ
  | 0, _, k => k + 1
  | 1, m, 0 => m
  | 2, _, 0 => 0
  | n + 3, _, 0 => 1
  | n + 1, m, k + 1 => hyperoperation n m (hyperoperation (n + 1) m k)
#align hyperoperation hyperoperation
-/

#print hyperoperation_zero /-
-- Basic hyperoperation lemmas
@[simp]
theorem hyperoperation_zero (m : ℕ) : hyperoperation 0 m = Nat.succ :=
  funext fun k => by rw [hyperoperation, Nat.succ_eq_add_one]
#align hyperoperation_zero hyperoperation_zero
-/

#print hyperoperation_ge_three_eq_one /-
theorem hyperoperation_ge_three_eq_one (n m : ℕ) : hyperoperation (n + 3) m 0 = 1 := by
  rw [hyperoperation]
#align hyperoperation_ge_three_eq_one hyperoperation_ge_three_eq_one
-/

#print hyperoperation_recursion /-
theorem hyperoperation_recursion (n m k : ℕ) :
    hyperoperation (n + 1) m (k + 1) = hyperoperation n m (hyperoperation (n + 1) m k) := by
  obtain _ | _ | _ := n <;> rw [hyperoperation]
#align hyperoperation_recursion hyperoperation_recursion
-/

#print hyperoperation_one /-
-- Interesting hyperoperation lemmas
@[simp]
theorem hyperoperation_one : hyperoperation 1 = (· + ·) :=
  by
  ext (m k)
  induction' k with bn bih
  · rw [Nat.add_zero m, hyperoperation]
  · rw [hyperoperation_recursion, bih, hyperoperation_zero]
    exact Nat.add_assoc m bn 1
#align hyperoperation_one hyperoperation_one
-/

#print hyperoperation_two /-
@[simp]
theorem hyperoperation_two : hyperoperation 2 = (· * ·) :=
  by
  ext (m k)
  induction' k with bn bih
  · rw [hyperoperation]
    exact (Nat.mul_zero m).symm
  · rw [hyperoperation_recursion, hyperoperation_one, bih]
    ring
#align hyperoperation_two hyperoperation_two
-/

#print hyperoperation_three /-
@[simp]
theorem hyperoperation_three : hyperoperation 3 = (· ^ ·) :=
  by
  ext (m k)
  induction' k with bn bih
  · rw [hyperoperation_ge_three_eq_one]
    exact (pow_zero m).symm
  · rw [hyperoperation_recursion, hyperoperation_two, bih]
    exact (pow_succ m bn).symm
#align hyperoperation_three hyperoperation_three
-/

#print hyperoperation_ge_two_eq_self /-
theorem hyperoperation_ge_two_eq_self (n m : ℕ) : hyperoperation (n + 2) m 1 = m :=
  by
  induction' n with nn nih
  · rw [hyperoperation_two]
    ring
  · rw [hyperoperation_recursion, hyperoperation_ge_three_eq_one, nih]
#align hyperoperation_ge_two_eq_self hyperoperation_ge_two_eq_self
-/

#print hyperoperation_two_two_eq_four /-
theorem hyperoperation_two_two_eq_four (n : ℕ) : hyperoperation (n + 1) 2 2 = 4 :=
  by
  induction' n with nn nih
  · rw [hyperoperation_one]
  · rw [hyperoperation_recursion, hyperoperation_ge_two_eq_self, nih]
#align hyperoperation_two_two_eq_four hyperoperation_two_two_eq_four
-/

#print hyperoperation_ge_three_one /-
theorem hyperoperation_ge_three_one (n : ℕ) : ∀ k : ℕ, hyperoperation (n + 3) 1 k = 1 :=
  by
  induction' n with nn nih
  · intro k
    rw [hyperoperation_three, one_pow]
  · intro k
    cases k
    · rw [hyperoperation_ge_three_eq_one]
    · rw [hyperoperation_recursion, nih]
#align hyperoperation_ge_three_one hyperoperation_ge_three_one
-/

/- warning: hyperoperation_ge_four_zero -> hyperoperation_ge_four_zero is a dubious translation:
lean 3 declaration is
  forall (n : Nat) (k : Nat), Eq.{1} Nat (hyperoperation (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 4 (OfNat.mk.{0} Nat 4 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) k) (ite.{1} Nat (Even.{0} Nat Nat.hasAdd k) (Nat.Even.decidablePred k) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))
but is expected to have type
  forall (n : Nat) (k : Nat), Eq.{1} Nat (hyperoperation (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 4 (instOfNatNat 4))) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) k) (ite.{1} Nat (Even.{0} Nat instAddNat k) (Nat.instDecidablePredNatEvenInstAddNat k) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))
Case conversion may be inaccurate. Consider using '#align hyperoperation_ge_four_zero hyperoperation_ge_four_zeroₓ'. -/
theorem hyperoperation_ge_four_zero (n k : ℕ) :
    hyperoperation (n + 4) 0 k = if Even k then 1 else 0 :=
  by
  induction' k with kk kih
  · rw [hyperoperation_ge_three_eq_one]
    simp only [even_zero, if_true]
  · rw [hyperoperation_recursion]
    rw [kih]
    simp_rw [Nat.even_add_one]
    split_ifs
    · exact hyperoperation_ge_two_eq_self (n + 1) 0
    · exact hyperoperation_ge_three_eq_one n 0
#align hyperoperation_ge_four_zero hyperoperation_ge_four_zero


import tactic.ring
import data.real.basic

example (x y : ℕ) : x + y = y + x := by ring
example (x y : ℕ) : x + y + y = 2 * y + x := by ring
example (x y : ℕ) : x + id y = y + id x := by ring!
example {α} [comm_ring α] (x y : α) : x + y + y - x = 2 * y := by ring
example (x y : ℚ) : x / 2 + x / 2 = x := by ring
example (x y : ℚ) : (x + y) ^ 3 = x ^ 3 + y ^ 3 + 3 * (x * y ^ 2 + x ^ 2 * y) := by ring
example (x y : ℝ) : (x + y) ^ 3 = x ^ 3 + y ^ 3 + 3 * (x * y ^ 2 + x ^ 2 * y) := by ring
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 6 = (1 + x) ^ 6 := by try_for 15000 {ring}
example (n : ℕ) : (n / 2) + (n / 2) = 2 * (n / 2) := by ring
example {α} [field α] [char_zero α] (a : α) : a / 2 = a / 2 := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  a * (-c / b) * (-c / b) + -c + c = a * (c / b * (c / b)) := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  b ^ 2 - 4 * c * a = -(4 * c * a) + b ^ 2 := by ring
example (x : ℚ) : x ^ (2 + 2) = x^4 := by ring_nf -- TODO: ring should work?
example {α} [comm_ring α] (x : α) : x ^ 2 = x * x := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  b ^ 2 - 4 * c * a = -(4 * c * a) + b ^ 2 := by ring
example {α} [linear_ordered_field α] (a b c : α) :
  b ^ 2 - 4 * a * c = 4 * a * 0 + b * b - 4 * a * c := by ring
example {α} [comm_semiring α] (x y z : α) (n : ℕ) :
  (x + y) * (z * (y * y) + (x * x ^ n + (1 + ↑n) * x ^ n * y)) =
    x * (x * x ^ n) + ((2 + ↑n) * (x * x ^ n) * y + (x * z + (z * y + (1 + ↑n) * x ^ n)) * (y * y)) := by ring
example {α} [comm_ring α] (a b c d e : α) :
  (-(a * b) + c + d) * e = (c + (d + -a * b)) * e := by ring
example (a n s: ℕ) : a * (n - s) = (n - s) * a := by ring

example (x y z : ℚ) (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
  x / (y / z) + y ⁻¹ + 1 / (y * -x) = -1/ (x * y) + (x * z + 1) / y :=
begin
  field_simp,
  ring
end

example (a b c d x y : ℚ) (hx : x ≠ 0) (hy : y ≠ 0) :
  a + b / x - c / x^2 + d / x^3 = a + x⁻¹ * (y * b / y + (d / x - c) / x) :=
begin
  field_simp,
  ring
end

example : (876544 : ℤ) * -1 + (1000000 - 123456) = 0 := by ring

example (x y : ℝ) (hx : x ≠ 0) (hy : y ≠ 0) :
  2 * x ^ 3 * 2 / (24 * x) = x ^ 2 / 6 :=
begin
  field_simp,
  ring
end

-- this proof style is not recommended practice
example (A B : ℕ) (H : B * A = 2) : A * B = 2 := by {ring_nf, exact H}