/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Johannes Hölzl, Rémy Degenne
-/
import order.filter.partial
import order.filter.at_top_bot

/-!
# liminfs and limsups of functions and filters

Defines the Liminf/Limsup of a function taking values in a conditionally complete lattice, with
respect to an arbitrary filter.

We define `f.Limsup` (`f.Liminf`) where `f` is a filter taking values in a conditionally complete
lattice. `f.Limsup` is the smallest element `a` such that, eventually, `u ≤ a` (and vice versa for
`f.Liminf`). To work with the Limsup along a function `u` use `(f.map u).Limsup`.

Usually, one defines the Limsup as `Inf (Sup s)` where the Inf is taken over all sets in the filter.
For instance, in ℕ along a function `u`, this is `Inf_n (Sup_{k ≥ n} u k)` (and the latter quantity
decreases with `n`, so this is in fact a limit.). There is however a difficulty: it is well possible
that `u` is not bounded on the whole space, only eventually (think of `Limsup (λx, 1/x)` on ℝ. Then
there is no guarantee that the quantity above really decreases (the value of the `Sup` beforehand is
not really well defined, as one can not use ∞), so that the Inf could be anything. So one can not
use this `Inf Sup ...` definition in conditionally complete lattices, and one has to use a less
tractable definition.

In conditionally complete lattices, the definition is only useful for filters which are eventually
bounded above (otherwise, the Limsup would morally be +∞, which does not belong to the space) and
which are frequently bounded below (otherwise, the Limsup would morally be -∞, which is not in the
space either). We start with definitions of these concepts for arbitrary filters, before turning to
the definitions of Limsup and Liminf.

In complete lattices, however, it coincides with the `Inf Sup` definition.
-/

open filter set
open_locale filter

variables {α β ι : Type*}
namespace filter

section relation

/-- `f.is_bounded (≺)`: the filter `f` is eventually bounded w.r.t. the relation `≺`, i.e.
eventually, it is bounded by some uniform bound.
`r` will be usually instantiated with `≤` or `≥`. -/
def is_bounded (r : α → α → Prop) (f : filter α) := ∃ b, ∀ᶠ x in f, r x b

/-- `f.is_bounded_under (≺) u`: the image of the filter `f` under `u` is eventually bounded w.r.t.
the relation `≺`, i.e. eventually, it is bounded by some uniform bound. -/
def is_bounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (f.map u).is_bounded r

variables {r : α → α → Prop} {f g : filter α}

/-- `f` is eventually bounded if and only if, there exists an admissible set on which it is
bounded. -/
lemma is_bounded_iff : f.is_bounded r ↔ (∃s∈f.sets, ∃b, s ⊆ {x | r x b}) :=
iff.intro
  (assume ⟨b, hb⟩, ⟨{a | r a b}, hb, b, subset.refl _⟩)
  (assume ⟨s, hs, b, hb⟩, ⟨b, mem_sets_of_superset hs hb⟩)

/-- A bounded function `u` is in particular eventually bounded. -/
lemma is_bounded_under_of {f : filter β} {u : β → α} :
  (∃b, ∀x, r (u x) b) → f.is_bounded_under r u
| ⟨b, hb⟩ := ⟨b, show ∀ᶠ x in f, r (u x) b, from eventually_of_forall hb⟩

lemma is_bounded_bot : is_bounded r ⊥ ↔ nonempty α :=
by simp [is_bounded, exists_true_iff_nonempty]

lemma is_bounded_top : is_bounded r ⊤ ↔ (∃t, ∀x, r x t) :=
by simp [is_bounded, eq_univ_iff_forall]

lemma is_bounded_principal (s : set α) : is_bounded r (𝓟 s) ↔ (∃t, ∀x∈s, r x t) :=
by simp [is_bounded, subset_def]

lemma is_bounded_sup [is_trans α r] (hr : ∀b₁ b₂, ∃b, r b₁ b ∧ r b₂ b) :
  is_bounded r f → is_bounded r g → is_bounded r (f ⊔ g)
| ⟨b₁, h₁⟩ ⟨b₂, h₂⟩ := let ⟨b, rb₁b, rb₂b⟩ := hr b₁ b₂ in
  ⟨b, eventually_sup.mpr ⟨h₁.mono (λ x h, trans h rb₁b), h₂.mono (λ x h, trans h rb₂b)⟩⟩

lemma is_bounded.mono (h : f ≤ g) : is_bounded r g → is_bounded r f
| ⟨b, hb⟩ := ⟨b, h hb⟩

lemma is_bounded_under.mono {f g : filter β} {u : β → α} (h : f ≤ g) :
  g.is_bounded_under r u → f.is_bounded_under r u :=
λ hg, hg.mono (map_mono h)

lemma is_bounded.is_bounded_under {q : β → β → Prop} {u : α → β}
  (hf : ∀a₀ a₁, r a₀ a₁ → q (u a₀) (u a₁)) : f.is_bounded r → f.is_bounded_under q u
| ⟨b, h⟩ := ⟨u b, show ∀ᶠ x in f, q (u x) (u b), from h.mono (λ x, hf x b)⟩

/-- `is_cobounded (≺) f` states that the filter `f` does not tend to infinity w.r.t. `≺`. This is
also called frequently bounded. Will be usually instantiated with `≤` or `≥`.

There is a subtlety in this definition: we want `f.is_cobounded` to hold for any `f` in the case of
complete lattices. This will be relevant to deduce theorems on complete lattices from their
versions on conditionally complete lattices with additional assumptions. We have to be careful in
the edge case of the trivial filter containing the empty set: the other natural definition
  `¬ ∀ a, ∀ᶠ n in f, a ≤ n`
would not work as well in this case.
-/
def is_cobounded (r : α → α → Prop) (f : filter α) := ∃b, ∀a, (∀ᶠ x in f, r x a) → r b a

/-- `is_cobounded_under (≺) f u` states that the image of the filter `f` under the map `u` does not
tend to infinity w.r.t. `≺`. This is also called frequently bounded. Will be usually instantiated
with `≤` or `≥`. -/
def is_cobounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (f.map u).is_cobounded r

/-- To check that a filter is frequently bounded, it suffices to have a witness
which bounds `f` at some point for every admissible set.

This is only an implication, as the other direction is wrong for the trivial filter.-/
lemma is_cobounded.mk [is_trans α r] (a : α) (h : ∀s∈f, ∃x∈s, r a x) : f.is_cobounded r :=
⟨a, assume y s, let ⟨x, h₁, h₂⟩ := h _ s in trans h₂ h₁⟩

/-- A filter which is eventually bounded is in particular frequently bounded (in the opposite
direction). At least if the filter is not trivial. -/
lemma is_bounded.is_cobounded_flip [is_trans α r] [ne_bot f] :
  f.is_bounded r → f.is_cobounded (flip r)
| ⟨a, ha⟩ := ⟨a, assume b hb,
  let ⟨x, rxa, rbx⟩ := (ha.and hb).exists in
  show r b a, from trans rbx rxa⟩

lemma is_cobounded_bot : is_cobounded r ⊥ ↔ (∃b, ∀x, r b x) :=
by simp [is_cobounded]

lemma is_cobounded_top : is_cobounded r ⊤ ↔ nonempty α :=
by simp [is_cobounded, eq_univ_iff_forall, exists_true_iff_nonempty] {contextual := tt}

lemma is_cobounded_principal (s : set α) :
  (𝓟 s).is_cobounded r ↔ (∃b, ∀a, (∀x∈s, r x a) → r b a) :=
by simp [is_cobounded, subset_def]

lemma is_cobounded.mono (h : f ≤ g) : f.is_cobounded r → g.is_cobounded r
| ⟨b, hb⟩ := ⟨b, assume a ha, hb a (h ha)⟩

end relation

lemma is_cobounded_le_of_bot [order_bot α] {f : filter α} : f.is_cobounded (≤) :=
⟨⊥, assume a h, bot_le⟩

lemma is_cobounded_ge_of_top [order_top α] {f : filter α} : f.is_cobounded (≥) :=
⟨⊤, assume a h, le_top⟩

lemma is_bounded_le_of_top [order_top α] {f : filter α} : f.is_bounded (≤) :=
⟨⊤, eventually_of_forall $ λ _, le_top⟩

lemma is_bounded_ge_of_bot [order_bot α] {f : filter α} : f.is_bounded (≥) :=
⟨⊥, eventually_of_forall $ λ _, bot_le⟩

lemma is_bounded_under_sup [semilattice_sup α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≤) u → f.is_bounded_under (≤) v → f.is_bounded_under (≤) (λa, u a ⊔ v a)
| ⟨bu, (hu : ∀ᶠ x in f, u x ≤ bu)⟩ ⟨bv, (hv : ∀ᶠ x in f, v x ≤ bv)⟩ :=
  ⟨bu ⊔ bv, show ∀ᶠ x in f, u x ⊔ v x ≤ bu ⊔ bv,
    by filter_upwards [hu, hv] assume x, sup_le_sup⟩

lemma is_bounded_under_inf [semilattice_inf α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≥) u → f.is_bounded_under (≥) v → f.is_bounded_under (≥) (λa, u a ⊓ v a)
| ⟨bu, (hu : ∀ᶠ x in f, u x ≥ bu)⟩ ⟨bv, (hv : ∀ᶠ x in f, v x ≥ bv)⟩ :=
  ⟨bu ⊓ bv, show ∀ᶠ x in f, u x ⊓ v x ≥ bu ⊓ bv,
    by filter_upwards [hu, hv] assume x, inf_le_inf⟩

/-- Filters are automatically bounded or cobounded in complete lattices. To use the same statements
in complete and conditionally complete lattices but let automation fill automatically the
boundedness proofs in complete lattices, we use the tactic `is_bounded_default` in the statements,
in the form `(hf : f.is_bounded (≥) . is_bounded_default)`. -/
meta def is_bounded_default : tactic unit :=
tactic.applyc ``is_cobounded_le_of_bot <|>
tactic.applyc ``is_cobounded_ge_of_top <|>
tactic.applyc ``is_bounded_le_of_top <|>
tactic.applyc ``is_bounded_ge_of_bot

section conditionally_complete_lattice
variables [conditionally_complete_lattice α]

/-- The `Limsup` of a filter `f` is the infimum of the `a` such that, eventually for `f`,
holds `x ≤ a`. -/
def Limsup (f : filter α) : α := Inf { a | ∀ᶠ n in f, n ≤ a }

/-- The `Liminf` of a filter `f` is the supremum of the `a` such that, eventually for `f`,
holds `x ≥ a`. -/
def Liminf (f : filter α) : α := Sup { a | ∀ᶠ n in f, a ≤ n }

/-- The `limsup` of a function `u` along a filter `f` is the infimum of the `a` such that,
eventually for `f`, holds `u x ≤ a`. -/
def limsup (f : filter β) (u : β → α) : α := (f.map u).Limsup

/-- The `liminf` of a function `u` along a filter `f` is the supremum of the `a` such that,
eventually for `f`, holds `u x ≥ a`. -/
def liminf (f : filter β) (u : β → α) : α := (f.map u).Liminf

section
variables {f : filter β} {u : β → α}
theorem limsup_eq : f.limsup u = Inf { a | ∀ᶠ n in f, u n ≤ a } := rfl
theorem liminf_eq : f.liminf u = Sup { a | ∀ᶠ n in f, a ≤ u n } := rfl
end

theorem Limsup_le_of_le {f : filter α} {a}
  (hf : f.is_cobounded (≤) . is_bounded_default) (h : ∀ᶠ n in f, n ≤ a) : f.Limsup ≤ a :=
cInf_le hf h

theorem le_Liminf_of_le {f : filter α} {a}
  (hf : f.is_cobounded (≥) . is_bounded_default) (h : ∀ᶠ n in f, a ≤ n) : a ≤ f.Liminf :=
le_cSup hf h

theorem le_Limsup_of_le {f : filter α} {a}
  (hf : f.is_bounded (≤) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, n ≤ b) → a ≤ b) :
  a ≤ f.Limsup :=
le_cInf hf h

theorem Liminf_le_of_le {f : filter α} {a}
  (hf : f.is_bounded (≥) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, b ≤ n) → b ≤ a) :
  f.Liminf ≤ a :=
cSup_le hf h

theorem Liminf_le_Limsup {f : filter α} [ne_bot f]
  (h₁ : f.is_bounded (≤) . is_bounded_default) (h₂ : f.is_bounded (≥) . is_bounded_default) :
  f.Liminf ≤ f.Limsup :=
Liminf_le_of_le h₂ $ assume a₀ ha₀, le_Limsup_of_le h₁ $ assume a₁ ha₁,
  show a₀ ≤ a₁, from let ⟨b, hb₀, hb₁⟩ := (ha₀.and ha₁).exists in le_trans hb₀ hb₁

lemma Liminf_le_Liminf {f g : filter α}
  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default)
  (h : ∀ a, (∀ᶠ n in f, a ≤ n) → ∀ᶠ n in g, a ≤ n) : f.Liminf ≤ g.Liminf :=
cSup_le_cSup hg hf h

lemma Limsup_le_Limsup {f g : filter α}
  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default)
  (h : ∀ a, (∀ᶠ n in g, n ≤ a) → ∀ᶠ n in f, n ≤ a) : f.Limsup ≤ g.Limsup :=
cInf_le_cInf hf hg h

lemma Limsup_le_Limsup_of_le {f g : filter α} (h : f ≤ g)
  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default) :
  f.Limsup ≤ g.Limsup :=
Limsup_le_Limsup hf hg (assume a ha, h ha)

lemma Liminf_le_Liminf_of_le {f g : filter α} (h : g ≤ f)
  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default) :
  f.Liminf ≤ g.Liminf :=
Liminf_le_Liminf hf hg (assume a ha, h ha)

lemma limsup_le_limsup {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : u ≤ᶠ[f] v)
  (hu : f.is_cobounded_under (≤) u . is_bounded_default)
  (hv : f.is_bounded_under (≤) v . is_bounded_default) :
  f.limsup u ≤ f.limsup v :=
Limsup_le_Limsup hu hv $ assume b, h.trans

lemma liminf_le_liminf {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a ≤ v a)
  (hu : f.is_bounded_under (≥) u . is_bounded_default)
  (hv : f.is_cobounded_under (≥) v . is_bounded_default) :
  f.liminf u ≤ f.liminf v :=
@limsup_le_limsup (order_dual β) α _ _ _ _ h hv hu

theorem Limsup_principal {s : set α} (h : bdd_above s) (hs : s.nonempty) :
  (𝓟 s).Limsup = Sup s :=
by simp [Limsup]; exact cInf_upper_bounds_eq_cSup h hs

theorem Liminf_principal {s : set α} (h : bdd_below s) (hs : s.nonempty) :
  (𝓟 s).Liminf = Inf s :=
