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

end Mathlib


import tidy.tidy
import tactic.ring

import .number
import .binary_op
import .order
import .facts

--define pairs and the rational equality law

structure pair := mk ::
  ( x y : ℤ )
  ( non_zero : y ≠ 0)

def q_law : pair → pair → Prop := λ a b : pair, a.1 * b.2 = b.1 * a.2

theorem q_refl : ∀ ( a : pair ), q_law a a
    := by unfold q_law; intro a; refl
theorem q_symm : ∀ ( a b : pair ), q_law a b → q_law b a
    := by unfold q_law; intros a b; tidy
theorem q_trans : ∀ (a b c : pair), (q_law a b) → (q_law b c) → (q_law a c) := begin
    intros a b c,
    unfold q_law,
    intros h1 h2,
    have hr : b.2 * (c.1 * a.2) = b.2 * (a.1 * c.2), from calc
        b.2 * (c.1 * a.2) = a.2 * (c.1 * b.2) : by ring
                    ... = a.2 * (b.1 * c.2) : by rw h2
                    ... = (b.1 * a.2) * c.2 : by ring
                    ... = (a.1 * b.2) * c.2 : by rw h1
                    ... = b.2 * (a.1 * c.2) : by ring,
    exact eq.symm (cancellation_law b.non_zero hr),
end

instance pair_setoid := setoid.mk q_law (mk_equivalence q_law q_refl q_symm q_trans)

def pair_add : bop pair
    := λ a b : pair, pair.mk (a.1 * b.2 + b.1 * a.2) (a.2 * b.2)
        (nonzero_mul a.non_zero b.non_zero)

def pair_mul : bop pair
    := λ a b : pair, pair.mk (a.1 * b.1) (a.2 * b.2)
        (nonzero_mul a.non_zero b.non_zero)

--proving well-definedness, and then commutativity

lemma pair_add_assoc : bop_rel_assoc q_law pair_add
    := by intros a b c; unfold q_law; unfold pair_add; simp; ring
lemma pair_mul_assoc : bop_rel_assoc q_law pair_mul
    := by intros a b c; unfold q_law; unfold pair_mul; simp; ring

lemma pair_add_comm : bop_rel_comm q_law pair_add
    := by intros a b; unfold q_law; unfold pair_add; simp; ring
lemma pair_mul_comm : bop_rel_comm q_law pair_mul
    := by intros a b; unfold q_law; unfold pair_mul; simp; ring

lemma pair_add_invar_first : bop_rel_invar_first q_law pair_add :=
begin
   intros a b c h,
   unfold q_law,
--FIXME these three lines are need because obviously is really slow without
   unfold pair_add,
   simp,
   ring,
   have hh : a.x * b.y = b.x * a.y, by apply h,
   obviously,
end

lemma pair_mul_invar_first : bop_rel_invar_first q_law pair_mul :=
begin
   intros a b c h,
   unfold q_law,
   have hh : a.x * b.y = b.x * a.y, by apply h,
   obviously,
end

lemma pair_add_invar : bop_rel_invar q_law pair_add
:= bop_comm_easy_invar pair_add_comm pair_add_invar_first
lemma pair_mul_invar : bop_rel_invar q_law pair_mul
:= bop_comm_easy_invar pair_mul_comm pair_mul_invar_first

def pair_add_l := liftable_bop.mk pair_setoid pair_add pair_add_invar
def pair_mul_l := liftable_bop.mk pair_setoid pair_mul pair_mul_invar

-- lift the above construction to give the rationals

def ℚℚ := quotient pair_setoid
def ℚℚ.mk (p : pair) : ℚℚ := quot.mk q_law p
def ℚℚ.divide (a b : ℤ) (h : b ≠ 0) : ℚℚ := ℚℚ.mk (pair.mk a b h)
def ℚℚ.from_int (n : ℤ) : ℚℚ := ℚℚ.mk (pair.mk n 1 one_ne_zero)

def rat_add : bop ℚℚ := lift_bop pair_add_l
def rat_mul : bop ℚℚ := lift_bop pair_mul_l

-- addition and multiplication are associative and commutative

theorem rat_add_assoc : bop_assoc rat_add
    := lift_assoc pair_add_l pair_add_assoc
theorem rat_add_comm : bop_comm rat_add
    := lift_comm pair_add_l pair_add_comm

theorem rat_mul_assoc : bop_assoc rat_mul
    := lift_assoc pair_mul_l pair_mul_assoc
theorem rat_mul_comm : bop_comm rat_mul
    := lift_comm pair_mul_l pair_mul_comm

--example of the equivalence of the general construction above to the ``direct way''

def pair_add_rat_direct : pair → pair → ℚℚ
:= λ a b : pair, (ℚℚ.mk (pair_add a b))
example : ∀ a b : pair, pair_add_rat_direct a b = (induced_quobop pair_setoid pair_add) a b := by tidy

--order

def rat_leq_rel (a b : ℚℚ) : Prop := (quot.out a).1 * (quot.out b).2 ≤ (quot.out b).1 * (quot.out a).2

lemma rat_req_refl : ∀ a : ℚℚ, rat_leq_rel a a := by unfold rat_leq_rel; tidy
lemma rat_req_antisymm : ∀ a b : ℚℚ, rat_leq_rel a b → rat_leq_rel b a → a = b :=
begin
    intros a b h1 h2,
    have hm : (quot.out b).x * (quot.out a).y = (quot.out a).x * (quot.out b).y,
        unfold rat_leq_rel at *,
        apply eq.symm (leq_fact h1 h2),
    clear h1 h2,
    have hn : ℚℚ.mk (quot.out a) = ℚℚ.mk (quot.out b),
        have hl : q_law (quot.out a) (quot.out b),
            unfold q_law,
            apply eq.symm hm,
        apply (@quotient_fact pair pair_setoid (quot.out a) (quot.out b)),
        exact hl,
    transitivity,
    apply eq.symm (quotient.out_eq a),
    transitivity,
    apply hn,
    apply quotient.out_eq,
end

#check quotient pair_setoid
#check @quotient.out_eq pair pair_setoid

lemma rat_req_trans : ∀ a b c : ℚℚ, rat_leq_rel a b → rat_leq_rel b c → rat_leq_rel a c :=
begin
    intros a b c h1 h2,
    unfold rat_leq_rel at *,
    admit
end

#check rat_leq_rel

-- Scott: Why is this definition of rat_leq okay? Even though it secretly is, it
-- may not even be well-defined in the sense which I intend. I suppose the
-- ``constructive'' interpretation is that there is some distinguished function
-- quot.out : ℚℚ → pair which can reliably give the same element for each
-- equivalence class. This is still very strange to me! Am I really just
-- thinking that the Axiom of Choice is strange?


import logic.basic --hide

/-
## Exact

Sometimes after rewriting the hypotheses and goal enough we reach a point where the goal is
exactly the same as one of the hypothesis.
In this case we want to tell Lean that we are finished, one of our hypotheses now matches
the conclusion we needed to get to.

The tactic to do this is called `exact`, and to use it we just need to supply the name of
the hypothesis we want to use.