@Limsup_principal (order_dual α) _ s h hs

lemma limsup_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a = v a) : limsup f u = limsup f v :=
begin
  rw limsup_eq,
  congr' with b,
  exact eventually_congr (h.mono $ λ x hx, by simp [hx])
end

lemma liminf_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a = v a) : liminf f u = liminf f v :=
@limsup_congr (order_dual β) _ _ _ _ _ h

lemma limsup_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
  (b : β) : limsup f (λ x, b) = b :=
by simpa only [limsup_eq, eventually_const] using cInf_Ici

lemma liminf_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
  (b : β) : liminf f (λ x, b) = b :=
@limsup_const (order_dual β) α _ f _ b

end conditionally_complete_lattice

section complete_lattice
variables [complete_lattice α]

@[simp] theorem Limsup_bot : (⊥ : filter α).Limsup = ⊥ :=
bot_unique $ Inf_le $ by simp

@[simp] theorem Liminf_bot : (⊥ : filter α).Liminf = ⊤ :=
top_unique $ le_Sup $ by simp

@[simp] theorem Limsup_top : (⊤ : filter α).Limsup = ⊤ :=
top_unique $ le_Inf $
  by simp [eq_univ_iff_forall]; exact assume b hb, (top_unique $ hb _)

@[simp] theorem Liminf_top : (⊤ : filter α).Liminf = ⊥ :=
bot_unique $ Sup_le $
  by simp [eq_univ_iff_forall]; exact assume b hb, (bot_unique $ hb _)

/-- Same as limsup_const applied to `⊥` but without the `ne_bot f` assumption -/
lemma limsup_const_bot {f : filter β} : limsup f (λ x : β, (⊥ : α)) = (⊥ : α) :=
begin
  rw [limsup_eq, eq_bot_iff],
  exact Inf_le (eventually_of_forall (λ x, le_refl _)),
end

/-- Same as limsup_const applied to `⊤` but without the `ne_bot f` assumption -/
lemma liminf_const_top {f : filter β} : liminf f (λ x : β, (⊤ : α)) = (⊤ : α) :=
@limsup_const_bot (order_dual α) β _ _

lemma liminf_le_limsup {f : filter β} [ne_bot f] {u : β → α}  : liminf f u ≤ limsup f u :=
Liminf_le_Limsup is_bounded_le_of_top is_bounded_ge_of_bot

theorem has_basis.Limsup_eq_infi_Sup {ι} {p : ι → Prop} {s} {f : filter α} (h : f.has_basis p s) :
  f.Limsup = ⨅ i (hi : p i), Sup (s i) :=
le_antisymm
  (le_binfi $ λ i hi, Inf_le $ h.eventually_iff.2 ⟨i, hi, λ x, le_Sup⟩)
  (le_Inf $ assume a ha, let ⟨i, hi, ha⟩ := h.eventually_iff.1 ha in
    infi_le_of_le _ $ infi_le_of_le hi $ Sup_le ha)

theorem has_basis.Liminf_eq_supr_Inf {p : ι → Prop} {s : ι → set α} {f : filter α}
  (h : f.has_basis p s) : f.Liminf = ⨆ i (hi : p i), Inf (s i) :=
@has_basis.Limsup_eq_infi_Sup (order_dual α) _ _ _ _ _ h

theorem Limsup_eq_infi_Sup {f : filter α} : f.Limsup = ⨅ s ∈ f, Sup s :=
f.basis_sets.Limsup_eq_infi_Sup

theorem Liminf_eq_supr_Inf {f : filter α} : f.Liminf = ⨆ s ∈ f, Inf s :=
@Limsup_eq_infi_Sup (order_dual α) _ _

/-- In a complete lattice, the limsup of a function is the infimum over sets `s` in the filter
of the supremum of the function over `s` -/
theorem limsup_eq_infi_supr {f : filter β} {u : β → α} : f.limsup u = ⨅ s ∈ f, ⨆ a ∈ s, u a :=
(f.basis_sets.map u).Limsup_eq_infi_Sup.trans $
  by simp only [Sup_image, id]

lemma limsup_eq_infi_supr_of_nat {u : ℕ → α} : limsup at_top u = ⨅ n : ℕ, ⨆ i ≥ n, u i :=
(at_top_basis.map u).Limsup_eq_infi_Sup.trans $
  by simp only [Sup_image, infi_const]; refl

lemma limsup_eq_infi_supr_of_nat' {u : ℕ → α} : limsup at_top u = ⨅ n : ℕ, ⨆ i : ℕ, u (i + n) :=
by simp only [limsup_eq_infi_supr_of_nat, supr_ge_eq_supr_nat_add]