For example if we were trying to prove that 3 divides some natural number `n` and we
ended up with the goal state:
```
n : ℕ
h : 3 ∣ n
⊢ 3 ∣ n
```
then `exact h,` would complete the proof.

-/

/- 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$).

-/

/- Axiom :
or_and_distrib_right : ∀ {a b c : Prop}, (a ∨ b) ∧ c ↔ a ∧ c ∨ b ∧ c
-/

/- Axiom :
not_and_self (a : Prop) : (¬a ∧ a) ↔ false
-/

/- Axiom :
or_false (a : Prop) : (a ∨ false) ↔ a
-/

/- Axiom :
and_comm : ∀ (a b : Prop), a ∧ b ↔ b ∧ a
-/

/- Axiom :
and_assoc : ∀ {c : Prop} (a b : Prop), (a ∧ b) ∧ c ↔ a ∧ b ∧ c
-/

/- Axiom :
and_self : ∀ (a : Prop), a ∧ a ↔ a
-/

/- Lemma : no-side-bar
-/
lemma prop_prop (P Q : Prop) (h : Q ∧ P ∧ Q) :
  (P ∨ ¬ Q) ∧ Q :=
begin
  rw or_and_distrib_right,
  rw not_and_self,
  rw or_false,
  rw and_comm at h,
  rw and_assoc at h,
  rw and_self at h,
  exact h,
end


/-
ATTENTION: This file got long and is now obsolete.
Please see it broken into individual sections in the
Inference_Rules directory. We'll leave the original
content in place below for reference in case you need
to look back.
-/

/-
As a reminder, here are the inference rules (and a few
"logical fallacies" that you tested for validity in the
setting of propositional logic, where the variables are
all Boolean, and where logical connectives correspond to
Boolean operations, such as &&, ||, and ! (C, C++, etc.)

1. X ∨ Y, X ⊢ ¬Y             -- affirming the disjunct
2. X, Y ⊢ X ∧ Y              -- and introduction
3. X ∧ Y ⊢ X                 -- and elimination left
4. X ∧ Y ⊢ Y                 -- and elimination right
5. ¬¬X ⊢ X                   -- negation elimination
6. ¬(X ∧ ¬X)                 -- no contradiction
7. X ⊢ X ∨ Y                 -- or introduction left
8. Y ⊢ X ∨ Y                 -- or introduction right
9. X → Y, ¬X ⊢ ¬ Y           -- denying the antecedent
10. X → Y, Y → X ⊢ X ↔ Y      -- iff introduction
11. X ↔ Y ⊢ X → Y            -- iff elimination left
12. X ↔ Y ⊢ Y → X            -- iff elimination right
13. X ∨ Y, X → Z, Y → Z ⊢ Z  -- or elimination
14. X → Y, Y ⊢ X             -- affirming the conclusion
15. X → Y, X ⊢ Y             -- arrow elimination
16. X → Y, Y → Z ⊢ X → Z     -- transitivity of →
17. X → Y ⊢ Y → X            -- converse
18. X → Y ⊢ ¬Y → ¬X          -- contrapositive
19. ¬(X ∨ Y) ↔ ¬X ∧ ¬Y       -- DeMorgan #1 (¬ distributes over ∨)
20. ¬(X ∧ Y) ↔ ¬X ∨ ¬Y       -- Demorgan #2 (¬ distributes over ∧)
-/

/-
Here we present the familiar inference rules above but
now in the context of the more expressive, higher-order
predicate logic of the Lean Prover tool. A big benefit
is that "Lean" checks the syntax of our expressions.

Note that we've reordered the inference rules you've already
seen, putting all of the inference rules related to any given
connective or quantifier together.

We've also added inference rules for the quantifiers, ∀ and
∃, which of course are not relevant in propositional logic
but that are essential in predicate logic (whether first- or
higher-order).

We've also separate out, and present first, the fundamental
inference rules from "inference rules" that are can be proved
using the fundamental rules. These rules are thus "theorems,"
not "axioms."
-/

/-
Ok. So each of the following lines does the following. As you
read this, look at the first definition, of and_introduction.

In Lean, we can use "def," a Lean keywork, to start to define
the meaning/value of a variable. After "def" comes the name of
the variable. Here it's and_introduction. Next comes what we
have already seen, albeit briefly: a type judgment, comprising
a colon followed by a type name. The type name in this case is
"Prop," which is the type of all *propositions* in Lean. So far
then we've told Lean that we're going to define and_introduction
to be a variable the value of which is a proposition. Next is
a :=, which is the Lean operator for binding a value to a name.
Finally, the value to be bound is to the right. In this case,
as expected, it's a proposition.

The particular proposition in this case is what we can call a
"universal generalization" in that it starts with a ∀. The ∀
introduces two new variable names, X and Y, with a type judgment
stating that their values are propositions, indeed they can be
*any* propositions whatsoever. Finally, in the context of the
assumption that X and Y are arbitrary (any) proposition, the
rule states that if we assume that we are given a proof of X
(the analog of the assumption that X is true in propositional
or first-order predicate logic), and if in that context we then
further assume that we have a proof of Y (and thus that Y is
also true), then in that context, we can construct a proof of
X ∧ Y, thus concluding that it, too, must be true.
-/

/- *** AND *** -/

-- ∧
def and_introduction  : Prop  := ∀ (X Y : Prop), X → Y → (X ∧ Y)
def and_elim_left     : Prop  := ∀ (X Y : Prop), X ∧ Y → X
def and_elim_right    : Prop  := ∀ (X Y : Prop), X ∧ Y → Y

/-
Note that we are able to express these rules of logic very
naturally in higher-order constructive logic because we can
quantify over propositions. You cannot write these definitions
in first-order logic because it doesn't allow you to do this.
Such an expression is a syntax error in first-order logic.
-/

/- A LEAN DETAIL and IMPORTANT LANGUAGE DESIGN CONCEPT
A good language gives you good ways not to repeat yourself.
We can avoid having to repeatedly write "∀ (X Y : Prop),"
by creating a "section" in a Lean file, and declaring the
common variables once at the top. Lean then implicitly adds
a "∀ (X : Prop)" at the beginning of any expression that has
an X in it (and the same goes for Y and Z in this file).
I
-/

section pred_logic

variables X Y Z : Prop

/-
In your mind, be sure to recognize that every one of the
following propositions now has an implicit ∀ in front. The
or_intro_left definition that comes next, for example, means
def or_intro_left : Prop := ∀ (X Y : Prop), X → X ∨ Y.
-/

/- *** OR *** -/

-- ∨
def or_intro_left : Prop    := X → X ∨ Y
def or_intro_right : Prop   := Y → X ∨ Y
def or_elim : Prop          := (X ∨ Y) → (X → Z) → (Y → Z) → Z

/-
Lean, and other languages like it, also allow you to drop
explicit type judgments when they can be inferred from the
context. In the rest of this file, we also drop the ": Prop"
explicit type judgments because Lean can figure our from the
values that follow the :='s that type types of the variables
here just have to be Prop.
-/

/-
Quiz questions.

Suppose you know that (X → Z) and (Y → Z) are true and you
want to prove Z. To be able to prove Z it will *suffice* to
prove ______; for then you will need only to apply the ______
rule to deduce that Z is true.

Suppose you know that (X → Z), (Y → Z), and Z are all true.
Is it necessarily that case that (X ∨ Y) is also true? Defend
you answer.

Suppose it's raining OR the sprinkler is running, and that in
either case the grass is wet. Is the grass wet? How would you
prove it?
-/

/- *** IFF *** -/

-- ↔
def iff_intro         := (X → Y) → (Y → X) → X ↔ Y

/-
You can read this rule both forward (left to right) and
backwards. Reading forwards, it says that if you have a
proof (or know the truth) of X → Y, and you have a proof
(or know the truth) of Y → X, then you can derive of a proof
(deduce the truth) of X ↔ Y.

The more important direction in practice is to read it
from right to left. What it says in this reading is that
if you want to prove X ↔ Y, then it will suffice to have
two "smaller" proofs: one of X → Y and one of Y → X.

From now on, whenever you're asked to prove equivalence
of two propositions, X and Y, you'll thus start by saying,
"It will suffice to prove the implication in each direction."
Then you end up with two smaller goals to prove, one in
each direction. So, "We first consider X → Y." Then give
a proof of it. Then, "Next we consider Y → X." Then give
a proof of it. And finally, "Having proven the implication
in each direction (by application of the rule of ↔ intro)
we've completed our proof. QED."
-/

def iff_elim_left     := X ↔ Y → (X → Y)
def iff_elim_right    := X ↔ Y → (Y → X)

/-
The elimination rules are also easy. Given X ↔ Y, you can
immediately deduce X → Y and Y → X.
-/

/- *** FORALL and ARROW *** -/

-- → and ∀
def arrow_all_equiv   := (∀ (x : X), Y) ↔ (X → Y)

/-
To prove either (∀ (x : X), Y) or (X → Y), you first assume
that you're given an arbitrary but specific proof of X, and
in that context, you show that you can derive a proof (thus
deducing the truth) of Y. It's exactly the same reasoning in
each case. This is the *introduction* rule for ∀ and →.
-/

/-
In fact, in constructive logic, X → Y is simply a notation
*defined* as ∀ (x : X), Y. What each of these propositions
states in constructive logic is that "From *any* proof, x,
of X, we can derive a proof of Y." In fact, in Lean, these
propositions are not only equivalent but equal.
-/

#check X → Y          -- Lean confirms this is a proposition
#check ∀ (x : X), Y   -- Lean understands this to say X → Y!

/- OPTIONAL
As an aside, here's a proof that these propositions are
actually equal. This proof uses an inference rule, rfl, for
equality that we've not yet studied. Don't worry about the
"rfl" for now, but trust that we're giving a correct proof
of the equality of these two propositions in Lean
-/
theorem all_imp_equal : (∀ (x : X), Y) = (X → Y) := rfl

/-
The reason it's super-helpful to know these propositions
are equivalent is that it tells you that you can *use* a
proof of a ∀ proposition or of a → proposition in exactly
the same way. So let's turn to the *elimination* rules for
→ and ∀.
-/

def arrow_elim        := (X → Y)        → X   → Y
def all_elim          := (∀ (x : X), Y) → X   → Y

/-
The idea underlying these rules date to ancient times.
They both say "if from the truth or a proof of X you
can derive a proof or the truth of Y, and if you also
have a proof, or know the truth, of X, then you can (in
constructive logic) derive a proof of Y (or deduce the
truth of Y."

Here's an example. What we want to say in logic is
that if every ball is blue and b is some specific
ball then b is blue. The elimination rule for ∀ and
→ applies a generalization to a specific instance to
deduce that the generalized statement specialized to
a particular instance is true.

Note: In this example, Y is a proposition obtained by
plugging "x" into a one-argument predicate. So suppose
(∀ (x : X), Y) is read as "for any Ball x, x is blue."
Here X is "Ball;" x is an arbitrary but specific Ball;
and Y is read as "x is blue."

Now suppose that, in this context, you're given a
*particular* ball, (b : X). What the overall rules
says is that you now conclude that "b is blue."

The elimination rule works by *applying* a proof of
a universal generalization (showing that something
is true of *every* object of a particular kind) to
a *specific* object of that kind, to deduce that the
generalized statement is also true of that specific
object.

If every ball is blue, and if b is a ball, then b
must be blue. Another way to say it that makes a
bit more sense for the (X → Y) notation is that
"if being any ball, x, implies that x is blue, and
if b is some particular ball, then b is blue.
-/

/-
As an example, consider a predicate, (isBlue _), where you can fill
in the blank/argument with any Ball-type object. If b is a specific
Ball-type object, then (isBlue b) is a proposition, representing the
English-language claim that b is blue. Here's how we represent this
predicate in Lean.
-/

variable Ball : Type            -- Ball is a type of object
variable isBlue : Ball → Prop
/-
First we Ball to be the name of a type of object (like int or
bool). Then we define isBlue to be a construct (think function!)
that when given any object of type Ball as an argument yields a
proposition. To see how this works, suppose we have some specific
balls, b1 and b2.
-/
variables (b1 b2 : Ball)
/-
Now let's use isBlue to make some propositions!
-/
#check isBlue                               -- a predicate
#check isBlue b1                            -- a proposition about b1
#check isBlue b2                            -- a proposition about b2
#check (∀ (x : Ball), isBlue x)             -- generalization
variable all_balls_blue : (∀ (x : Ball), isBlue x)   -- proof of it
#check all_balls_blue b1                    -- proof b1 is blue
#check all_balls_blue b2                    -- proof b2 is blue

/-
Here's an English-language version.

Suppose b1 and b2 are objects of some type, Ball, and that isBlue
is one-place predicate taking any Ball, b, as an argument, and that
reduces to a proposition, denoted (isBlue b), that we understand as
asserting that the particular ball, b, is blue. Next (295), we take
all_balls_blue as a proof that all balls are blue. Finally (296 and
297), we see that we can can use this proof/truth by *applying* it
to any particular ball, b, to obtain a proof/truth that b is blue.

For any type S, given any X: (∀ s : S), T and any s : S, the ∀
and → elimination rule(s) say that you can derive a value/proof of
type T; moreover this operation is basically done by *applying* ,
viewed as a function from parameter value to proposition, to the
actual parameter, s (in Lean denoted as (X s)), to obtain a value
(proof) of (type) T. Modus ponens is like function application. In
constructive logic, a proof of the ∀ proposition *is* a function.
Here you begin to see how profound is that proofs in constructive
logic tell you not only that a proposition is true but why. Here a
proof of X → Y or of ∀ (x : X), Y, is a program that when given any
value/proof of X as an argument returns a value/proof of Y. If you
can produce a function that turns any proof of X into a proof of Y,
then you've shown that whenever X is true, so is Y; and that's just
what X → Y is meant to say (similarly for ∀ (x : X), Y).
-/

/-
Walk-away message: Applying a proof/truth of a universal
generalization to a specific object yields a proof of the
generalization *specialized* to that particular object. That
is in the higher-order predicate logic of Lean.
-/

/-
Finally, let's compare our elimination rule, in the higher-order
predicate logic of Lean, with its first-order logic counterpart.

There are two big differences, first, in first-order logic, you
have to present the rule outside of the logic: you can't write
rules like this, ∀ (X Y : Prop), X → Y → (X ∧ Y), in first-order
logic because in first order logic you can't quantify over types,
propositions, predicates, functions. Here we do just this with the
"∀ (X Y : Prop)." By contrast, in the higher-order logic of Lean,
we can represent the rules of first-order logic with no problem:
e.g., "∀ (X Y : Prop), X → Y → (X ∧ Y)."

Second, as we've discussed, using Lean's higher-order logic, you
can think of a proof of "∀ (X Y : Prop), X → Y → (X ∧ Y)" as a
function. Each variable bound by a ∀ and each implication premise
is an argument, with the type of the return value at the end of
the line. So, here, a proof of this proposition can be taken as
a function that takes two propositions, X and Y as arguments, then
a proof (value) of (type) X, then a proof (value) of type Y, and
that finally returns a proof (value) X ∧ Y. Whereas the proof of
∀ (X Y : Prop), X → Y → (X ∧ Y) is a function the returned proof
of (X ∧ Y) is a pair-like data structure. Proofs in constructive
logic are *computational*, and you can even compute with them, as
you do when you *apply* a proof of a certain kind to an argument
to obtain a resulting proof/value.
-/

/-
Quiz questions:

First-order logic. I know that every natural number is
beautiful (∀ n, NaturalNumber(n) → Beautiful(n) : true),
and I want to prove (7 is beautiful : true). Prove it.
Name the inference rule and identify the arguments you
give it to prove it.

Constructive logic. Suppose I have a proof, pf, that every
natural number is beautiful (∀ (n : ℕ), beautiful n), and I
need a proof that 7 is beautiful. How can I get the proof
I need? Answer in both English and with a Lean expression.

Formalize this story: All people are mortal, and Plato
is a person, therefore Plato is Mortal.
-/

variable Person : Type
variable Plato : Person
variable isMortal : Person → Prop
variable everyoneIsMortal : ∀ (p : Person), isMortal p
#check (everyoneIsMortal Plato)   -- ∀ elimination!

/- *** TRUE AND FALSE *** -/

/-
In propositional logic, the literal expressions, true
and false, are part of the syntax of the logic, with
obvious interpretations. The "true" expression always
evaluates to Boolean true, and the "false" expression
to Boolean false. We could thus write expressions such
as (X ∨ false) and (X ∧ true).

In predicate logic we have the same concepts exactly.
In first order predicate logic, true is a proposition
that is invariably judged to be true, and false is a
proposition that is invariable false.

In the higher-order predicate logic defined in Lean,
true and false are also propositions, as we can see
with the following checks and an example.
-/

#check true
#check false
#check ∀ (P : Prop), P ∨ true

/-
As with all of the basic connectives and quantifiers,
the *meanings* of these terms are established by their
inference rules. We address the rules for each one now.
-/

/-
We want "true" to be a proposition that is always true.
In constructive logic, that means there's always a proof
of it. Indeed, in Lean, that proof is called true.intro.
The way to prove that "true" is true is by giving this
proof as evidence.
-/

theorem true_is_true : true := true.intro

/-
In other words, there's always a trivial proof lying
around to prove that the proposition, "true," is true.
Let's decode that theorem:
- "theorem" says we're about to prove a proposition
- the proposition in this case is "true"
- and the proof is true.intro
The Lean prover accepts this proof as correct. It is.
Simply put, true.intro is the introduction rule for the
proposition, "true," in Lean.
-/

/-
What about the elimination rule for true? Well, having
a proof of true gives you essentially zero information,
so there's nothing useful you can really do with a proof
of true. Thus there is no elimination rule for true.
-/

/-
Next, we want the inference rules for the proposition,
"false" to capture two ideas. First, the proposition
"false" must always be logically false. In first-order
logic, that's all there is to it. In the constructive
logic of Lean, the proposition "false," is logically
false *because it is defined to be a proposition that
has no proofs.* Because it has no proofs, there is no
introduction rule for "false." If there were, then we
would be able to use it to construct a proof of false,
which can't exist." There is thus *no possible way* to
complete the following definition.
-/

theorem a_proof_of_false : false := _   -- no can do!

/-
Now we get to the most interesting and important rule:
false elimination, or the elimination rule for "false."

As you recall, in propositional logic, false → X is
always true, no matter whether X is true or false.
So, false → false is true, and false → true is true.

Now suppose P is any proposition in first-order logic.
The elimination rule for "false" is false ⊢ P. In
other words, if you assume or have somehow proven
false (which is possible from a false premise), then
you can deduce that anything at all is true: including
P, no matter what proposition it is, even if it's a
false proposition. As they say, "from false anything
follows," or, in Latin, "ex falso quodlibet."

This principle makes good sense, because if false is
true (the premise), then even if a proposition, P, is
false, false is true, so P is true (too)!
-/

/-
A little practice. Which of the following propositions
in predicate logic is true?
-/

def p1 : Prop := false → false
def p2 : Prop := false → true
def p3 : Prop := true → true
def p4 : Prop := true → false
def p5 : Prop := false → 2 = 3
def p6 : Prop := false → 0 = 0
def p7 : Prop := ∀ (P : Prop), true → P
def p8 : Prop := ∀ (P : Prop), false → P

theorem p8_is_true : p8 :=
begin
unfold p8,
assume P,
assume f,
apply false.elim f,
end

/-
For each proposition, state whether it's true or false
then give a proof of it (in English). Here are some formal
proofs to help.
-/

-- def p1 : Prop := false → false
theorem x : p1 :=
begin
  unfold p1,
  assume f : false,
  exact f,
end

-- false → true
example : p2 :=
begin
  unfold p2,
  assume f,           -- move premise into context
  --exact true.intro,   -- don't have to use assumption
  -- apply false.elim f,
  contradiction,
end

example : p3 :=
begin
unfold p3,
assume t,
exact t,    -- exact true.intro also works
end

example : p4 :=
begin
unfold p4,
assume t,
end

example : p5 :=
begin
unfold p5,
assume f,
cases f,
end

example : p6 :=
begin
unfold p6,
assume f,
cases f,
-- exact rfl,
end
/-
What? The cases tactic applies the elimination rule to
an assumed or derived proof of false. For each of the
ways that the proof, f, could have been constructed,
you have a case to consider; but there are no ways a
proof of false can be constructed so you have no cases
to consider, so the proof is done! This is another way
to understand how/why false elimination works in the
constructive logic of Lean and other similar tools.
-/

example : p7 :=
begin
unfold p7,
intro P,
assume t,
-- stuck
end

example : p8 :=
begin
unfold p8,
assume P f,
cases f,
end

/- *** NOT *** -/

-- ¬
/-
With an understanding of "false" and its elimination rule, we
can now talk about the inference rules for negation.
-/

/-
Recall that if P is any proposition, then (not P), generally
written as ¬P, is also a proposition. when is ¬P true? It's
true in first-order logic if P is false. It's also true in
constructive logic when P is false, which is to say, *when
there is no proof of P*.

Now here's the slightly tricky way that we show that there can
be no proof of P. We show (P → false). What this proposition
says is that "If there is a proof of P, then from it we can
derive a proof of false." But a proof of false doesn't exist,
so if we prove (P → false) is true then there must be no proof
of P. In other words, to prove there is no proof of P, we prove
P → false! And that leads to our definition of ¬P. What it means
is *exactly* P → false.
-/
def not_ (X : Prop) := X → false  -- the definition of "not" (¬)

/-
Examples
-/

example : 0 = 1 → false :=
begin
assume h,   -- suppose 0 = 1
cases h,    -- that can't happen, no cases, we've proved ¬(0=1)
end

example : ¬(0 = 1) :=
begin
assume h,
cases h,
/-
Remember!!!  0 ≠ 1 means ¬(0 = 1) means 0 = 1 → false. You
must remember that when you want to prove ¬P, that means you
need to prove P → false: that a proof of P is a contradiction.
to remember this, because it tells you how to prove it. To
show it, assume the premise, 0 = 1, then show that in this
context, there is a contradiction ---given our intuitive
grasp of equality and the natural numbers.

If you can derive a contradiction, that is tantamount to a
proof of false, and from a proof of false, f, the truth of
any other proposition follows. Put another way, in terms of
Lean's formal logic, the term, (false.elim f), where f is a
proof of false, serves is a formal proof of any proposition.
-/
end

/- PROOF BY NEGATION

What we have now seen is a crucial "proof strategy" often
called proof by negation. To show ¬P, that the statement,
P is false, is true, prove P → false. First assume that
P is true (you have a proof of it) and show that in this
context, you can derive a proof of false. You will often
do this by producing a contradiction, which is proofs of
both X and ¬X for some proposition, from which, as we will
see shortly, you can derive a proof of false by applying
the rule of arrow elimination (function application!).
-/

/-
HW #3 Exercise: state and prove the rule (the "theorem")
of "no contradiction:" first in English and then in the
predicate logic of Lean. Or if you prefer, work it out
in Lean and the write it in English. The formal statement
of the proposition is in the partially completed theorem
below.
-/

theorem no_contra : ¬(X ∧ ¬X) :=
begin
end

/-
Hint: The proof uses arrow introduction (you have to prove an
implication), "and" elimination (you need separate proofs of X
and ¬X; try using cases in Lean), and arrow elimination (you
need to *use* these proofs, one of which, remember, is a proof
of an implication; so what can you do with that?).
-/

/- COMING SOON -/

def excluded_middle   := X ∨ ¬X   -- not an axiom in CL
def neg_elim          := ¬¬X → X  -- depends on axiom of e.m.

/- Under Construction -/

/-
And for this explanation, we need to be precise about what it means
to be a predicate in predicate logic. As we've exaplained before,
a predicate is a proposition with one or more parameters. Think of
parameters as blanks in the reading of a proposition that you can
fill in with any value of the right type for that slot. When you
fill in all the blanks, which you do by by applying the predicate
to actual parameter values, you get back a proposition: a specific
statement about specific objects with no remaining parameters to
be filled in. A predicate thus gives rise to a whole *family* of
propositions, one for each possible combination of argument values.
Once all the parameters in a predicate are fixed to actual values,
you've no longer got a predicate but just a proposition.
-/

-- ∃
def exists_intro := ∀ {P : X → Prop} (w : X), P w → (∃ (x : X), P x)
def exists_elim := ∀ {P : X → Prop}, (∃ (x : X), P x) → (∀ (x : X), P x → Y) → Y

/-
That's it for the fundamental rules of higher-order predicate
logic. The constructive logic versions of the remaining inference
rules we saw in propositional logic are actually theorems, which
means that they can be proved using only the fundamental rules,
which we accept as axioms. An axiom is a proposition accepted as
true without a proof. The inference rules of a logic are accepted
as axioms. The truth of any other proposition in predicate logic
(the foundation for most of mathematics) is proved by applying
fundamental axioms and previously proved theorems..
-/

-- theorems
def arrow_trans       := (X → Y) → (Y → Z) → (X → Z)
def contrapostitive   := (X → Y) → (¬Y → ¬X)
def demorgan1         := ¬(X ∨ Y) ↔ ¬X ∧ ¬Y
def demorgan2         := ¬(X ∧ Y) ↔ ¬X ∨ ¬Y
def no_contradiction  := ¬(X ∧ ¬X)

/-
Here are the logical fallacies we first met in propositional
logic, now presented in the much richer context of constructive
logic. You might guess that it will be impossible to construct
proofs of these fallacies, and you would be correct, as we will
see going forward.
-/
-- fallacies
def converse          := (X → Y) → (Y → X)
def deny_antecedent   := (X → Y) → ¬X →  ¬Y
def affirm_conclusion := (X → Y) → (Y → X)
def affirm_disjunct   := X ∨ Y → (X → ¬Y)

end pred_logic


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import computability.DFA
import data.set.functor

/-!
# Nondeterministic Finite Automata
This file contains the definition of a Nondeterministic Finite Automaton (NFA), a state machine
which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular
set by evaluating the string over every possible path.
We show that DFA's are equivalent to NFA's however the construction from NFA to DFA uses an
exponential number of states.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true NFA's.
-/

open set

universes u v

/-- An NFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`).
  Note the transition function sends a state to a `set` of states. These are the states that it
  may be sent to. -/
structure NFA (α : Type u) (σ : Type v) :=
(step : σ → α → set σ)
(start : set σ)
(accept : set σ)

variables {α : Type u} {σ σ' : Type v} (M : NFA α σ)

namespace NFA

instance : inhabited (NFA α σ) := ⟨ NFA.mk (λ _ _, ∅) ∅ ∅ ⟩

/-- `M.step_set S a` is the union of `M.step s a` for all `s ∈ S`. -/
def step_set (S : set σ) (a : α) : set σ := ⋃ s ∈ S, M.step s a

@[simp] lemma step_set_empty (a : α) : M.step_set ∅ a = ∅ :=
by simp_rw [step_set, Union_false, Union_empty]

/-- `M.eval_from S x` computes all possible paths though `M` with input `x` starting at an element
  of `S`. -/
def eval_from (start : set σ) : list α → set σ :=
list.foldl M.step_set start

@[simp] lemma eval_from_nil (S : set σ) : M.eval_from S [] = S := rfl
@[simp] lemma eval_from_singleton (S : set σ) (a : α) : M.eval_from S [a] = M.step_set S a := rfl
@[simp] lemma eval_from_append_singleton (S : set σ) (x : list α) (a : α) :
  M.eval_from S (x ++ [a]) = M.step_set (M.eval_from S x) a :=
by simp only [eval_from, list.foldl_append, list.foldl_cons, list.foldl_nil]

/-- `M.eval x` computes all possible paths though `M` with input `x` starting at an element of
  `M.start`. -/
def eval : list α → set σ := M.eval_from M.start

@[simp] lemma eval_nil : M.eval [] = M.start := rfl
@[simp] lemma eval_singleton (a : α) : M.eval [a] = M.step_set M.start a := rfl
@[simp] lemma eval_append_singleton (x : list α) (a : α) :
  M.eval (x ++ [a]) = M.step_set (M.eval x) a :=
eval_from_append_singleton _ _ _ _

/-- `M.accepts` is the language of `x` such that there is an accept state in `M.eval x`. -/
def accepts : language α :=
λ x, ∃ S ∈ M.accept, S ∈ M.eval x

/-- `M.to_DFA` is an `DFA` constructed from a `NFA` `M` using the subset construction. The
  states is the type of `set`s of `M.state` and the step function is `M.step_set`. -/
def to_DFA : DFA α (set σ) :=
{ step := M.step_set,
  start := M.start,
  accept := {S | ∃ s ∈ S, s ∈ M.accept} }

@[simp] lemma to_DFA_correct :
  M.to_DFA.accepts = M.accepts :=
begin
  ext x,
  rw [accepts, DFA.accepts, eval, DFA.eval],
  change list.foldl _ _ _ ∈ {S | _} ↔ _,
  split; { exact λ ⟨w, h2, h3⟩, ⟨w, h3, h2⟩ },
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card (set σ) ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  rw ←to_DFA_correct at hx ⊢,
  exact M.to_DFA.pumping_lemma hx hlen
end

end NFA

namespace DFA

/-- `M.to_NFA` is an `NFA` constructed from a `DFA` `M` by using the same start and accept
  states and a transition function which sends `s` with input `a` to the singleton `M.step s a`. -/
def to_NFA (M : DFA α σ') : NFA α σ' :=
{ step := λ s a, {M.step s a},
  start := {M.start},
  accept := M.accept }

@[simp] lemma to_NFA_eval_from_match (M : DFA α σ) (start : σ) (s : list α) :
  M.to_NFA.eval_from {start} s = {M.eval_from start s} :=
begin
  change list.foldl M.to_NFA.step_set {start} s = {list.foldl M.step start s},
  induction s with a s ih generalizing start,
  { tauto },
  { rw [list.foldl, list.foldl,
        show M.to_NFA.step_set {start} a = {M.step start a}, by simpa [NFA.step_set]],
    tauto }
end

@[simp] lemma to_NFA_correct (M : DFA α σ) :
  M.to_NFA.accepts = M.accepts :=
begin
  ext x,
  change (∃ S H, S ∈ M.to_NFA.eval_from {M.start} x) ↔ _,
  rw to_NFA_eval_from_match,
  split,
  { rintro ⟨ S, hS₁, hS₂ ⟩,
    rwa set.mem_singleton_iff.mp hS₂ at hS₁ },
  { exact λ h, ⟨M.eval x, h, rfl⟩ }
end

end DFA


import tactic
import tactic.induction

namespace pred_logic

universe u

structure language (α β : Type u) :=
(hαβ : α ≠ β)
(rel_symbols : set α)
(func_symbols : set β)
(rel_arity : α → ℕ)
(func_arity : β → ℕ)

inductive term {α β : Type u} (𝓛 : language α β)
| var : ℕ → term
| func {f : β} (f ∈ 𝓛.func_symbols) : (fin (𝓛.func_arity f) → term) → term

inductive formula {α β : Type u} (𝓛 : language α β)
| bot : formula
| relation {R : α} (R ∈ 𝓛.rel_symbols) : (fin (𝓛.rel_arity R) → term 𝓛) → formula
| Exists : ℕ → formula → formula
| imp : formula → formula → formula

variables {α β : Type u} {𝓛 : language α β}

def term_vars : term 𝓛 → ℕ → Prop
| (term.var m) n := m = n
| (term.func f hf terms) n := ∃m : (fin (𝓛.func_arity f)), term_vars (terms m) n

def free_vars : formula 𝓛  → ℕ → Prop
| formula.bot m := false
| (formula.Exists n φ) m := m ≠ n ∧ free_vars φ m
| (formula.imp φ ψ) m := free_vars φ m ∨ free_vars ψ m
| (formula.relation R hR terms) m := ∃n : (fin (𝓛.rel_arity R)), term_vars (terms n) m

structure interpretation (𝓛 : language α β) :=
(domain : Type)
(to_func : ∀{f}, f ∈ 𝓛.func_symbols → (fin (𝓛.func_arity f) → domain) → domain)
(to_rel : ∀{R}, R ∈ 𝓛.rel_symbols → (fin (𝓛.rel_arity R) → domain) → Prop)

variable {M : interpretation 𝓛}

def assignment (M : interpretation 𝓛) := ℕ → M.domain

def replace (s : assignment M) (n : ℕ) (m : M.domain) : assignment M :=
λk, if k = n then m else s k

lemma replace_pos {s : assignment M} {n : ℕ} {m : M.domain}
: replace s n m n = m := if_pos rfl

lemma replace_neg {s : assignment M} {n : ℕ} {m : M.domain} {k : ℕ}
: k ≠ n → replace s n m k = s k := λhk, if_neg hk

def value (s : assignment M) : term 𝓛 → M.domain
| (term.var n) := s n
| (term.func f hf terms) := let v := λk, value (terms k) in M.to_func hf v

def satisfies : assignment M →  formula 𝓛 → Prop
| s (formula.bot) := false
| s (formula.relation R hR terms) := M.to_rel hR (value s ∘ terms)
| s (formula.imp φ ψ) := satisfies s φ → satisfies s ψ
| s (formula.Exists n φ) := ∃(m : M.domain), satisfies (replace s n m) φ

example {s s' : assignment M} {u : term 𝓛} :
(∀n, term_vars u n → s n = s' n) → value s u = value s' u :=
begin
	intro h,
	induction' u with u f g g_func g_args ih,
	{exact h u rfl},
	{
		unfold value,
		simp,
		apply congr_arg,
		sorry,
	},
end

lemma satisfies_of_agree_free {s s' : assignment M} (φ : formula 𝓛) :
(∀{n}, free_vars φ n → s n = s' n) → satisfies s φ → satisfies s' φ :=
begin
	intros agree_free hsφ,
	induction' φ,
	{exfalso,exact hsφ},
	{
		unfold satisfies at *,
		sorry,
	}, repeat {sorry},
end

end pred_logic


import data.set
noncomputable theory
local attribute [instance] classical.prop_decidable
universe u
namespace add_comm_group

class is_add_subgroup {M : Type u} [add_comm_group M] (N : set M) : Prop :=
(zero : (0:M) ∈ N)
(add  : ∀ {x y:M}, x ∈ N → y ∈ N → x + y ∈ N)
(neg : ∀ {x:M}, x ∈ N → -x ∈ N)

variables {M : Type u} (N : set M)
variables [add_comm_group M] [HMN : is_add_subgroup N]
include N HMN

@[reducible] def add_quot_group_reln (x y : M) := x - y ∈ N

--variables (M : Type*) [add_comm_group M] (N : set M) [is_add_subgroup N]

def add_group_setoid
  : setoid M :=
{ r:= λ x y, x - y ∈ N,
  iseqv := ⟨λ x,by simp [is_add_subgroup.zero],
            λ x y Hxy,
              have -(x-y) ∈ N:=is_add_subgroup.neg Hxy,
              by simpa using this,
            λ x y z Hxy Hyz,
              have (x-y)+(y-z) ∈ N := is_add_subgroup.add Hxy Hyz,
              by simpa using this⟩
}

local attribute [instance] add_group_setoid

lemma quotient_rel_eq {a b : M}
-- (M : Type*) [add_comm_group M] (N : set M) [is_add_subgroup N] {a b : M}
: (a ≈ b) = (a - b ∈ N) := rfl

#check add_group_setoid
--@[reducible] def add_quot_group (M : Type u) [add_comm_group M] (N : set M) [is_add_subgroup N] := quot (add_quot_group_reln M N)
section
variable (M)
@[reducible] def add_quot_group
--(M : Type u) [add_comm_group M] (N : set M) [is_add_subgroup N]
:= quotient (add_group_setoid N)
end

#check add_quot_group

local notation ` Qu ` := add_quot_group M N

instance quotient_has_zero : has_zero (Qu) := ⟨⟦0⟧⟩--⟦ ]]

instance quotient_has_add : has_add (Qu) := ⟨
    quot.lift (λ m₁ : M,
      quot.lift (λ m₂ : M, quot.mk setoid.r (m₁ + m₂))
      ( begin
          intros a b HabN,
          apply quot.sound,
          show ((m₁ + a) - (m₁ + b) ∈ N),
          suffices : a + -b ∈ N,by simp [this],
          rw [←sub_eq_add_neg],
          exact HabN,
        end)
    )
    ( begin
        intros a b HabN,
        funext q,
        apply congr_fun,
        suffices : (λ (m₂ : M), quot.mk setoid.r (a + m₂)) = (λ (m₂ : M), quot.mk setoid.r (b + m₂)),
          simp [this],
        funext m,
        apply quot.sound,
        show (a+m) - (b+m) ∈ N,
        suffices : a + -b ∈ N,by simp [this],
        rw [←sub_eq_add_neg],
        exact HabN
      end )
  ⟩

instance quotient_has_neg : has_neg (Qu) := ⟨quot.lift (λ m : M, quot.mk setoid.r (-m)) (begin
      intros a b HabN,
      apply quot.sound,
      show (-a - (-b) ∈  N),
      have H : -(a-b) ∈ N := is_add_subgroup.neg HabN,
      have H2 : -a - -b = -(a-b) := by simp,
      rwa [H2],
    end)⟩

theorem quot_map_add
--(M : Type u) [add_comm_group M] (N : set M) [is_add_subgroup N]
(a b : M) :
  ⟦a+b⟧ = ⟦a⟧ + ⟦b⟧ :=
begin
  apply quot.sound,
  unfold setoid.r add_quot_group_reln,
  simp [is_add_subgroup.zero],
end

instance add_quot_group_is_group
  : add_comm_group (Qu) :=
  { add := (+),
    add_assoc := begin
      refine quot.ind _,
      intro a,
      refine quot.ind _,
      intro b,
      refine quot.ind _,
      intro c,
--      dunfold add_quot_group_add,
      show ⟦a + b + c⟧ = ⟦a + (b + c)⟧,
      rw [add_assoc],
      refl,
    end,
    zero := (0),
    zero_add := begin
      refine quot.ind _,
      intro a,
      apply quot.sound,
      unfold setoid.r add_quot_group_reln,
      simp [sub_self],
      exact is_add_subgroup.zero _,
    end,
    add_zero := begin
      refine quot.ind _,
      intro a,
      apply quot.sound,
      unfold setoid.r add_quot_group_reln,
      simp [sub_self],
      exact is_add_subgroup.zero _,
    end,
    neg := has_neg.neg,
    add_left_neg := begin
      refine quot.ind _,
      intro a,
      apply quot.sound,
      rw neg_add_self,
      unfold setoid.r add_quot_group_reln,
      rw sub_self,
      exact is_add_subgroup.zero _,
    end,
    add_comm := begin
      refine quot.ind _,
      intro a,
      refine quot.ind _,
      intro b,
      show ⟦a⟧ + ⟦b⟧ = ⟦b⟧ + ⟦a⟧,
      rw [eq.symm (quot_map_add N a b)],
      rw [eq.symm (quot_map_add N b a)],
      rw [add_comm]
    end,
  }

lemma quot_map_zero : ⟦0⟧ = (0:Qu) := rfl

--set_option trace.class_instances true

lemma quot_map_neg (a : M) :
--(M : Type u) [add_comm_group M] (N : set M) [is_add_subgroup N] (a : M) :
  ⟦-a⟧ = -⟦a⟧ := --@add_comm_group.neg _ H ((quot.mk r a):(add_quot_group M N)) :=
--  quot.mk r (-a) = -((quot.mk r a):(add_quot_group M N)) :=
  begin
--  simp,
  apply eq_neg_of_add_eq_zero,
  rw [eq.symm (quot_map_add N _ _)],
  rw [neg_add_eq_sub,sub_self],
  exact quot_map_zero _,
end

def subgroup_to_quot_subgroup (I : set M)
  : set (Qu) :=
  set.image (λ b, ⟦b⟧) I

instance image_of_subgroup_is_subgroup
--{M : Type*} [add_comm_group M] {N : set M} [is_add_subgroup N]
(I : set M) [is_add_subgroup I]
  : is_add_subgroup (subgroup_to_quot_subgroup N I) :=
{ zero := begin
    existsi (0:M),
    split,
    { exact is_add_subgroup.zero I },
    { exact quot_map_zero N
    },
  end,
  add := begin
    intros x y Hx Hy,
    cases Hx with a Ha,
    cases Hy with b Hb,
    existsi (a+b),
    split,
    { exact is_add_subgroup.add Ha.1 Hb.1 },
    { rw ←Ha.2,rw ←Hb.2,
      exact quot_map_add N a b },
  end,
  neg := begin
    intros x Hx,
    cases Hx with a Ha,
    existsi (-a),
    split,
    { exact is_add_subgroup.neg Ha.1},
    { rw ←Ha.2,
      exact quot_map_neg _ _
    }
  end
}

def quot_subgroup_to_subgroup
 --{M : Type*} [add_comm_group M] {N : set M} [is_add_subgroup N]
 (Ibar : set (Qu))
  [is_add_subgroup Ibar] : set M :=
  set.preimage (λ (x:M), (⟦x⟧:Qu)) Ibar
--  set.preimage (quot.mk (add_quot_group_reln N)) Ibar

--set_option pp.all true
instance preimage_of_subgroup_is_subgroup
--{M : Type*} [add_comm_group M] {N : set M} [is_add_subgroup N]
  (Ibar : set (Qu)) [is_add_subgroup Ibar]
  : is_add_subgroup (quot_subgroup_to_subgroup N Ibar) :=
{
  zero := begin
    show (0:Qu) ∈ Ibar,
    exact is_add_subgroup.zero Ibar,
  end,
  add := begin
    intros x y Hx Hy,
    have Hx2 : ⟦x⟧ ∈ Ibar := Hx,
    have Hy2 : ⟦y⟧ ∈ Ibar := Hy,

    show ⟦x+y⟧ ∈ Ibar,
--    suffices : add_quot_group_add (quot.mk (add_quot_group_reln M N) x) (quot.mk (add_quot_group_reln M N) y) ∈ Ibar,
--      have H:quot.mk (add_quot_group_reln M N) (x + y) =
--        add_quot_group_add (quot.mk (add_quot_group_reln M N) x) (quot.mk (add_quot_group_reln M N) y) := (quot_map_add M N x y),
--      simp [this,H],
--    show (quot.mk (add_quot_group_reln M N) x) + (quot.mk (add_quot_group_reln M N) y) ∈ Ibar,
    rw quot_map_add,
    apply is_add_subgroup.add,
      exact Hx,
      exact Hy,
  end,
  neg := begin
    intros x Hx,
    show ⟦-x⟧ ∈ Ibar,
    rw quot_map_neg,
    apply is_add_subgroup.neg,
    exact Hx,
  end
}

#check @quotient.mk
#check @setoid.r
#check @quotient.exact
#print notation ⟦
--set_option pp.all true
theorem eq_preimage_of_image
 --{M : Type*} [add_comm_group M] {N : set M} [is_add_subgroup N]
 (I : set M) [is_add_subgroup I]
  : N ⊆ I → quot_subgroup_to_subgroup N (subgroup_to_quot_subgroup N I) = I :=
begin
  intro H,
  apply set.eq_of_subset_of_subset,
  { intros x Hx,
    cases Hx with y H2,
    have H3 : @setoid.r _ (add_group_setoid N) y x :=
      @quotient.exact _ (add_group_setoid N) _ _ H2.2,
    have H4 : y-x ∈ I := H H3,
    have H5 : x = -(y-x) + y := by simp,
    rw H5,
    refine is_add_subgroup.add _ _,
      refine is_add_subgroup.neg _,assumption,
    exact H2.1
  },
  { intros x Hx,
    show @quotient.mk M (add_group_setoid N) x ∈ subgroup_to_quot_subgroup N I,
    existsi x,
    split,exact Hx,
    refl
  }
end

#check quot.exists_rep

theorem eq_image_of_preimage
 --{M : Type*} [add_comm_group M] {N : set M} [is_add_subgroup N]
 (Ibar : set Qu) [is_add_subgroup Ibar] :
  subgroup_to_quot_subgroup N (quot_subgroup_to_subgroup N Ibar) = Ibar :=
begin
  apply set.eq_of_subset_of_subset,
  { intros xbar Hxbar,
    cases Hxbar with y Hy,
    rw [←Hy.2],
    exact Hy.1
  },
  { intros xbar Hxbar,
    unfold subgroup_to_quot_subgroup,
    unfold set.image,
    have H := quot.exists_rep xbar,
    cases H with a Ha,
    existsi a,
    split,
    { show Ibar (quot.mk setoid.r a),
      rw Ha,
      exact Hxbar
    },
    { exact Ha,
    },
  }
end

end add_comm_group

namespace comm_ring

class is_ideal {R : Type*} [comm_ring R] (J : set R) : Prop :=
(zero : (0:R) ∈ J)
(add  : ∀ {x y}, x ∈ J → y ∈ J → x + y ∈ J)
(mul : ∀ r x : R, x ∈ J → r * x ∈ J)

-- now add
-- structure ideal...

end comm_ring
/-
So it would be reasonable to have both definitions in a commutative algebra file?
Mario Carneiro
@digama0
21:55
yes
I would use is_ideal in the definition of ideal to avoid repeating myself
Kevin Buzzard
@kbuzzard
21:56
Oh! Great. but then don't I now have 100 questions about how to formulate 100 lemmas about ideals?
i.e. which one to use?
Mario Carneiro
@digama0
21:56
Use is_ideal when it makes sense, use ideal for the rest

-/


import data.real.basic

#check pow_two

variables (x y : ℝ)

-- BEGIN
example (h : x^2 = 1) : x = 1 ∨ x = -1 :=
begin
  have h' : (x + 1) * (x - 1) = 0,
  calc (x + 1) * (x - 1) = x^2 - 1 : by ring
  ...                    = 1 - 1 : by rw h
  ...                    = 0 : by norm_num,
  have h'' : x + 1 = 0 ∨ x - 1 = 0 := mul_eq_zero.mp h',
    cases h'',
    right,
    exact add_eq_zero_iff_eq_neg.mp h'',
    left,
    exact sub_eq_zero.mp h'',
end

example (h : x^2 = y^2) : x = y ∨ x = -y :=
begin
  have h' : (x + y) * (x - y) = 0,
  calc (x + y) * (x - y) = x^2 - y^2 : by ring
  ...                    = y^2 - y^2 : by rw h
  ...                    = 0 : sub_self (y ^ 2),
  have h'' : x + y = 0 ∨ x - y = 0 := mul_eq_zero.mp h',
    cases h'',
    right,
    exact add_eq_zero_iff_eq_neg.mp h'',
    left,
    exact sub_eq_zero.mp h'',
end

-- END


-- 1
def nandb : bool → bool → bool
| tt tt := ff
| a b := tt

def is_correct : (bool → bool → bool) → bool :=
λ a, (a (ff) (ff) = tt) && (a (ff) (tt) = tt) && (a (tt) (ff) = tt) &&(a (tt) (tt) = ff)

inductive naat: Type
| zro : naat
| suc : naat → naat

def is_even : naat → bool
| naat.zro := tt
| (naat.suc naat.zro) := ff
| (naat.suc (naat.suc n)) := is_even n

def nat_add : naat → naat → naat
| naat.zro x := x
| (naat.suc a) b := naat.suc (nat_add a b)

def nat_double : naat → naat
| naat.zro := naat.zro
| (naat.suc n) := nat_add (naat.suc (naat.suc naat.zro)) (nat_double n)

theorem easy : ∀ n : nat, 2 * (1 + n) = 2 + 2 * n :=
begin
intro n,
rewrite mul_add,
rewrite mul_one,
end

def nat_eq : naat → naat → bool
| naat.zro naat.zro := tt
| (naat.suc a) (naat.suc b) := nat_eq a b
| _ _ := ff

def a_bigger_than_b : naat → naat → bool
| naat.zro naat.zro := ff
| naat.zro a := ff
| a naat.zro := tt
| (naat.suc a) (naat.suc b) := a_bigger_than_b a b

def factorial : ℕ → ℕ
| 0 := 1
| (nat.succ n) := nat.succ n * factorial n