theorem has_basis.limsup_eq_infi_supr {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
  (h : f.has_basis p s) : f.limsup u = ⨅ i (hi : p i), ⨆ a ∈ s i, u a :=
(h.map u).Limsup_eq_infi_Sup.trans $ by simp only [Sup_image, id]

/-- In a complete lattice, the liminf of a function is the infimum over sets `s` in the filter
of the supremum of the function over `s` -/
theorem liminf_eq_supr_infi {f : filter β} {u : β → α} : f.liminf u = ⨆ s ∈ f, ⨅ a ∈ s, u a :=
@limsup_eq_infi_supr (order_dual α) β _ _ _

lemma liminf_eq_supr_infi_of_nat {u : ℕ → α} : liminf at_top u = ⨆ n : ℕ, ⨅ i ≥ n, u i :=
@limsup_eq_infi_supr_of_nat (order_dual α) _ u

lemma liminf_eq_supr_infi_of_nat' {u : ℕ → α} : liminf at_top u = ⨆ n : ℕ, ⨅ i : ℕ, u (i + n) :=
@limsup_eq_infi_supr_of_nat' (order_dual α) _ _

theorem has_basis.liminf_eq_supr_infi {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
  (h : f.has_basis p s) : f.liminf u = ⨆ i (hi : p i), ⨅ a ∈ s i, u a :=
@has_basis.limsup_eq_infi_supr (order_dual α) _ _ _ _ _ _ _ h

@[simp] lemma liminf_nat_add (f : ℕ → α) (k : ℕ) :
  at_top.liminf (λ i, f (i + k)) = at_top.liminf f :=
by { simp_rw liminf_eq_supr_infi_of_nat, exact supr_infi_ge_nat_add f k }

@[simp] lemma limsup_nat_add (f : ℕ → α) (k : ℕ) :
  at_top.limsup (λ i, f (i + k)) = at_top.limsup f :=
@liminf_nat_add (order_dual α) _ f k

lemma liminf_le_of_frequently_le' {α β} [complete_lattice β]
  {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, u a ≤ x) :
  f.liminf u ≤ x :=
begin
  rw liminf_eq,
  refine Sup_le (λ b hb, _),
  have hbx : ∃ᶠ a in f, b ≤ x,
  { revert h,
    rw [←not_imp_not, not_frequently, not_frequently],
    exact λ h, hb.mp (h.mono (λ a hbx hba hax, hbx (hba.trans hax))), },
  exact hbx.exists.some_spec,
end

lemma le_limsup_of_frequently_le' {α β} [complete_lattice β]
  {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, x ≤ u a) :
  x ≤ f.limsup u :=
@liminf_le_of_frequently_le' _ (order_dual β) _ _ _ _ h

end complete_lattice

section conditionally_complete_linear_order

lemma eventually_lt_of_lt_liminf {f : filter α} [conditionally_complete_linear_order β]
  {u : α → β} {b : β} (h : b < liminf f u) (hu : f.is_bounded_under (≥) u . is_bounded_default) :
  ∀ᶠ a in f, b < u a :=
begin
  obtain ⟨c, hc, hbc⟩ : ∃ (c : β) (hc : c ∈ {c : β | ∀ᶠ (n : α) in f, c ≤ u n}), b < c :=
    exists_lt_of_lt_cSup hu h,
  exact hc.mono (λ x hx, lt_of_lt_of_le hbc hx)
end

lemma eventually_lt_of_limsup_lt {f : filter α} [conditionally_complete_linear_order β]
  {u : α → β} {b : β} (h : limsup f u < b) (hu : f.is_bounded_under (≤) u . is_bounded_default) :
  ∀ᶠ a in f, u a < b :=
@eventually_lt_of_lt_liminf _ (order_dual β) _ _ _ _ h hu

lemma liminf_le_of_frequently_le  {α β} [conditionally_complete_linear_order β] {f : filter α}
  {u : α → β}  {b : β} (hu_le : ∃ᶠ x in f, u x ≤ b)
  (hu : f.is_bounded_under (≥) u . is_bounded_default) :
  f.liminf u ≤ b :=
@le_limsup_of_frequently_le _ (order_dual β) _ f u b hu_le hu

end conditionally_complete_linear_order

end filter

section order
open filter

lemma galois_connection.l_limsup_le {α β γ} [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {v : α → β}
  {l : β → γ} {u : γ → β} (gc : galois_connection l u)
  (hlv : f.is_bounded_under (≤) (λ x, l (v x)) . is_bounded_default)
  (hv_co : f.is_cobounded_under (≤) v . is_bounded_default) :
  l (f.limsup v) ≤ f.limsup (λ x, l (v x)) :=
begin
  refine le_Limsup_of_le hlv (λ c hc, _),
  rw filter.eventually_map at hc,
  simp_rw (gc _ _) at hc ⊢,
  exact Limsup_le_of_le hv_co hc,
end

lemma order_iso.limsup_apply {γ} [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {u : α → β} (g : β ≃o γ)
  (hu : f.is_bounded_under (≤) u . is_bounded_default)
  (hu_co : f.is_cobounded_under (≤) u . is_bounded_default)
  (hgu : f.is_bounded_under (≤) (λ x, g (u x)) . is_bounded_default)
  (hgu_co : f.is_cobounded_under (≤) (λ x, g (u x)) . is_bounded_default) :
  g (f.limsup u) = f.limsup (λ x, g (u x)) :=
begin
  refine le_antisymm (g.to_galois_connection.l_limsup_le hgu hu_co) _,
  rw [←(g.symm.symm_apply_apply (f.limsup (λ (x : α), g (u x)))), g.symm_symm],
  refine g.monotone _,
  have hf : u = λ i, g.symm (g (u i)), from funext (λ i, (g.symm_apply_apply (u i)).symm),
  nth_rewrite 0 hf,
  refine g.symm.to_galois_connection.l_limsup_le _ hgu_co,
  simp_rw g.symm_apply_apply,
  exact hu,
end

lemma order_iso.liminf_apply {γ} [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {u : α → β} (g : β ≃o γ)
  (hu : f.is_bounded_under (≥) u . is_bounded_default)
  (hu_co : f.is_cobounded_under (≥) u . is_bounded_default)
  (hgu : f.is_bounded_under (≥) (λ x, g (u x)) . is_bounded_default)
  (hgu_co : f.is_cobounded_under (≥) (λ x, g (u x)) . is_bounded_default) :
  g (f.liminf u) = f.liminf (λ x, g (u x)) :=
@order_iso.limsup_apply α (order_dual β) (order_dual γ) _ _ f u g.dual hu hu_co hgu hgu_co

end order


import .form ..clause

namespace int

@[omega] def push_neg : form → form
| (p ∨* q) := (push_neg p) ∧* (push_neg q)
| (p ∧* q) := (push_neg p) ∨* (push_neg q)
| (¬*p)    := p
| p        := ¬* p

lemma push_neg_equiv :
  ∀ {p}, form.equiv (push_neg p) (¬* p) :=
begin
  form.induce `[intros v; try {refl}],
  { simp_omega [classical.not_not] },
  { simp only [form.holds, push_neg, not_or_distrib, ihp v, ihq v] },
  { simp only [form.holds, push_neg, classical.not_and_distrib, ihp v, ihq v] }
end

def nnf : form → form
| (¬* p)   := push_neg (nnf p)
| (p ∨* q) := (nnf p) ∨* (nnf q)
| (p ∧* q) := (nnf p) ∧* (nnf q)
| a        := a

def is_nnf : form → Prop
| (t =* s) := true
| (t ≤* s) := true
| ¬*(t =* s) := true
| ¬*(t ≤* s) := true
| (p ∨* q) := is_nnf p ∧ is_nnf q
| (p ∧* q) := is_nnf p ∧ is_nnf q
| _ := false

lemma is_nnf_push_neg : ∀ p, is_nnf p → is_nnf (push_neg p) :=
begin
  form.induce `[intro h1; try {trivial}],
  { cases p; try {cases h1}; trivial },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption }
end

def neg_free : form → Prop
| (t =* s) := true
| (t ≤* s) := true
| (p ∨* q) := neg_free p ∧ neg_free q
| (p ∧* q) := neg_free p ∧ neg_free q
| _        := false

lemma is_nnf_nnf : ∀ p, is_nnf (nnf p) :=
begin
  form.induce `[try {trivial}],
  { apply is_nnf_push_neg _ ih },
  { constructor; assumption },
  { constructor; assumption }
end

lemma nnf_equiv : ∀ {p : form}, form.equiv (nnf p) p :=
begin
  form.induce `[intros v; try {refl}; simp only [nnf]],
  { rw push_neg_equiv,
    apply not_iff_not_of_iff, apply ih },
  { apply or_iff_or (ihp v) (ihq v) },
  { apply and_iff_and (ihp v) (ihq v) }
end

@[omega] def neg_elim : form → form
| (¬* (t =* s)) := (t.succ ≤* s) ∨* (s.succ ≤* t)
| (¬* (t ≤* s)) := s.succ ≤* t
| (p ∨* q) := (neg_elim p) ∨* (neg_elim q)
| (p ∧* q) := (neg_elim p) ∧* (neg_elim q)
| p        := p

lemma neg_free_neg_elim : ∀ p, is_nnf p → neg_free (neg_elim p) :=
begin
  form.induce `[intro h1, try {simp only [neg_free, neg_elim]}, try {trivial}],
  { cases p; try {cases h1}; try {trivial},
    constructor; trivial },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption },
  { cases h1, constructor; [{apply ihp}, {apply ihq}]; assumption }
end

lemma le_and_le_iff_eq {α : Type} [partial_order α] {a b : α} :
  (a ≤ b ∧ b ≤ a) ↔ a = b :=
begin
  constructor; intro h1,
  { cases h1, apply le_antisymm; assumption },
  { constructor; apply le_of_eq; rw h1  }
end

lemma implies_neg_elim : ∀ {p : form}, form.implies p (neg_elim p) :=
begin
  form.induce `[intros v h, try {apply h}],
  { cases p with t s t s; try {apply h},
    { simp_omega [le_and_le_iff_eq.symm,
        classical.not_and_distrib, not_le] at h,
      simp_omega [int.add_one_le_iff], rw or.comm, assumption },
    { simp_omega [not_le, int.add_one_le_iff] at *, assumption} },
  { simp only [neg_elim], cases h; [{left, apply ihp},
    {right, apply ihq}]; assumption },
  { apply and_of_and (ihp _) (ihq _) h }
end

@[omega] def dnf_core : form → list clause
| (p ∨* q) := (dnf_core p) ++ (dnf_core q)
| (p ∧* q) :=
  (list.product (dnf_core p) (dnf_core q)).map
  (λ pq, clause.append pq.fst pq.snd)
| (t =* s) := [([term.sub (canonize s) (canonize t)],[])]
| (t ≤* s) := [([],[term.sub (canonize s) (canonize t)])]
| (¬* _)   := []

def dnf (p : form) : list clause :=
dnf_core $ neg_elim $ nnf p

lemma exists_clause_holds {v} :
  ∀ {p : form}, neg_free p → p.holds v → ∃ c ∈ (dnf_core p), clause.holds v c :=
begin
  form.induce `[intros h1 h2],
  { apply list.exists_mem_cons_of, constructor,
    { simp_omega at h2, rw [list.forall_mem_singleton], simp_omega [h2] },
    { apply list.forall_mem_nil } },
  { apply list.exists_mem_cons_of, constructor,
    { apply list.forall_mem_nil },
    { simp_omega at h2, rw [list.forall_mem_singleton],
      simp_omega, rw [le_sub, sub_zero], assumption } },
    { cases h1 },
    { cases h2 with h2 h2;
      [ {cases (ihp h1.left h2) with c h3},
        {cases (ihq h1.right h2) with c h3}];
      cases h3 with h3 h4;
      refine ⟨c, list.mem_append.elim_right _, h4⟩;
      [left,right]; assumption },
    { rcases (ihp h1.left h2.left) with ⟨cp, hp1, hp2⟩,
      rcases (ihq h1.right h2.right) with ⟨cq, hq1, hq2⟩,
      constructor, constructor,
      simp_omega, rw list.mem_map,
      constructor, constructor,
      rw list.mem_product, constructor; assumption, refl,
      apply clause.holds_append; assumption }
end

lemma clauses_sat_dnf_core {p : form} :
  neg_free p → p.sat → clauses.sat (dnf_core p) :=
begin
  intros h1 h2, cases h2 with v h2,
  rcases (exists_clause_holds h1 h2) with ⟨c,h3,h4⟩,
  refine ⟨c,h3,v,h4⟩
end

lemma unsat_of_clauses_unsat {p : form} :
clauses.unsat (dnf p) → p.unsat :=
begin
  intros h1 h2, apply h1,
  apply clauses_sat_dnf_core,
  apply neg_free_neg_elim _ (is_nnf_nnf _),
  apply form.sat_of_implies_of_sat implies_neg_elim,
  have hrw := exists_iff_exists (@nnf_equiv p),
  apply hrw.elim_right h2
end

#exit
@[omega] def dnf_core : form → list polytope
| (p ∨* q) := (dnf_core p) ++ (dnf_core q)
| (p ∧* q) :=
  (list.product (dnf_core p) (dnf_core q)).map (λ pq, pq.fst ++ pq.snd)
| (t =* s) :=
  [[term.sub (canonize s) (canonize t),
    term.sub (canonize t) (canonize s)]]
| (t ≤* s) := [[term.sub (canonize s) (canonize t)]]
| (¬* _)   := []

def dnf (p : form) : list polytope :=
dnf_core $ nf $ nnf p

lemma exists_polytope_holds {v} :
  ∀ {p : form}, neg_free p → p.holds v → ∃ c ∈ (dnf_core p), polytope.holds v c :=
begin
  form.induce `[intros h1 h2],
  { apply list.exists_mem_cons_of, --constructor,
    simp only [polytope.holds], rw list.forall_mem_cons, constructor,
    { simp_omega at *, rw [h2, sub_self] },
    { rw list.forall_mem_singleton, simp_omega at *, rw [h2, sub_self] } },
  { apply list.exists_mem_cons_of,
    simp only [polytope.holds], rw list.forall_mem_singleton,
    simp_omega at *, rw [le_sub, sub_zero], assumption },
    { cases h1 },
    { cases h2 with h2 h2;
      [ {cases (ihp h1.left h2) with c h3},
        {cases (ihq h1.right h2) with c h3}];
      cases h3 with h3 h4;
      refine ⟨c, list.mem_append.elim_right _, h4⟩;
      [left,right]; assumption },
    { rcases (ihp h1.left h2.left) with ⟨cp, hp1, hp2⟩,
      rcases (ihq h1.right h2.right) with ⟨cq, hq1, hq2⟩,
      constructor, constructor,
      simp_omega, rw list.mem_map,
      constructor, constructor,
      rw list.mem_product, constructor; assumption, refl,
      simp only [polytope.holds, list.forall_mem_append],
      apply and.intro hp2 hq2 }
end

lemma exists_polytope_sat {p : form} :
  neg_free p → p.sat → ∃ c ∈ (dnf_core p), polytope.sat c :=
begin
  intros h1 h2, cases h2 with v h2,
  rcases (exists_polytope_holds h1 h2) with ⟨c,h3,h4⟩,
  refine ⟨c,h3,v,h4⟩
end

lemma unsat_of_unsat_dnf {p : form} :
polytopes.unsat (dnf p) → p.unsat :=
begin
  intros h1 h2,
  dsimp only [polytopes.unsat] at h1,
  rw ← list.not_exists_mem_not at h1,
  apply h1,
  simp only [polytope.unsat, classical.not_not],
  apply exists_polytope_sat (neg_free_nf _ (is_nnf_nnf _)),
  apply form.sat_of_implies_of_sat implies_nf,
  have hrw := exists_iff_exists (@nnf_equiv p),
  apply hrw.elim_right h2
end

end int


import data.rat.basic
import data.int.basic
import data.nat.basic
import algebra.field
import linear_algebra.finsupp
import ring_theory.polynomial
import ring_theory.algebra
import ring_theory.adjoin_root
import ring_theory.ideals
import algebra.module
import algebra.char_zero
import linear_algebra.finite_dimensional
import tactic.tidy
import tactic.library_search

instance rat_algebra.vector_space {K : Type*} [ring K] [algebra ℚ K] :
  vector_space ℚ K := by apply_instance

instance char_zero.rat_algebra (K : Type*) [discrete_field K] [char_zero K] : algebra ℚ K :=
{ smul := λ q r, q * r,
  one_smul := λ x, begin simp only [rat.cast_one], exact one_mul _, end,
  mul_smul := λ x y b, begin simp only [rat.cast_mul], exact mul_assoc _ _ _ end,
  smul_add := λ x y b, begin simp only, exact mul_add _ _ _ end,
  smul_zero := λ x, begin simp only, exact mul_zero _ end,
  add_smul := λ x y b, begin simp only [rat.cast_add], exact add_mul _ _ _ end,
  zero_smul := λ x, begin simp only [rat.cast_zero], exact zero_mul _ end,
  to_fun := rat.cast,
  hom := { map_one := rat.cast_one,
  map_mul := rat.cast_mul,
  map_add := rat.cast_add },
  commutes' := λ x y, mul_comm y (rat.cast x),
  smul_def' := λ x y, rfl }

class number_field (K : Type*) extends discrete_field K :=
(char_zero : char_zero K)
(fin_dim : finite_dimensional ℚ K)

def real_embs (K : Type*) [number_field K] := { f : K → ℝ // is_field_hom f}

instance : number_field ℚ := {
  char_zero := linear_ordered_semiring.to_char_zero,
  fin_dim := begin
    apply finite_dimensional.of_fg,
    use {1},
    unfold submodule.span,
    simp only [submodule.mem_coe, lattice.Inf_eq_top, finset.insert_empty_eq_singleton,
      finset.coe_singleton, set.mem_set_of_eq, set.singleton_subset_iff],
    intros a h,
    ext,
    split,
    {intro hx, exact set.mem_univ x,},
    {
      intro hx,
      have := a.smul x h,
      simp only [has_scalar.smul, mul_one, rat.cast_id] at this,
      assumption,
    },
  end,
  ..show discrete_field ℚ, by apply_instance,
}

variables (f : polynomial ℚ) (h : irreducible f)
include h

lemma nat_coe_eq_nat_rat_coe (m : ℕ) : (m : adjoin_root f) = (m : ℚ) :=
begin
  induction m,
  {
    change 0 = adjoin_root.of (0 : ℚ),
    simpa [adjoin_root.of],
  },
  {
    simp only [add_comm, nat.cast_succ],
    rw [adjoin_root.is_ring_hom.map_add, adjoin_root.is_ring_hom.map_one, m_ih],
  }
end

instance adjoin_root.is_add_group_hom : is_add_group_hom (@adjoin_root.mk _ _ _ f) :=
by apply_instance

noncomputable instance : number_field (adjoin_root f) := {
  char_zero := { cast_inj := λ m n,
    begin split,
    {
      intro h1,
      rw nat_coe_eq_nat_rat_coe f h m at h1,
      rw nat_coe_eq_nat_rat_coe f h n at h1,
      unfold_coes at h1,
      have := (@adjoin_root.coe_injective ℚ _ f _ ) m n h1,
      exact (@nat.cast_injective ℚ _ _ _) m n this,
    },
    {
      intro h,
      rwa h,
    }
    end
  },
  fin_dim :=
  begin
    apply finite_dimensional.of_fg,
    unfold submodule.fg,
    let X := (@adjoin_root.root _ _ _ f),
    let d := polynomial.degree f,
    let dnat := polynomial.nat_degree f,
    use (finset.image (λ i, X^i) (finset.range dnat)),
    simp only [finset.coe_image],
    ext g,
    split,
    {
      intro hx,
      simp only [submodule.mem_top],
    },
    {
      simp only [⊤, forall_prop_of_true, submodule.mem_top],
      --induction x using quotient.induction_on' <- doesn't do the same thing!?
      apply quotient.induction_on' g,
      intro x,
      have : quotient.mk' x = ideal.quotient.mk (ideal.span {f}) x := rfl,
      rw this,
      have := euclidean_domain.div_add_mod x f,
      conv_lhs
      begin
        congr,
        rw ← this,
      end,
      have : ideal.quotient.mk (ideal.span {f}) f = 0 := adjoin_root.mk_self,
      simp only [add_comm, ideal.quotient.mk_mul, ideal.quotient.mk_add, this, zero_mul, add_zero],
      -- TODO why doesn't simp do `this` for me?
      let mo := x % f,
      have modeg: polynomial.degree mo < d :=
        euclidean_domain.mod_lt _ (ne_zero_of_irreducible h),
      rw finsupp.mem_span_iff_total,
      use [mo],
      simp only [exists_prop],
      split,
      {
        rw finsupp.mem_supported,
        have := polynomial.degree_eq_nat_degree (ne_zero_of_irreducible h),
        unfold_coes,
        change polynomial.degree mo < polynomial.degree f at modeg,
        rw [this] at modeg,
        have : mo.support ⊆ (finset.range dnat) := begin
          rw finset.subset_iff,
          intros ll hll,
          rw finset.mem_range,
          have : ↑ ll ≤ polynomial.degree mo := finset.le_sup hll,
          have : ↑ ll < (dnat: with_bot ℕ) := lt_of_le_of_lt this modeg,
          exact with_bot.coe_lt_coe.mp this
        end,
        exact finset.subset_iff.mpr this,
      },
      {
        rw finsupp.total_apply,
        rw ← polynomial.sum_C_mul_X_eq (x % f),
        rw finsupp.sum,
        rw finsupp.sum,
        rw is_add_group_hom.finset_sum (ideal.quotient.mk (ideal.span {f})) _ ((x % f).support),
        simp only [ideal.quotient.mk_pow, function.comp_app, ideal.quotient.mk_mul],
        {
          simp [(•)],
          unfold_coes,
          have : ((λ (a : ℕ), rat.cast ((mo.to_fun : ℕ → ℚ) a) * X ^ a) : ℕ → adjoin_root f)= (λ (x_1 : ℕ),
          adjoin_root.mk (polynomial.C   (((x % f).to_fun  : ℕ → ℚ) x_1)) *
            adjoin_root.mk (polynomial.X) ^ x_1) :=
          begin
            ext,
            have : (rat.cast (mo.to_fun x_1) : adjoin_root f) = (mo.to_fun x_1) :=
            begin
              unfold_coes,
              unfold adjoin_root.of,
              apply rat.eq_cast,
              sorry,
            end,
            rw this,
            refl,
          end,
          conv_lhs
          begin
            congr,
            skip,
            rw this,
          end,
          refl,
        },
        exactI adjoin_root.is_add_group_hom f h,
      }
    },
  end,
  ..show discrete_field _, by apply_instance,
   }


import data.list
import tactic
import data.finset
import misc_mathlib

/-- Define all subsequences that (1) ends at an index and (2) are pairwise following a
  relation (This will in our case be `≤` and `≥`). -/
def subsequences_ending
{X : Type*} [decidable_eq X]
{A : list X}
{n : ℕ}
(h : n < A.length)
(r : X → X → Prop) [decidable_rel r]
: list (list X)
:= (A.take n.succ).sublists.filter (λ l, A.nth_le n h ∈ l.last' ∧ l.pairwise r)

/- Our definition of `subsequences_ending` has the properties we want -/
theorem is_sublist
{X : Type*} [decidable_eq X]
{A l : list X}
{n : ℕ}
(h : n < A.length)
(R : X → X → Prop) [decidable_rel R]
(l_in : l ∈ subsequences_ending h R)
: l <+ A ∧ l.pairwise R
:= begin
  obtain ⟨rest, ⟨_, pairw⟩⟩ := list.mem_filter.mp l_in,
  rw list.mem_sublists at rest,
  exact ⟨sublist_take_mp_sublist A l n.succ rest, pairw⟩,
end

theorem index_singleton_mem_finset
{X : Type*} [decidable_eq X]
{A : list X}
{n1 : ℕ}
(h1 : n1 < A.length)
(r : X → X → Prop) [decidable_rel r]
: [A.nth_le n1 h1] ∈ (subsequences_ending h1 r).to_finset
:= begin
  refine list.mem_to_finset.mpr _,
  dsimp [subsequences_ending],
  rw list.mem_filter,
  split,
  { refine list.mem_sublists.mpr (list.singleton_sublist.mpr _),
    rw (list.nth_le_take A h1 (lt_add_one n1)),
    exact list.nth_le_mem (list.take (n1.succ) A) n1 _, },
  { exact ⟨rfl, list.pairwise_singleton r (list.nth_le A n1 h1)⟩, },
end

theorem largest_subsequence_ending_ne_zero
{X : Type*} [decidable_eq X]
{A : list X}
{n : ℕ}
(h1 : n < A.length)
(r : X → X → Prop) [decidable_rel r]
: ((subsequences_ending h1 r).to_finset).sup list.length ≠ 0
:= begin
  rw [(finset.insert_eq_of_mem (index_singleton_mem_finset h1 r)).symm, finset.sup_insert],
  exact ne_of_gt (le_max_left 1 (finset.sup _ list.length)),
end

theorem subsequences_ending_increasing
{X : Type*} [decidable_eq X]
{A : list X}
{n1 n2 : ℕ}
(h1 : n1 < A.length)
(h2 : n2 < A.length)
(h3 : n1 < n2)
(r : X → X → Prop) [decidable_rel r]
(r_trans : transitive r)
(h4 : r (A.nth_le n1 h1) (A.nth_le n2 h2))
: ((subsequences_ending h1 r).to_finset).sup list.length < ((subsequences_ending h2 r).to_finset).sup list.length
:= begin
  obtain ⟨a, b, c⟩ := finset.exists_mem_eq_sup ((subsequences_ending h1 r).to_finset) _ list.length,
  { let newer := a.concat (A.nth_le n2 h2),
    have newer_in : newer ∈ (subsequences_ending h2 r).to_finset,
    { have kkk := list.mem_to_finset.mp b,
      dsimp [subsequences_ending] at kkk,
      rw list.mem_filter at kkk,
      apply list.mem_to_finset.mpr,
      dsimp [subsequences_ending],
      rw list.mem_filter,
      have thiny : newer = a ++ [A.nth_le n2 h2] := list.concat_eq_append (list.nth_le A n2 h2) a,
      split,
      { have newer_sub: newer <+ list.take n2.succ A := sublist_of_take_concat_sublist_of_take h2 h3 (list.mem_sublists.mp kkk.1),
        exact list.mem_sublists.mpr newer_sub, },
      { split,
        { dsimp [newer],
          rw list.concat_eq_append (list.nth_le A n2 h2) a,
          rw list.last'_append_of_ne_nil _ (list.cons_ne_nil (list.nth_le A n2 h2) list.nil),
          exact rfl, },
        { apply (list.chain'_iff_pairwise r_trans).mp _,
          apply list_chain_concat,
          { exact (list.chain'_iff_pairwise r_trans).mpr kkk.2.2, },
          { intros _ ku_in,
            rw option.mem_unique ku_in kkk.2.1,
            exact h4, } } } },
    rw c,
    have gflggl : a.length < newer.length := by { rw list.length_concat _ _, exact lt_add_one (list.length a),},
    exact gt_of_ge_of_gt (finset.le_sup newer_in) gflggl, },
  exact ⟨[A.nth_le n1 h1], index_singleton_mem_finset h1 r⟩,
end

theorem subsequence_sup_short_exist
{X : Type*} [decidable_eq X]
{A : list X}
{n : ℕ}
(h : n < A.length)
(r : ℕ)
(R : X → X → Prop) [decidable_rel R]
(kk : (subsequences_ending h R).to_finset.sup list.length = r)
{nnn : ℕ}
(nle : nnn ≤ r)
: ∃ l, l <+ A ∧ l.length = nnn ∧ l.pairwise R
:= begin
  obtain ⟨aaa, memming, lenning⟩ := finset.exists_mem_eq_sup ((subsequences_ending h R).to_finset) _ list.length,
  { obtain ⟨aaa_pre, aaa_pairwise⟩ := is_sublist h R (list.mem_to_finset.mp memming),
    refine ⟨aaa.take nnn, _, _, _⟩,
    { exact list.sublist.trans (list.sublist_of_prefix (list.take_prefix nnn aaa)) aaa_pre, },
    { rw [list.length_take, lenning.symm, kk, min_eq_left_iff],
      exact nle, },
    { have take_sublist := list.sublist_of_prefix (list.take_prefix nnn aaa),
      exact list.pairwise_of_sublist take_sublist aaa_pairwise, } },
  exact ⟨[A.nth_le n h], index_singleton_mem_finset h R⟩,
end

theorem subsequences_ending_image
{X : Type*} [decidable_eq X]
{A : list X}
{x : ℕ}
(x_le : x < A.length)
(k : ℕ)
(R : X → X → Prop) [decidable_rel R]
(h : transitive R)
(h1: ∀ (x : list X), ¬(x <+ A ∧ x.length = k ∧ list.pairwise R x))
: (subsequences_ending x_le R).to_finset.sup list.length ∈ finset.range k \ {0}
:= begin
  apply finset.mem_sdiff.mpr,
  split,
  { rw finset.mem_range,
    by_contradiction,
    simp only [fin.val_eq_coe, not_lt] at h,
    let lenner := (subsequences_ending x_le R).to_finset.sup list.length,
    obtain ⟨ll, h_ll⟩ := subsequence_sup_short_exist x_le lenner R rfl h,
    exact (h1 ll) h_ll, },
  { apply finset.not_mem_singleton.mpr,
    exact largest_subsequence_ending_ne_zero x_le R, }
end

/- **Erdős–Szekeres theorem** -/
theorem erdos_szekeres
{X : Type*} [linear_order X]
(A : list X)
(r s : ℕ)
(h : (r-1)*(s-1) < A.length)
:   (∃ (R : list X), R <+ A ∧ R.length = r ∧ R.pairwise (≤))
  ∨ (∃ (S : list X), S <+ A ∧ S.length = s ∧ S.pairwise (≥))
:= begin
  by_cases hr : (1 ≤ r),
  by_cases hs : (1 ≤ s),

  -- We assume the sequences don't exist.
  { by_contradiction,
    simp only [not_or_distrib, not_exists] at h,
    cases h,

    -- Label each number nᵢ in the sequence with the pair (aᵢ, bᵢ), where aᵢ is
    -- the length of the longest monotonically increasing subsequence ending with
    -- nᵢ and bᵢ is the length of the longest monotonically decreasing subsequence
    -- ending with nᵢ
    let f := (λ (i : (fin (A.length))), ((subsequences_ending i.2 (≤)).to_finset.sup list.length, (subsequences_ending i.2 (≥)).to_finset.sup list.length) ),
    let B := (list.fin_range A.length).map f,
    have aaaa: B.length = (list.fin_range A.length).length := by {dsimp [B], exact list.length_map f (list.fin_range (A.length)), },
    have se: A.length = B.length := (finset.card_fin A.length).symm.trans aaaa.symm,

    -- Each two numbers in the sequence are labeled with a different pair
    have B_nodup : B.nodup,
    { unfold list.nodup,
      apply list.pairwise_iff_nth_le.mpr,
      intros ii jj hhj hh2,
      let bi                    := B.nth_le ii (lt_trans hh2 hhj),
      let bj                    := B.nth_le jj hhj,
      have hhi  : ii < B.length := lt_trans hh2 hhj,
      have hhia : ii < A.length := by {rw se, exact hhi},
      have hhja : jj < A.length := by {rw se, exact hhj},
      have hhfi : ii < (list.fin_range A.length).length := by {rw [ list.length_fin_range, se ], exact hhi,},
      have hhfj : jj < (list.fin_range A.length).length := by {rw [ list.length_fin_range, se ], exact hhj,},
      apply (prod_ne_iff_right_or_left_ne bi bj).mp,
      dsimp [bj, bi],
      by_cases lt_ind : (A.nth_le ii hhia ≤ A.nth_le jj hhja),
      refine or.inl _,
      rotate,
      refine or.inr _,
      all_goals
      { refine ne_of_lt _,
        rw [list.nth_le_map _ hhj hhfj, list.nth_le_map _ hhi hhfi],
        simp only [list.nth_le_fin_range], },
      exact subsequences_ending_increasing hhia hhja hh2 (≥) (@ge_trans X _) (le_of_not_ge lt_ind),
      exact subsequences_ending_increasing hhia hhja hh2 (≤) preorder.le_trans lt_ind, },

    let values : finset (ℕ × ℕ) := ⟨↑B, B_nodup⟩,
    have v_card : values.card = A.length := eq.symm se,
    let poss_values : finset (ℕ × ℕ) := finset.product ((finset.range r) \ {0}) ((finset.range s) \ {0}),
    have pv_card: poss_values.card = (r-1)*(s-1),
    { rw [finset.card_product, ←finset.range_one, finset.card_sdiff (finset.range_subset.mpr hr), finset.card_sdiff (finset.range_subset.mpr hs)],
      repeat { rw finset.card_range, }, },

    have hc : poss_values.card < values.card := by {rw [v_card, pv_card], exact h, },

    -- But there are only (r − 1)(s − 1) possible labels if aᵢ is at most r − 1 and bᵢ is at most s − 1
    have incl : ∀ x ∈ values, x ∈ poss_values,
    { intros xx xx_in_ttt,
      apply finset.mem_product.mpr,
      obtain ⟨xx_ind, _, uuuu⟩ := list.mem_map.mp (finset.mem_def.mp xx_in_ttt),
      rw ←uuuu,
      split,
      { exact subsequences_ending_image xx_ind.2 r (≤) preorder.le_trans h_left },
      { exact subsequences_ending_image xx_ind.2 s (≥) (@ge_trans X _) h_right }, },

    -- By the pigeonhole principle, two pairs must have the same value to fit in the range.
    obtain ⟨x, _, y, _, h⟩ := @finset.exists_ne_map_eq_of_card_lt_of_maps_to _ _ _ _ hc id incl,
    -- Contradiction
    exact (not_and_self (x = y)).mp h, },

  -- Special cases when s=0 ...
  { have s_eq_zero : s = 0, { linarith },
    refine or.inr (exists.intro list.nil _),
    rw s_eq_zero,
    exact ⟨list.nil_sublist A, rfl, list.pairwise.nil⟩, },
  -- ... or r=0
  { have r_eq_zero : r = 0, { linarith },
    refine or.inl (exists.intro list.nil _),
    rw r_eq_zero,
    exact ⟨list.nil_sublist A, rfl, list.pairwise.nil⟩, }

end

theorem erdos_szekeres'
{X : Type*} [linear_order X]
(A : list X)
: ∃ (R : list X), R <+ A ∧ R.length = A.length.sqrt ∧ (R.pairwise (≤) ∨ R.pairwise (≥))
:= begin
  let l := A.length.sqrt,
  by_cases h : 1 ≤ A.length,
  { have one_le2 : A.length.sqrt ≠ 0 := mt (nat.sqrt_eq_zero).mp (ne_of_gt h),
    have leee := calc
            (A.length.sqrt - 1) * (A.length.sqrt - 1)
          ≤ A.length.sqrt * (A.length.sqrt - 1)       : nat_mul_sub_left_le A.length.sqrt (A.length.sqrt - 1)
      ... < A.length.sqrt * A.length.sqrt             : nat_mul_sub_right_lt one_le2 one_le2
      ... ≤ A.length                                  : (list.length A).sqrt_le,
    have list_erdos := erdos_szekeres A (A.length.sqrt) (A.length.sqrt) leee,
    cases list_erdos,
    { obtain ⟨R, rl, rp, pw⟩ := list_erdos,
      exact ⟨R, rl, rp, (or.inl pw)⟩, },
    { obtain ⟨R, rl, rp, pw⟩ := list_erdos,
      exact ⟨R, rl, rp, (or.inr pw)⟩, }, },
  { have len_eq_zero : A.length = 0 := by omega,
    rw (nat.sqrt_eq_zero.mpr len_eq_zero),
    exact ⟨list.nil, (list.nil_sublist A), (list.length_eq_zero.mpr rfl), (or.inl list.pairwise.nil)⟩, }
end

theorem finset_from_list_properties
{X Y: Type*} [linear_order X]
(A : finset X)
(r : ℕ)
(r1 : Y → Y → Prop)
(r1_refl : reflexive r1)
(f : X → Y)
(cses : ∃ (Rl : list Y), Rl <+ (A.sort (≤)).map f ∧ Rl.length = r ∧ list.pairwise r1 Rl)
: ∃ R ⊆ A, R.card = r ∧ ∀ (x ∈ R) (y ∈ R), x ≤ y → r1 (f x) (f y)
:= begin
  let li := (A.sort (≤)).map f,
  have bef_sorted     := finset.sort_sorted (≤) A,
  have bef_nodup      := finset.sort_nodup (≤) A,
  obtain ⟨r_list, r_list_sub, r_list_len, r_list_pairwise⟩ := cses,
  obtain ⟨bef_sub, bef_sub_sub, bef_sub_map_eq_r_list⟩ := sublist_map_exists r_list_sub,
  have bef_sub_sorted := list.pairwise_of_sublist bef_sub_sub bef_sorted,
  have bef_sub_nodup  := list.nodup_of_sublist bef_sub_sub bef_nodup,
  have yeppers        := finset_sort_idempotent bef_sub_sorted bef_sub_nodup,
  let bef_sub_set     := bef_sub.to_finset,

  have bef_sub_set_sub : bef_sub_set ⊆ A,
  { intros _ xx_in,
    refine (finset.mem_sort (≤)).mp _,
    refine list.subset_def.mp (list.sublist.subset bef_sub_sub) _,
    exact list.mem_to_finset.mp xx_in, },
  have len : bef_sub_set.card = r,
  { rw [←r_list_len, ←bef_sub_map_eq_r_list, bef_sub.length_map f, ←yeppers],
    exact (finset.length_sort (≤)).symm, },
  refine ⟨bef_sub_set, bef_sub_set_sub, len, _⟩,
  { intros xx xx_in yy yy_in xx_le_yy,
    have xx_in' : xx ∈ bef_sub := list.mem_to_finset.mp xx_in,
    have yy_in' : yy ∈ bef_sub := list.mem_to_finset.mp yy_in,
    rw ←bef_sub_map_eq_r_list at r_list_pairwise,
    exact @pair_from_pairwise_to_pair_from_map X Y bef_sub f (≤) (@le_antisymm X _) r1 r1_refl bef_sub_sorted r_list_pairwise _ _ xx_in' yy_in' xx_le_yy,
    },
end

/- An indexed version of Erdős–Szekeres theorem -/
theorem erdos_szekeres''
{X Y: Type*} [linear_order X] [linear_order Y]
(r s : ℕ)
(A : finset X)
(h : (r-1)*(s-1) < A.card)
(f : X → Y)
: (∃ R ⊆ A, R.card = r ∧ ∀ (x ∈ R) (y ∈ R), x ≤ y → f x ≤ f y)
∨ (∃ S ⊆ A, S.card = s ∧ ∀ (x ∈ S) (y ∈ S), x ≤ y → f y ≤ f x)
:= begin
  let li := (A.sort (≤)).map f,
  have ye : (r - 1) * (s - 1) < li.length := by { rw [list.length_map, finset.length_sort], exact h, },
  have cses := erdos_szekeres li r s ye,
  cases cses,
  { exact or.inl (finset_from_list_properties A r (≤) (@le_rfl Y _) f cses), },
  { exact or.inr (finset_from_list_properties A s (≥) (@le_rfl Y _) f cses), },
end


/-
Copyright (c) 2021 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.normed_space.exponential
import analysis.calculus.fderiv_analytic
import data.complex.exponential
import topology.metric_space.cau_seq_filter

/-!
# Calculus results on exponential in a Banach algebra

In this file, we prove basic properties about the derivative of the exponential map `exp 𝕂`
in a Banach algebra `𝔸` over a field `𝕂`. We keep them separate from the main file
`analysis/normed_space/exponential` in order to minimize dependencies.

## Main results

We prove most result for an arbitrary field `𝕂`, and then specialize to `𝕂 = ℝ` or `𝕂 = ℂ`.

### General case

- `has_strict_fderiv_at_exp_zero_of_radius_pos` : `exp 𝕂` has strict Fréchet-derivative
  `1 : 𝔸 →L[𝕂] 𝔸` at zero, as long as it converges on a neighborhood of zero
  (see also `has_strict_deriv_at_exp_zero_of_radius_pos` for the case `𝔸 = 𝕂`)
- `has_strict_fderiv_at_exp_of_lt_radius` : if `𝕂` has characteristic zero and `𝔸` is commutative,
  then given a point `x` in the disk of convergence, `exp 𝕂` as strict Fréchet-derivative
  `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at x (see also `has_strict_deriv_at_exp_of_lt_radius` for the case
  `𝔸 = 𝕂`)

### `𝕂 = ℝ` or `𝕂 = ℂ`

- `has_strict_fderiv_at_exp_zero` : `exp 𝕂` has strict Fréchet-derivative `1 : 𝔸 →L[𝕂] 𝔸` at zero
  (see also `has_strict_deriv_at_exp_zero` for the case `𝔸 = 𝕂`)
- `has_strict_fderiv_at_exp` : if `𝔸` is commutative, then given any point `x`, `exp 𝕂` as strict
  Fréchet-derivative `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at x (see also `has_strict_deriv_at_exp` for the
  case `𝔸 = 𝕂`)

### Compatibilty with `real.exp` and `complex.exp`

- `complex.exp_eq_exp_ℂ` : `complex.exp = exp ℂ ℂ`
- `real.exp_eq_exp_ℝ` : `real.exp = exp ℝ ℝ`

-/

open filter is_R_or_C continuous_multilinear_map normed_field asymptotics
open_locale nat topological_space big_operators ennreal

section any_field_any_algebra

variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_ring 𝔸] [normed_algebra 𝕂 𝔸]
  [complete_space 𝔸]

/-- The exponential in a Banach-algebra `𝔸` over a normed field `𝕂` has strict Fréchet-derivative
`1 : 𝔸 →L[𝕂] 𝔸` at zero, as long as it converges on a neighborhood of zero. -/
lemma has_strict_fderiv_at_exp_zero_of_radius_pos (h : 0 < (exp_series 𝕂 𝔸).radius) :
  has_strict_fderiv_at (exp 𝕂) (1 : 𝔸 →L[𝕂] 𝔸) 0 :=
begin
  convert (has_fpower_series_at_exp_zero_of_radius_pos h).has_strict_fderiv_at,
  ext x,
  change x = exp_series 𝕂 𝔸 1 (λ _, x),
  simp [exp_series_apply_eq]
end

/-- The exponential in a Banach-algebra `𝔸` over a normed field `𝕂` has Fréchet-derivative
`1 : 𝔸 →L[𝕂] 𝔸` at zero, as long as it converges on a neighborhood of zero. -/
lemma has_fderiv_at_exp_zero_of_radius_pos (h : 0 < (exp_series 𝕂 𝔸).radius) :
  has_fderiv_at (exp 𝕂) (1 : 𝔸 →L[𝕂] 𝔸) 0 :=
(has_strict_fderiv_at_exp_zero_of_radius_pos h).has_fderiv_at

end any_field_any_algebra

section any_field_comm_algebra

variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸]
  [complete_space 𝔸]

/-- The exponential map in a commutative Banach-algebra `𝔸` over a normed field `𝕂` of
characteristic zero has Fréchet-derivative `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at any point `x` in the
disk of convergence. -/
lemma has_fderiv_at_exp_of_mem_ball [char_zero 𝕂] {x : 𝔸}
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  has_fderiv_at (exp 𝕂) (exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸) x :=
begin
  have hpos : 0 < (exp_series 𝕂 𝔸).radius := (zero_le _).trans_lt hx,
  rw has_fderiv_at_iff_is_o_nhds_zero,
  suffices : (λ h, exp 𝕂 x * (exp 𝕂 (0 + h) - exp 𝕂 0 - continuous_linear_map.id 𝕂 𝔸 h))
    =ᶠ[𝓝 0] (λ h, exp 𝕂 (x + h) - exp 𝕂 x - exp 𝕂 x • continuous_linear_map.id 𝕂 𝔸 h),
  { refine (is_o.const_mul_left _ _).congr' this (eventually_eq.refl _ _),
    rw ← has_fderiv_at_iff_is_o_nhds_zero,
    exact has_fderiv_at_exp_zero_of_radius_pos hpos },
  have : ∀ᶠ h in 𝓝 (0 : 𝔸), h ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius :=
    emetric.ball_mem_nhds _ hpos,
  filter_upwards [this] with _ hh,
  rw [exp_add_of_mem_ball hx hh, exp_zero, zero_add, continuous_linear_map.id_apply, smul_eq_mul],
  ring
end

/-- The exponential map in a commutative Banach-algebra `𝔸` over a normed field `𝕂` of
characteristic zero has strict Fréchet-derivative `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at any point `x` in
the disk of convergence. -/
lemma has_strict_fderiv_at_exp_of_mem_ball [char_zero 𝕂] {x : 𝔸}
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  has_strict_fderiv_at (exp 𝕂) (exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸) x :=
let ⟨p, hp⟩ := analytic_at_exp_of_mem_ball x hx in
hp.has_fderiv_at.unique (has_fderiv_at_exp_of_mem_ball hx) ▸ hp.has_strict_fderiv_at

end any_field_comm_algebra

section deriv

variables {𝕂 : Type*} [nondiscrete_normed_field 𝕂] [complete_space 𝕂]

/-- The exponential map in a complete normed field `𝕂` of characteristic zero has strict derivative
`exp 𝕂 x` at any point `x` in the disk of convergence. -/
lemma has_strict_deriv_at_exp_of_mem_ball [char_zero 𝕂] {x : 𝕂}
  (hx : x ∈ emetric.ball (0 : 𝕂) (exp_series 𝕂 𝕂).radius) :
  has_strict_deriv_at (exp 𝕂) (exp 𝕂 x) x :=
by simpa using (has_strict_fderiv_at_exp_of_mem_ball hx).has_strict_deriv_at

/-- The exponential map in a complete normed field `𝕂` of characteristic zero has derivative
`exp 𝕂 x` at any point `x` in the disk of convergence. -/
lemma has_deriv_at_exp_of_mem_ball [char_zero 𝕂] {x : 𝕂}
  (hx : x ∈ emetric.ball (0 : 𝕂) (exp_series 𝕂 𝕂).radius) :
  has_deriv_at (exp 𝕂) (exp 𝕂 x) x :=
(has_strict_deriv_at_exp_of_mem_ball hx).has_deriv_at

/-- The exponential map in a complete normed field `𝕂` of characteristic zero has strict derivative
`1` at zero, as long as it converges on a neighborhood of zero. -/
lemma has_strict_deriv_at_exp_zero_of_radius_pos (h : 0 < (exp_series 𝕂 𝕂).radius) :
  has_strict_deriv_at (exp 𝕂) (1 : 𝕂) 0 :=
(has_strict_fderiv_at_exp_zero_of_radius_pos h).has_strict_deriv_at

/-- The exponential map in a complete normed field `𝕂` of characteristic zero has derivative
`1` at zero, as long as it converges on a neighborhood of zero. -/
lemma has_deriv_at_exp_zero_of_radius_pos (h : 0 < (exp_series 𝕂 𝕂).radius) :
  has_deriv_at (exp 𝕂) (1 : 𝕂) 0 :=
(has_strict_deriv_at_exp_zero_of_radius_pos h).has_deriv_at

end deriv

section is_R_or_C_any_algebra

variables {𝕂 𝔸 : Type*} [is_R_or_C 𝕂] [normed_ring 𝔸] [normed_algebra 𝕂 𝔸]
  [complete_space 𝔸]

/-- The exponential in a Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ` has strict Fréchet-derivative
`1 : 𝔸 →L[𝕂] 𝔸` at zero. -/
lemma has_strict_fderiv_at_exp_zero :
  has_strict_fderiv_at (exp 𝕂) (1 : 𝔸 →L[𝕂] 𝔸) 0 :=
has_strict_fderiv_at_exp_zero_of_radius_pos (exp_series_radius_pos 𝕂 𝔸)

/-- The exponential in a Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ` has Fréchet-derivative
`1 : 𝔸 →L[𝕂] 𝔸` at zero. -/
lemma has_fderiv_at_exp_zero :
  has_fderiv_at (exp 𝕂) (1 : 𝔸 →L[𝕂] 𝔸) 0 :=
has_strict_fderiv_at_exp_zero.has_fderiv_at

end is_R_or_C_any_algebra

section is_R_or_C_comm_algebra

variables {𝕂 𝔸 : Type*} [is_R_or_C 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸]
  [complete_space 𝔸]

/-- The exponential map in a commutative Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ` has strict
Fréchet-derivative `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at any point `x`. -/
lemma has_strict_fderiv_at_exp {x : 𝔸} :
  has_strict_fderiv_at (exp 𝕂) (exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸) x :=
has_strict_fderiv_at_exp_of_mem_ball ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

/-- The exponential map in a commutative Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ` has
Fréchet-derivative `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at any point `x`. -/
lemma has_fderiv_at_exp {x : 𝔸} :
  has_fderiv_at (exp 𝕂) (exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸) x :=
has_strict_fderiv_at_exp.has_fderiv_at

end is_R_or_C_comm_algebra

section deriv_R_or_C

variables {𝕂 : Type*} [is_R_or_C 𝕂]

/-- The exponential map in `𝕂 = ℝ` or `𝕂 = ℂ` has strict derivative `exp 𝕂 x` at any point
`x`. -/
lemma has_strict_deriv_at_exp {x : 𝕂} : has_strict_deriv_at (exp 𝕂) (exp 𝕂 x) x :=
has_strict_deriv_at_exp_of_mem_ball ((exp_series_radius_eq_top 𝕂 𝕂).symm ▸ edist_lt_top _ _)

/-- The exponential map in `𝕂 = ℝ` or `𝕂 = ℂ` has derivative `exp 𝕂 x` at any point `x`. -/
lemma has_deriv_at_exp {x : 𝕂} : has_deriv_at (exp 𝕂) (exp 𝕂 x) x :=
has_strict_deriv_at_exp.has_deriv_at

/-- The exponential map in `𝕂 = ℝ` or `𝕂 = ℂ` has strict derivative `1` at zero. -/
lemma has_strict_deriv_at_exp_zero : has_strict_deriv_at (exp 𝕂) (1 : 𝕂) 0 :=
has_strict_deriv_at_exp_zero_of_radius_pos (exp_series_radius_pos 𝕂 𝕂)

/-- The exponential map in `𝕂 = ℝ` or `𝕂 = ℂ` has derivative `1` at zero. -/
lemma has_deriv_at_exp_zero :
  has_deriv_at (exp 𝕂) (1 : 𝕂) 0 :=
has_strict_deriv_at_exp_zero.has_deriv_at

end deriv_R_or_C

section complex

lemma complex.exp_eq_exp_ℂ : complex.exp = exp ℂ :=
begin
  refine funext (λ x, _),
  rw [complex.exp, exp_eq_tsum_div],
  exact tendsto_nhds_unique x.exp'.tendsto_limit
    (exp_series_div_summable ℝ x).has_sum.tendsto_sum_nat
end

end complex

section real

lemma real.exp_eq_exp_ℝ : real.exp = exp ℝ :=
begin
  refine funext (λ x, _),
  rw [real.exp, complex.exp_eq_exp_ℂ, ← exp_ℝ_ℂ_eq_exp_ℂ_ℂ, exp_eq_tsum, exp_eq_tsum_div,
      ← re_to_complex, ← re_clm_apply, re_clm.map_tsum (exp_series_summable' (x : ℂ))],
  refine tsum_congr (λ n, _),
  rw [re_clm.map_smul, ← complex.of_real_pow, re_clm_apply, re_to_complex, complex.of_real_re,
      smul_eq_mul, div_eq_inv_mul]
end

end real


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash

! This file was ported from Lean 3 source module analysis.normed_space.add_torsor_bases
! leanprover-community/mathlib commit 2f4cdce0c2f2f3b8cd58f05d556d03b468e1eb2e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.FiniteDimension
import Mathbin.Analysis.Calculus.AffineMap
import Mathbin.Analysis.Convex.Combination
import Mathbin.LinearAlgebra.AffineSpace.FiniteDimensional

/-!
# Bases in normed affine spaces.

This file contains results about bases in normed affine spaces.

## Main definitions:

 * `continuous_barycentric_coord`
 * `is_open_map_barycentric_coord`
 * `affine_basis.interior_convex_hull`
 * `exists_subset_affine_independent_span_eq_top_of_open`
 * `interior_convex_hull_nonempty_iff_affine_span_eq_top`
-/

section Barycentric

variable {ι 𝕜 E P : Type _} [NontriviallyNormedField 𝕜] [CompleteSpace 𝕜]

variable [NormedAddCommGroup E] [NormedSpace 𝕜 E]

variable [MetricSpace P] [NormedAddTorsor E P]

include E

theorem isOpenMap_barycentric_coord [Nontrivial ι] (b : AffineBasis ι 𝕜 P) (i : ι) :
    IsOpenMap (b.Coord i) :=
  AffineMap.isOpenMap_linear_iff.mp <|
    (b.Coord i).linear.isOpenMap_of_finiteDimensional <|
      (b.Coord i).linear_surjective_iff.mpr (b.surjective_coord i)
#align is_open_map_barycentric_coord isOpenMap_barycentric_coord

variable [FiniteDimensional 𝕜 E] (b : AffineBasis ι 𝕜 P)

@[continuity]
theorem continuous_barycentric_coord (i : ι) : Continuous (b.Coord i) :=
  (b.Coord i).continuous_of_finiteDimensional
#align continuous_barycentric_coord continuous_barycentric_coord

theorem smooth_barycentric_coord (b : AffineBasis ι 𝕜 E) (i : ι) : ContDiff 𝕜 ⊤ (b.Coord i) :=
  (⟨b.Coord i, continuous_barycentric_coord b i⟩ : E →A[𝕜] 𝕜).ContDiff
#align smooth_barycentric_coord smooth_barycentric_coord

end Barycentric

open Set

/-- Given a finite-dimensional normed real vector space, the interior of the convex hull of an
affine basis is the set of points whose barycentric coordinates are strictly positive with respect
to this basis.

TODO Restate this result for affine spaces (instead of vector spaces) once the definition of
convexity is generalised to this setting. -/
theorem AffineBasis.interior_convexHull {ι E : Type _} [Finite ι] [NormedAddCommGroup E]
    [NormedSpace ℝ E] (b : AffineBasis ι ℝ E) :
    interior (convexHull ℝ (range b)) = { x | ∀ i, 0 < b.Coord i x } :=
  by
  cases subsingleton_or_nontrivial ι
  · -- The zero-dimensional case.
    have : range b = univ :=
      AffineSubspace.eq_univ_of_subsingleton_span_eq_top (subsingleton_range _) b.tot
    simp [this]
  · -- The positive-dimensional case.
    haveI : FiniteDimensional ℝ E := b.finite_dimensional
    have : convexHull ℝ (range b) = ⋂ i, b.coord i ⁻¹' Ici 0 :=
      by
      rw [b.convex_hull_eq_nonneg_coord, set_of_forall]
      rfl
    ext
    simp only [this, interior_interᵢ, ←
      IsOpenMap.preimage_interior_eq_interior_preimage (isOpenMap_barycentric_coord b _)
        (continuous_barycentric_coord b _),
      interior_Ici, mem_Inter, mem_set_of_eq, mem_Ioi, mem_preimage]
#align affine_basis.interior_convex_hull AffineBasis.interior_convexHull

variable {V P : Type _} [NormedAddCommGroup V] [NormedSpace ℝ V] [MetricSpace P]
  [NormedAddTorsor V P]

include V

open AffineMap

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (y «expr ∉ » s) -/
/-- Given a set `s` of affine-independent points belonging to an open set `u`, we may extend `s` to
an affine basis, all of whose elements belong to `u`. -/
theorem IsOpen.exists_between_affineIndependent_span_eq_top {s u : Set P} (hu : IsOpen u)
    (hsu : s ⊆ u) (hne : s.Nonempty) (h : AffineIndependent ℝ (coe : s → P)) :
    ∃ t : Set P, s ⊆ t ∧ t ⊆ u ∧ AffineIndependent ℝ (coe : t → P) ∧ affineSpan ℝ t = ⊤ :=
  by
  obtain ⟨q, hq⟩ := hne
  obtain ⟨ε, ε0, hεu⟩ := metric.nhds_basis_closed_ball.mem_iff.1 (hu.mem_nhds <| hsu hq)
  obtain ⟨t, ht₁, ht₂, ht₃⟩ := exists_subset_affineIndependent_affineSpan_eq_top h
  let f : P → P := fun y => line_map q y (ε / dist y q)
  have hf : ∀ y, f y ∈ u := by
    refine' fun y => hεu _
    simp only [f]
    rw [Metric.mem_closedBall, line_map_apply, dist_vadd_left, norm_smul, Real.norm_eq_abs,
      dist_eq_norm_vsub V y q, abs_div, abs_of_pos ε0, abs_of_nonneg (norm_nonneg _), div_mul_comm]
    exact mul_le_of_le_one_left ε0.le (div_self_le_one _)
  have hεyq : ∀ (y) (_ : y ∉ s), ε / dist y q ≠ 0 := fun y hy =>
    div_ne_zero ε0.ne' (dist_ne_zero.2 (ne_of_mem_of_not_mem hq hy).symm)
  classical
    let w : t → ℝˣ := fun p => if hp : (p : P) ∈ s then 1 else Units.mk0 _ (hεyq (↑p) hp)
    refine' ⟨Set.range fun p : t => line_map q p (w p : ℝ), _, _, _, _⟩
    · intro p hp
      use ⟨p, ht₁ hp⟩
      simp [w, hp]
    · rintro y ⟨⟨p, hp⟩, rfl⟩
      by_cases hps : p ∈ s <;>
          simp only [w, hps, line_map_apply_one, Units.val_mk0, dif_neg, dif_pos, not_false_iff,
            Units.val_one, Subtype.coe_mk] <;>
        [exact hsu hps, exact hf p]
    · exact (ht₂.units_line_map ⟨q, ht₁ hq⟩ w).range
    · rw [affineSpan_eq_affineSpan_lineMap_units (ht₁ hq) w, ht₃]
#align is_open.exists_between_affine_independent_span_eq_top IsOpen.exists_between_affineIndependent_span_eq_top

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (s «expr ⊆ » u) -/
theorem IsOpen.exists_subset_affineIndependent_span_eq_top {u : Set P} (hu : IsOpen u)
    (hne : u.Nonempty) :
    ∃ (s : _)(_ : s ⊆ u), AffineIndependent ℝ (coe : s → P) ∧ affineSpan ℝ s = ⊤ :=
  by
  rcases hne with ⟨x, hx⟩
  rcases hu.exists_between_affine_independent_span_eq_top (singleton_subset_iff.mpr hx)
      (singleton_nonempty _) (affineIndependent_of_subsingleton _ _) with
    ⟨s, -, hsu, hs⟩
  exact ⟨s, hsu, hs⟩
#align is_open.exists_subset_affine_independent_span_eq_top IsOpen.exists_subset_affineIndependent_span_eq_top

/-- The affine span of a nonempty open set is `⊤`. -/
theorem IsOpen.affineSpan_eq_top {u : Set P} (hu : IsOpen u) (hne : u.Nonempty) :
    affineSpan ℝ u = ⊤ :=
  let ⟨s, hsu, hs, hs'⟩ := hu.exists_subset_affineIndependent_span_eq_top hne
  top_unique <| hs' ▸ affineSpan_mono _ hsu
#align is_open.affine_span_eq_top IsOpen.affineSpan_eq_top

theorem affineSpan_eq_top_of_nonempty_interior {s : Set V}
    (hs : (interior <| convexHull ℝ s).Nonempty) : affineSpan ℝ s = ⊤ :=
  top_unique <|
    isOpen_interior.affineSpan_eq_top hs ▸
      (affineSpan_mono _ interior_subset).trans_eq (affineSpan_convexHull _)
#align affine_span_eq_top_of_nonempty_interior affineSpan_eq_top_of_nonempty_interior

theorem AffineBasis.centroid_mem_interior_convexHull {ι} [Fintype ι] (b : AffineBasis ι ℝ V) :
    Finset.univ.centroid ℝ b ∈ interior (convexHull ℝ (range b)) :=
  by
  haveI := b.nonempty
  simp only [b.interior_convex_hull, mem_set_of_eq, b.coord_apply_centroid (Finset.mem_univ _),
    inv_pos, Nat.cast_pos, Finset.card_pos, Finset.univ_nonempty, forall_true_iff]
#align affine_basis.centroid_mem_interior_convex_hull AffineBasis.centroid_mem_interior_convexHull

theorem interior_convexHull_nonempty_iff_affineSpan_eq_top [FiniteDimensional ℝ V] {s : Set V} :
    (interior (convexHull ℝ s)).Nonempty ↔ affineSpan ℝ s = ⊤ :=
  by
  refine' ⟨affineSpan_eq_top_of_nonempty_interior, fun h => _⟩
  obtain ⟨t, hts, b, hb⟩ := AffineBasis.exists_affine_subbasis h
  suffices (interior (convexHull ℝ (range b))).Nonempty
    by
    rw [hb, Subtype.range_coe_subtype, set_of_mem_eq] at this
    refine' this.mono _
    mono*
  lift t to Finset V using b.finite_set
  exact ⟨_, b.centroid_mem_interior_convex_hull⟩
#align interior_convex_hull_nonempty_iff_affine_span_eq_top interior_convexHull_nonempty_iff_affineSpan_eq_top

theorem Convex.interior_nonempty_iff_affineSpan_eq_top [FiniteDimensional ℝ V] {s : Set V}
    (hs : Convex ℝ s) : (interior s).Nonempty ↔ affineSpan ℝ s = ⊤ := by
  rw [← interior_convexHull_nonempty_iff_affineSpan_eq_top, hs.convex_hull_eq]
#align convex.interior_nonempty_iff_affine_span_eq_top Convex.interior_nonempty_iff_affineSpan_eq_top


/-
Copyright (c) 2021 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/

import computability.NFA

/-!
# Epsilon Nondeterministic Finite Automata
This file contains the definition of an epsilon 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, also having access to ε-transitons,
which can be followed without reading a character.
Since this definition allows for automata with infinite states, a `fintype` instance must be
supplied for true `ε_NFA`'s.
-/

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 and can make ε-transitions by
  inputing `none`.
  Since this definition allows for Automata with infinite states, a `fintype` instance must be
  supplied for true `ε_NFA`'s.-/
structure ε_NFA (α : Type u) (σ : Type v) :=
(step : σ → option α → set σ)
(start : set σ)
(accept : set σ)

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

namespace ε_NFA

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

/-- The `ε_closure` of a set is the set of states which can be reached by taking a finite string of
  ε-transitions from an element of the set -/
inductive ε_closure : set σ → set σ
| base : ∀ S (s ∈ S), ε_closure S s
| step : ∀ S s (t ∈ M.step s none), ε_closure S s → ε_closure S t

/-- `M.step_set S a` is the union of the ε-closure of `M.step s a` for all `s ∈ S`. -/
def step_set : set σ → α → set σ :=
λ S a, S >>= (λ s, M.ε_closure (M.step s a))

/-- `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 (M.ε_closure start)

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

/-- `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_NFA` is an `NFA` constructed from an `ε_NFA` `M`. -/
def to_NFA : NFA α σ :=
{ step := λ S a, M.ε_closure (M.step S a),
  start := M.ε_closure M.start,
  accept := M.accept }

@[simp] lemma to_NFA_eval_from_match (start : set σ) :
  M.to_NFA.eval_from (M.ε_closure start) = M.eval_from start := rfl

@[simp] lemma to_NFA_correct :
  M.to_NFA.accepts = M.accepts :=
begin
  ext x,
  rw [accepts, NFA.accepts, eval, NFA.eval, ←to_NFA_eval_from_match],
  refl
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_NFA_correct at hx ⊢,
  exact M.to_NFA.pumping_lemma hx hlen
end

end ε_NFA

namespace NFA

/-- `M.to_ε_NFA` is an `ε_NFA` constructed from an `NFA` `M` by using the same start and accept
  states and transition functions. -/
def to_ε_NFA (M : NFA α σ) : ε_NFA α σ :=
{ step := λ s a, a.cases_on' ∅ (λ a, M.step s a),
  start := M.start,
  accept := M.accept }

@[simp] lemma to_ε_NFA_ε_closure (M : NFA α σ) (S : set σ) : M.to_ε_NFA.ε_closure S = S :=
begin
  ext a,
  split,
  { rintro ( ⟨ _, _, h ⟩ | ⟨ _, _, _, h, _ ⟩ ),
    exact h,
    cases h },
  { intro h,
    apply ε_NFA.ε_closure.base,
    exact h }
end

@[simp] lemma to_ε_NFA_eval_from_match (M : NFA α σ) (start : set σ) :
  M.to_ε_NFA.eval_from start = M.eval_from start :=
begin
  rw [eval_from, ε_NFA.eval_from, step_set, ε_NFA.step_set, to_ε_NFA_ε_closure],
  congr,
  ext S s,
  simp only [exists_prop, set.mem_Union, set.bind_def],
  apply exists_congr,
  simp only [and.congr_right_iff],
  intros t ht,
  rw M.to_ε_NFA_ε_closure,
  refl
end

@[simp] lemma to_ε_NFA_correct (M : NFA α σ) :
  M.to_ε_NFA.accepts = M.accepts :=
begin
  rw [accepts, ε_NFA.accepts, eval, ε_NFA.eval, to_ε_NFA_eval_from_match],
  refl
end

end NFA


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.Classes
import LeanColls.Range
import LeanColls.IndexedOps
import LeanColls.Uninit
import LeanColls.AuxLemmas
import LeanColls.View
import LeanColls.Array.ArrayUninit

namespace LeanColls

/-! # Fixed-length arrays

Represented as an `ArrayUninit`.
-/
structure Array (α : Type u) (n : Nat) : Type u where
  data : ArrayUninit α n n (Nat.le_refl _)

namespace Array

/-!
### Array.new

Build an array of length `n` where all elements are instantiated to `x`.
-/
def new (x : α) (n : Nat) : Array α n :=
  have res := Range.foldl'' ⟨n⟩
    (motive := fun i => Σ' h, Σ' (A : ArrayUninit α n i h),
      ∀ j hm, A.get j (Nat.lt_of_lt_of_le hm h) hm = x)
    (fun _ h_i ⟨_, A, h⟩ =>
      ⟨h_i, A.push x h_i, by
        intro j hm
        simp
        split; rfl; apply h⟩
    ) ⟨Nat.zero_le _, ArrayUninit.new n, by intro _ hj; contradiction⟩
  ⟨res.2.1⟩

/-!
### Array.init

Build an array of length `n` where element `i` is instantiated to `f i`.
-/
def init {α : Type u} {n : Nat} (f : Fin n → α) : Array α n :=
  have res := Range.foldl'' ⟨n⟩
    (motive := fun i => Σ' h, Σ' (A : ArrayUninit α n i h),
      ∀ j hm, A.get j (Nat.lt_of_lt_of_le hm h) hm =
              f ⟨j,(Nat.lt_of_lt_of_le hm h)⟩)
    (fun i h_i ⟨_, A, h⟩ =>
      ⟨h_i, A.push (f ⟨i,h_i⟩) h_i, by
        intro j hj
        simp
        have := Nat.lt_or_eq_of_le <| Nat.le_of_succ_le_succ hj
        cases this
        case inr hj => simp [hj]
        case inl hj =>
          simp [Nat.ne_of_lt hj]
          apply h⟩
    ) ⟨Nat.zero_le _, ArrayUninit.new n, by intro _ hj; contradiction⟩
  ⟨res.2.1⟩

/-!
### Array.get

Gets an element at the specified index. An array is uniquely characterized
by its `get` (see `Array.ext`).
-/
@[inline]
def get (A : @& Array α n) (i : @& Fin n) : α
  := A.data.get i.val i.isLt i.isLt

/-!
### Array.set

Sets the element at index `i` to `x`, throwing out the old value.
-/
@[inline]
def set {n : @& Nat} (A : Array α n) (i : @& Fin n) (x : α) : Array α n
  := ⟨A.data.set i i.isLt x⟩

/-!
## Extensionality & simp lemmas
-/

@[simp]
theorem ext {α n} {A B : Array α n} : A = B ↔ A.get = B.get
  := by
  constructor
  intro h; rw [h]
  intro h; cases A; cases B
  simp [get] at h ⊢
  funext i h_i _
  exact congrFun h ⟨i,h_i⟩

@[simp]
theorem get_new {x : α} {n} {i : Fin n}
  : get (new x n) i = x
  := by
  simp [get, new]
  generalize Range.foldl'' _ _ _ _ = res
  match res with
  | ⟨_, _, h⟩ =>
  simp
  apply h

@[simp]
theorem get_init {f : Fin n → α} {i}
  : get (init f) i = f i
  := by
  simp [get, init]
  generalize Range.foldl'' _ _ _ _ = res
  match res with
  | ⟨_, _, h⟩ =>
  simp
  apply h

theorem get_of_set_eq (f : Array α n) (i : Fin n) (x : α) {i' : Fin n} (h_i : i = i')
  : (f.set i x).get i' = x
  := by
  simp [get, set, ArrayUninit.get_set, h_i]

theorem get_of_set_ne (f : Array α n) (i : Fin n) (x : α) (j : Fin n) (h : i ≠ j)
  : (f.set i x).get j = f.get j
  := by
  simp [get, set]
  cases i; cases j
  simp at h ⊢
  simp [h]

@[simp]
theorem get_of_set (f : Array α n) (i : Fin n) (x : α) {i' : Fin n}
  : (f.set i x).get i' = if i = i' then x else f.get i'
  := by
  split
  apply get_of_set_eq; assumption
  apply get_of_set_ne; assumption

def empty : Array α 0 := init (Fin.elim0)

def copy {n : Nat} (A : Array α n) : Array α n
  := init A.get

@[simp]
theorem copy_def (A : Array α n) : A.copy = A
  := by
  simp [copy]
  funext i
  simp

def copyIfShared (A : Array α n) : Array α n :=
  if ArrayUninit.isExclusive A then A else copy A

@[simp]
theorem copyIfShared_def (A : Array α n) : A.copyIfShared = A
  := by
  simp [copyIfShared]

/-! ## Class instances -/

instance : Indexed (Array α n) α where
  size _ := n
  nth := Array.get

instance : IndexedOps (Array α n) α := default

instance : Initable (Array α n) n α where
  init := init

instance [N : Nonempty α] : Nonempty (Array α n) :=
  Nonempty.elim N (fun a => ⟨new a n⟩)

instance [Inhabited α] : Inhabited (Array α n) where
  default := new default n

instance : GetElem (Array α n) Nat α (fun _ i => i < n) where
  getElem A i h := A.get ⟨i,h⟩

/-! ## Misc -/

def toList (A : Array α n) : List α := FoldableOps.toList A

def ofList (L : List α) : Array α L.length :=
  have res :=
    (Range.mk L.length).foldl''
      (motive := fun i =>
        Σ' h, Σ' (acc : ArrayUninit α L.length i h) (rest : List α),
        rest = L.drop i ∧ ∀ j h_j,
        acc.get j (Nat.lt_of_lt_of_le h_j h) h_j =
          L.get ⟨j, Nat.lt_of_lt_of_le h_j h⟩)
      (fun i h ⟨_, acc, rest, h_rest, h_acc⟩ =>
        match rest with
        | [] => False.elim <| by
          have := List.length_drop i L
          rw [←h_rest] at this
          simp at this
          apply Nat.ne_of_lt h
          apply Nat.le_antisymm
          exact Nat.le_of_lt h
          exact Nat.sub_eq_zero_iff_le.mp this.symm
        | x::rest =>
          ⟨h, acc.push x h
          , rest
          , by
            have := h_rest.symm ▸ List.get_drop_eq_drop L i h
            have h_x : x = L[i]' h := by
              simp at this; exact this.1.symm
            have h_rest : rest = L.drop i.succ := by
              simp at this; exact this.2.symm
            constructor
            exact h_rest
            intro j h_j
            simp
            split
            subst_vars
            simp [getElem]
            apply h_acc
            ⟩
      )
      ⟨Nat.zero_le _, ArrayUninit.new _, L, by simp,
        by intro j hj; contradiction⟩
  ⟨res.2.1⟩

instance [Repr α] : Repr (Array α n) where
  reprPrec A prec := "LeanColls.Array.ofList " ++ reprPrec A.toList prec

instance [ToString α] : ToString (Array α n) where
  toString A := toString A.toList

@[simp]
theorem get_ofList (L : List α) (i)
  : get (ofList L) i = L.get i
  := by
  simp [get, ofList]
  generalize Range.foldl'' _ _ _ _ = res
  match res with
  | ⟨h, acc, rest, h_rest, h_acc⟩ =>
  simp
  apply h_acc

instance [Repr α] : Repr (Array α n) where
  reprPrec A prec := "Array.ofList " ++ reprPrec (α := List α) A.toList prec

@[simp]
theorem canonicalToList_eq_toList (A : Array α n)
  : canonicalToList (Foldable.fold A) = A.toList
  := by
  unfold toList
  rw [IndexedOps.toList_eq_default_toList,
    FoldableOps.default_toList_eq_canonicalToList]

@[simp]
theorem size_set (A : Array α n) (i : Fin n) (x : α)
  : Size.size (A.set i x) = Size.size A
  := by simp [Size.size]

@[simp]
def length (_ : Array α n) := n

@[simp]
theorem length_toList (A : Array α n)
  : A.toList.length = n
  := by simp [toList, Size.size]

private def memRangeToList_to_fin (i : {a // a ∈ Range.toList ⟨n⟩})
  : Fin n := ⟨i.val, by
    cases i; case mk i hi =>
    rw [Range.toList_eq_canonicalToList] at hi
    rw [←Range.memCorrect] at hi
    simp [Membership.mem] at hi
    exact hi⟩

theorem toList_get (A : Array α n) (i : Fin n)
  : A.get i = List.get A.toList ⟨i,by simp; exact i.isLt⟩
  := by
  simp [toList]
  rw [IndexedOps.get_toList_eq_get]
  simp [Indexed.nth]

@[simp]
theorem toList_set (A : Array α n) (i : Fin n) (x : α)
  : (A.set i x).toList =
    List.set A.toList i x
  := by
  simp [toList]
  rw [IndexedOps.toList_eq_range_toList_map]
  case hL => simp [Foldable.fold, ←Range.toList_eq_canonicalToList]
  rw [IndexedOps.toList_eq_range_toList_map]
  case hL => simp [Foldable.fold, ←Range.toList_eq_canonicalToList]
  have :
    canonicalToList (Range.mk (Size.size (A.set i x))).foldl
    = Range.toList ⟨n⟩ := by
    simp [Size.size, Range.toList_eq_canonicalToList]
  rw [List.map'_rw _ this]
  have :
    canonicalToList (Range.mk (Size.size A)).foldl
    = Range.toList ⟨n⟩ := by
    simp [Size.size, Range.toList_eq_canonicalToList]
  rw [List.map'_rw _ this]
  simp [Indexed.nth]
  rw [Range.set_map'_toList]
  congr
  funext j hj
  simp at hj
  cases i; case mk i hi =>
  split
  case inl h =>
    simp at h; simp [h]
  case inr h =>
    simp at h; simp [Ne.symm h]


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Reid Barton, Simon Hudon

"The Following Are Equivalent" (tfae) :
Tactic for proving the equivalence of a set of proposition
using various implications between them.
-/
import data.list.tfae
import tactic.scc

open expr tactic lean lean.parser

namespace tactic
open interactive interactive.types expr

export list (tfae)

namespace tfae

@[derive has_reflect, derive inhabited]
inductive arrow : Type
| right      : arrow
| left_right : arrow
| left       : arrow

meta def mk_implication : Π (re : arrow) (e₁ e₂ : expr), pexpr
| arrow.right      e₁ e₂ := ``(%%e₁ → %%e₂)
| arrow.left_right e₁ e₂ := ``(%%e₁ ↔ %%e₂)
| arrow.left       e₁ e₂ := ``(%%e₂ → %%e₁)

meta def mk_name : Π (re : arrow) (i₁ i₂ : nat), name
| arrow.right      i₁ i₂ := ("tfae_" ++ to_string i₁ ++ "_to_"  ++ to_string i₂ : string)
| arrow.left_right i₁ i₂ := ("tfae_" ++ to_string i₁ ++ "_iff_" ++ to_string i₂ : string)
| arrow.left       i₁ i₂ := ("tfae_" ++ to_string i₂ ++ "_to_"  ++ to_string i₁ : string)

end tfae

namespace interactive

open tactic.tfae list

meta def parse_list : expr → option (list expr)
| `([]) := pure []
| `(%%e :: %%es) := (::) e <$> parse_list es
| _ := none

/-- In a goal of the form `tfae [a₀, a₁, a₂]`,
`tfae_have : i → j` creates the assertion `aᵢ → aⱼ`. The other possible
notations are `tfae_have : i ← j` and `tfae_have : i ↔ j`. The user can
also provide a label for the assertion, as with `have`: `tfae_have h : i ↔ j`.
-/
meta def tfae_have
  (h : parse $ optional ident <* tk ":")
  (i₁ : parse (with_desc "i" small_nat))
  (re : parse (((tk "→" <|> tk "->")  *> return arrow.right)      <|>
               ((tk "↔" <|> tk "<->") *> return arrow.left_right) <|>
               ((tk "←" <|> tk "<-")  *> return arrow.left)))
  (i₂ : parse (with_desc "j" small_nat))
  (discharger : tactic unit := tactic.solve_by_elim) :
  tactic unit := do
    `(tfae %%l) <- target,
    l ← parse_list l,
    e₁ ← list.nth l (i₁ - 1) <|> fail format!"index {i₁} is not between 1 and {l.length}",
    e₂ ← list.nth l (i₂ - 1) <|> fail format!"index {i₂} is not between 1 and {l.length}",
    type ← to_expr (tfae.mk_implication re e₁ e₂),
    let h := h.get_or_else (mk_name re i₁ i₂),
    tactic.assert h type,
    return ()

/-- Finds all implications and equivalences in the context
to prove a goal of the form `tfae [...]`.
-/
meta def tfae_finish : tactic unit :=
applyc ``tfae_nil <|>
closure.with_new_closure (λ cl,
do impl_graph.mk_scc cl,
   `(tfae %%l) ← target,
   l ← parse_list l,
   (_,r,_) ← cl.root l.head,
   refine ``(tfae_of_forall %%r _ _),
   thm ← mk_const ``forall_mem_cons,
   l.mmap' (λ e,
     do rewrite_target thm, split,
        (_,r',p) ← cl.root e,
        tactic.exact p ),
   applyc ``forall_mem_nil,
   pure ())

end interactive
end tactic

/--
The `tfae` tactic suite is a set of tactics that help with proving that certain
propositions are equivalent.
In `data/list/basic.lean` there is a section devoted to propositions of the
form
```lean
tfae [p1, p2, ..., pn]
```
where `p1`, `p2`, through, `pn` are terms of type `Prop`.
This proposition asserts that all the `pi` are pairwise equivalent.
There are results that allow to extract the equivalence
of two propositions `pi` and `pj`.

To prove a goal of the form `tfae [p1, p2, ..., pn]`, there are two
tactics.  The first tactic is `tfae_have`.  As an argument it takes an
expression of the form `i arrow j`, where `i` and `j` are two positive
natural numbers, and `arrow` is an arrow such as `→`, `->`, `←`, `<-`,
`↔`, or `<->`.  The tactic `tfae_have : i arrow j` sets up a subgoal in
which the user has to prove the equivalence (or implication) of `pi` and `pj`.

The remaining tactic, `tfae_finish`, is a finishing tactic. It
collects all implications and equivalences from the local context and
computes their transitive closure to close the
main goal.

`tfae_have` and `tfae_finish` can be used together in a proof as
follows:

```lean
example (a b c d : Prop) : tfae [a,b,c,d] :=
begin
  tfae_have : 3 → 1,
  { /- prove c → a -/ },
  tfae_have : 2 → 3,
  { /- prove b → c -/ },
  tfae_have : 2 ← 1,
  { /- prove a → b -/ },
  tfae_have : 4 ↔ 2,
  { /- prove d ↔ b -/ },
    -- a b c d : Prop,
    -- tfae_3_to_1 : c → a,
    -- tfae_2_to_3 : b → c,
    -- tfae_1_to_2 : a → b,
    -- tfae_4_iff_2 : d ↔ b
    -- ⊢ tfae [a, b, c, d]
  tfae_finish,
end
```
-/
add_tactic_doc
{ name := "tfae",
  category                 := doc_category.tactic,
  decl_names               := [`tactic.interactive.tfae_have, `tactic.interactive.tfae_finish],
  tags                     := ["logic"],
  inherit_description_from := `tactic.interactive.tfae_finish }


/-
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.basic logic.embedding data.nat.basic

open function

universes u v w
variables {α : Type*} {β : Type*} {γ : Type*}
  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}

structure order_embedding {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ↪ β :=
(ord : ∀ {a b}, r a b ↔ s (to_embedding a) (to_embedding b))

infix ` ≼o `:50 := order_embedding

/-- the induced order on a subtype is an embedding under the natural inclusion. -/
definition subtype.order_embedding {X : Type*} (r : X → X → Prop) (p : X → Prop) :
((subtype.val : subtype p → X) ⁻¹'o r) ≼o r :=
⟨⟨subtype.val,subtype.val_injective⟩,by intros;refl⟩

theorem preimage_equivalence {α β} (f : α → β) {s : β → β → Prop}
  (hs : equivalence s) : equivalence (f ⁻¹'o s) :=
⟨λ a, hs.1 _, λ a b h, hs.2.1 h, λ a b c h₁ h₂, hs.2.2 h₁ h₂⟩

namespace order_embedding

instance : has_coe_to_fun (r ≼o s) := ⟨λ _, α → β, λ o, o.to_embedding⟩

theorem ord' : ∀ (f : r ≼o s) {a b}, r a b ↔ s (f a) (f b)
| ⟨f, o⟩ := @o

@[simp] theorem coe_fn_mk (f : α ↪ β) (o) :
  (@order_embedding.mk _ _ r s f o : α → β) = f := rfl

@[simp] theorem coe_fn_to_embedding (f : r ≼o s) : (f.to_embedding : α → β) = f := rfl

theorem eq_of_to_fun_eq : ∀ {e₁ e₂ : r ≼o s}, (e₁ : α → β) = e₂ → e₁ = e₂
| ⟨⟨f₁, h₁⟩, o₁⟩ ⟨⟨f₂, h₂⟩, o₂⟩ h := by congr; exact h

@[refl] protected def refl (r : α → α → Prop) : r ≼o r :=
⟨embedding.refl _, λ a b, iff.rfl⟩

@[trans] protected def trans (f : r ≼o s) (g : s ≼o t) : r ≼o t :=
⟨f.1.trans g.1, λ a b, by rw [f.2, g.2]; simp⟩

@[simp] theorem refl_apply (x : α) : order_embedding.refl r x = x := rfl

@[simp] theorem trans_apply (f : r ≼o s) (g : s ≼o t) (a : α) : (f.trans g) a = g (f a) := rfl

/-- An order embedding is also an order embedding between dual orders. -/
def rsymm (f : r ≼o s) : swap r ≼o swap s :=
⟨f.to_embedding, λ a b, f.ord'⟩

/-- If `f` is injective, then it is an order embedding from the
  preimage order of `s` to `s`. -/
def preimage (f : α ↪ β) (s : β → β → Prop) : f ⁻¹'o s ≼o s := ⟨f, λ a b, iff.rfl⟩

theorem eq_preimage (f : r ≼o s) : r = f ⁻¹'o s :=
by funext a b; exact propext f.ord'

protected theorem is_irrefl : ∀ (f : r ≼o s) [is_irrefl β s], is_irrefl α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a h, H _ (o.1 h)⟩

protected theorem is_refl : ∀ (f : r ≼o s) [is_refl β s], is_refl α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a, o.2 (H _)⟩

protected theorem is_symm : ∀ (f : r ≼o s) [is_symm β s], is_symm α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h, o.2 (H _ _ (o.1 h))⟩

protected theorem is_asymm : ∀ (f : r ≼o s) [is_asymm β s], is_asymm α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h₁ h₂, H _ _ (o.1 h₁) (o.1 h₂)⟩

protected theorem is_antisymm : ∀ (f : r ≼o s) [is_antisymm β s], is_antisymm α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h₁ h₂, f.inj' (H _ _ (o.1 h₁) (o.1 h₂))⟩

protected theorem is_trans : ∀ (f : r ≼o s) [is_trans β s], is_trans α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b c h₁ h₂, o.2 (H _ _ _ (o.1 h₁) (o.1 h₂))⟩

protected theorem is_total : ∀ (f : r ≼o s) [is_total β s], is_total α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o o).2 (H _ _)⟩

protected theorem is_preorder : ∀ (f : r ≼o s) [is_preorder β s], is_preorder α r
| f H := by exactI {..f.is_refl, ..f.is_trans}

protected theorem is_partial_order : ∀ (f : r ≼o s) [is_partial_order β s], is_partial_order α r
| f H := by exactI {..f.is_preorder, ..f.is_antisymm}

protected theorem is_linear_order : ∀ (f : r ≼o s) [is_linear_order β s], is_linear_order α r
| f H := by exactI {..f.is_partial_order, ..f.is_total}

protected theorem is_strict_order : ∀ (f : r ≼o s) [is_strict_order β s], is_strict_order α r
| f H := by exactI {..f.is_irrefl, ..f.is_trans}

protected theorem is_trichotomous : ∀ (f : r ≼o s) [is_trichotomous β s], is_trichotomous α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o (or_congr f.inj'.eq_iff.symm o)).2 (H _ _)⟩

protected theorem is_strict_total_order' : ∀ (f : r ≼o s) [is_strict_total_order' β s], is_strict_total_order' α r
| f H := by exactI {..f.is_trichotomous, ..f.is_strict_order}

protected theorem acc (f : r ≼o s) (a : α) : acc s (f a) → acc r a :=
begin
  generalize h : f a = b, intro ac,
  induction ac with _ H IH generalizing a, subst h,
  exact ⟨_, λ a' h, IH (f a') (f.ord'.1 h) _ rfl⟩
end

protected theorem well_founded : ∀ (f : r ≼o s) (h : well_founded s), well_founded r
| f ⟨H⟩ := ⟨λ a, f.acc _ (H _)⟩

protected theorem is_well_order : ∀ (f : r ≼o s) [is_well_order β s], is_well_order α r
| f H := by exactI {wf := f.well_founded H.wf, ..f.is_strict_total_order'}

/-- It suffices to prove `f` is monotone between strict orders
  to show it is an order embedding. -/
def of_monotone [is_trichotomous α r] [is_asymm β s] (f : α → β) (H : ∀ a b, r a b → s (f a) (f b)) : r ≼o s :=
begin
  haveI := @is_irrefl_of_is_asymm β s _,
  refine ⟨⟨f, λ a b e, _⟩, λ a b, ⟨H _ _, λ h, _⟩⟩,
  { refine ((@trichotomous _ r _ a b).resolve_left _).resolve_right _;
    exact λ h, @irrefl _ s _ _ (by simpa [e] using H _ _ h) },
  { refine (@trichotomous _ r _ a b).resolve_right (or.rec (λ e, _) (λ h', _)),
    { subst e, exact irrefl _ h },
    { exact asymm (H _ _ h') h } }
end

@[simp] theorem of_monotone_coe [is_trichotomous α r] [is_asymm β s] (f : α → β) (H) :
  (@of_monotone _ _ r s _ _ f H : α → β) = f := rfl

-- If le is preserved by an order embedding of preorders, then lt is too
def lt_embedding_of_le_embedding [preorder α] [preorder β]
  (f : (has_le.le : α → α → Prop) ≼o (has_le.le : β → β → Prop)) :
(has_lt.lt : α → α → Prop) ≼o (has_lt.lt : β → β → Prop) :=
{ to_fun := f,
  inj := f.inj,
  ord := by intros; simp [lt_iff_le_not_le,f.ord] }

theorem nat_lt [is_strict_order α r] (f : ℕ → α) (H : ∀ n:ℕ, r (f n) (f (n+1))) :
  ((<) : ℕ → ℕ → Prop) ≼o r :=
of_monotone f $ λ a b h, begin
  induction b with b IH, {exact (nat.not_lt_zero _ h).elim},
  cases nat.lt_succ_iff_lt_or_eq.1 h with h e,
  { exact trans (IH h) (H _) },
  { subst b, apply H }
end

theorem nat_gt [is_strict_order α r] (f : ℕ → α) (H : ∀ n:ℕ, r (f (n+1)) (f n)) :
  ((>) : ℕ → ℕ → Prop) ≼o r :=
by haveI := is_strict_order.swap r; exact rsymm (nat_lt f H)

theorem well_founded_iff_no_descending_seq [is_strict_order α r] : well_founded r ↔ ¬ nonempty (((>) : ℕ → ℕ → Prop) ≼o r) :=
⟨λ ⟨h⟩ ⟨⟨f, o⟩⟩,
  suffices ∀ a, acc r a → ∀ n, a ≠ f n, from this (f 0) (h _) 0 rfl,
  λ a ac, begin
    induction ac with a _ IH, intros n h, subst a,
    exact IH (f (n+1)) (o.1 (nat.lt_succ_self _)) _ rfl
  end,
λ N, ⟨λ a, classical.by_contradiction $ λ na,
  let ⟨f, h⟩ := classical.axiom_of_choice $
    show ∀ x : {a // ¬ acc r a}, ∃ y : {a // ¬ acc r a}, r y.1 x.1,
    from λ ⟨x, h⟩, classical.by_contradiction $ λ hn, h $
      ⟨_, λ y h, classical.by_contradiction $ λ na, hn ⟨⟨y, na⟩, h⟩⟩ in
  N ⟨nat_gt (λ n, (f^[n] ⟨a, na⟩).1) $ λ n,
    by rw nat.iterate_succ'; apply h⟩⟩⟩

end order_embedding

/-- The inclusion map `fin n → ℕ` is an order embedding. -/
def fin.val.order_embedding (n) : @order_embedding (fin n) ℕ (<) (<) :=
⟨⟨fin.val, @fin.eq_of_veq _⟩, λ a b, iff.rfl⟩

/-- The inclusion map `fin m → fin n` is an order embedding. -/
def fin_fin.order_embedding {m n} (h : m ≤ n) : @order_embedding (fin m) (fin n) (<) (<) :=
⟨⟨λ ⟨x, h'⟩, ⟨x, lt_of_lt_of_le h' h⟩,
  λ ⟨a, _⟩ ⟨b, _⟩ h, by congr; injection h⟩,
  by intros; cases a; cases b; refl⟩

instance fin.lt.is_well_order (n) : is_well_order (fin n) (<) :=
(fin.val.order_embedding _).is_well_order

/-- An order isomorphism is an equivalence that is also an order embedding. -/
structure order_iso {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ≃ β :=
(ord : ∀ {a b}, r a b ↔ s (to_equiv a) (to_equiv b))

infix ` ≃o `:50 := order_iso

namespace order_iso

def to_order_embedding (f : r ≃o s) : r ≼o s :=
⟨f.to_equiv.to_embedding, f.ord⟩

instance : has_coe (r ≃o s) (r ≼o s) := ⟨to_order_embedding⟩

theorem coe_coe_fn (f : r ≃o s) : ((f : r ≼o s) : α → β) = f := rfl

theorem ord' : ∀ (f : r ≃o s) {a b}, r a b ↔ s (f a) (f b)
| ⟨f, o⟩ := @o

@[simp] theorem coe_fn_mk (f : α ≃ β) (o) :
  (@order_iso.mk _ _ r s f o : α → β) = f := rfl

@[simp] theorem coe_fn_to_equiv (f : r ≃o s) : (f.to_equiv : α → β) = f := rfl

theorem eq_of_to_fun_eq : ∀ {e₁ e₂ : r ≃o s}, (e₁ : α → β) = e₂ → e₁ = e₂
| ⟨e₁, o₁⟩ ⟨e₂, o₂⟩ h := by congr; exact equiv.eq_of_to_fun_eq h

@[refl] protected def refl (r : α → α → Prop) : r ≃o r :=
⟨equiv.refl _, λ a b, iff.rfl⟩

@[symm] protected def symm (f : r ≃o s) : s ≃o r :=
⟨f.to_equiv.symm, λ a b, by cases f with f o; rw o; simp⟩

@[trans] protected def trans (f₁ : r ≃o s) (f₂ : s ≃o t) : r ≃o t :=
⟨f₁.to_equiv.trans f₂.to_equiv, λ a b,
  by cases f₁ with f₁ o₁; cases f₂ with f₂ o₂; rw [o₁, o₂]; simp⟩

@[simp] theorem coe_fn_symm_mk (f o) : ((@order_iso.mk _ _ r s f o).symm : β → α) = f.symm :=
rfl

@[simp] theorem refl_apply (x : α) : order_iso.refl r x = x := rfl

@[simp] theorem trans_apply : ∀ (f : r ≃o s) (g : s ≃o t) (a : α), (f.trans g) a = g (f a)
| ⟨f₁, o₁⟩ ⟨f₂, o₂⟩ a := equiv.trans_apply _ _ _

@[simp] theorem apply_symm_apply : ∀ (e : r ≃o s) (x : β), e (e.symm x) = x
| ⟨f₁, o₁⟩ x := by simp

@[simp] theorem symm_apply_apply : ∀ (e : r ≃o s) (x : α), e.symm (e x) = x
| ⟨f₁, o₁⟩ x := by simp

/-- Any equivalence lifts to an order isomorphism between `s` and its preimage. -/
def preimage (f : α ≃ β) (s : β → β → Prop) : f ⁻¹'o s ≃o s := ⟨f, λ a b, iff.rfl⟩

noncomputable def of_surjective (f : r ≼o s) (H : surjective f) : r ≃o s :=
⟨equiv.of_bijective ⟨f.inj, H⟩, by simp [f.ord']⟩

@[simp] theorem of_surjective_coe (f : r ≼o s) (H) : (of_surjective f H : α → β) = f :=
by delta of_surjective; simp

theorem sum_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
  (e₁ : @order_iso α₁ α₂ r₁ r₂) (e₂ : @order_iso β₁ β₂ s₁ s₂) :
  sum.lex r₁ s₁ ≃o sum.lex r₂ s₂ :=
⟨equiv.sum_congr e₁.to_equiv e₂.to_equiv, λ a b,
 by cases e₁ with f hf; cases e₂ with g hg;
    cases a; cases b; simp [hf, hg]⟩

theorem prod_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
  (e₁ : @order_iso α₁ α₂ r₁ r₂) (e₂ : @order_iso β₁ β₂ s₁ s₂) :
  prod.lex r₁ s₁ ≃o prod.lex r₂ s₂ :=
⟨equiv.prod_congr e₁.to_equiv e₂.to_equiv,  λ a b, begin
  cases e₁ with f hf; cases e₂ with g hg,
  cases a with a₁ a₂; cases b with b₁ b₂,
  suffices : prod.lex r₁ s₁ (a₁, a₂) (b₁, b₂) ↔
    prod.lex r₂ s₂ (f a₁, g a₂) (f b₁, g b₂), {simpa [hf, hg]},
  split,
  { intro h, cases h with _ _ _ _ h _ _ _ h,
    { left, exact hf.1 h },
    { right, exact hg.1 h } },
  { generalize e : f b₁ = fb₁,
    intro h, cases h with _ _ _ _ h _ _ _ h,
    { subst e, left, exact hf.2 h },
    { have := f.injective e, subst b₁,
      right, exact hg.2 h } }
end⟩

end order_iso

/-- A subset `p : set α` embeds into `α` -/
def set_coe_embedding {α : Type*} (p : set α) : p ↪ α := ⟨subtype.val, @subtype.eq _ _⟩

/-- `subrel r p` is the inherited relation on a subset. -/
def subrel (r : α → α → Prop) (p : set α) : p → p → Prop :=
@subtype.val _ p ⁻¹'o r

@[simp] theorem subrel_val (r : α → α → Prop) (p : set α)
  {a b} : subrel r p a b ↔ r a.1 b.1 := iff.rfl

namespace subrel

protected def order_embedding (r : α → α → Prop) (p : set α) :
  subrel r p ≼o r := ⟨set_coe_embedding _, λ a b, iff.rfl⟩

@[simp] theorem order_embedding_apply (r : α → α → Prop) (p a) :
  subrel.order_embedding r p a = a.1 := rfl

instance (r : α → α → Prop) [is_well_order α r]
  (p : set α) : is_well_order p (subrel r p) :=
order_embedding.is_well_order (subrel.order_embedding r p)

end subrel

/-- Restrict the codomain of an order embedding -/
def order_embedding.cod_restrict (p : set β) (f : r ≼o s) (H : ∀ a, f a ∈ p) : r ≼o subrel s p :=
⟨f.to_embedding.cod_restrict p H, f.ord⟩

@[simp] theorem order_embedding.cod_restrict_apply (p) (f : r ≼o s) (H a) :
  order_embedding.cod_restrict p f H a = ⟨f a, H a⟩ := rfl