/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import logic.equiv.option
import order.rel_iso
import tactic.monotonicity.basic

/-!
# Order homomorphisms

This file defines order homomorphisms, which are bundled monotone functions. A preorder
homomorphism `f : α →o β` is a function `α → β` along with a proof that `∀ x y, x ≤ y → f x ≤ f y`.

## Main definitions

In this file we define the following bundled monotone maps:
 * `order_hom α β` a.k.a. `α →o β`: Preorder homomorphism.
    An `order_hom α β` is a function `f : α → β` such that `a₁ ≤ a₂ → f a₁ ≤ f a₂`
 * `order_embedding α β` a.k.a. `α ↪o β`: Relation embedding.
    An `order_embedding α β` is an embedding `f : α ↪ β` such that `a ≤ b ↔ f a ≤ f b`.
    Defined as an abbreviation of `@rel_embedding α β (≤) (≤)`.
* `order_iso`: Relation isomorphism.
    An `order_iso α β` is an equivalence `f : α ≃ β` such that `a ≤ b ↔ f a ≤ f b`.
    Defined as an abbreviation of `@rel_iso α β (≤) (≤)`.

We also define many `order_hom`s. In some cases we define two versions, one with `ₘ` suffix and
one without it (e.g., `order_hom.compₘ` and `order_hom.comp`). This means that the former
function is a "more bundled" version of the latter. We can't just drop the "less bundled" version
because the more bundled version usually does not work with dot notation.

* `order_hom.id`: identity map as `α →o α`;
* `order_hom.curry`: an order isomorphism between `α × β →o γ` and `α →o β →o γ`;
* `order_hom.comp`: composition of two bundled monotone maps;
* `order_hom.compₘ`: composition of bundled monotone maps as a bundled monotone map;
* `order_hom.const`: constant function as a bundled monotone map;
* `order_hom.prod`: combine `α →o β` and `α →o γ` into `α →o β × γ`;
* `order_hom.prodₘ`: a more bundled version of `order_hom.prod`;
* `order_hom.prod_iso`: order isomorphism between `α →o β × γ` and `(α →o β) × (α →o γ)`;
* `order_hom.diag`: diagonal embedding of `α` into `α × α` as a bundled monotone map;
* `order_hom.on_diag`: restrict a monotone map `α →o α →o β` to the diagonal;
* `order_hom.fst`: projection `prod.fst : α × β → α` as a bundled monotone map;
* `order_hom.snd`: projection `prod.snd : α × β → β` as a bundled monotone map;
* `order_hom.prod_map`: `prod.map f g` as a bundled monotone map;
* `pi.eval_order_hom`: evaluation of a function at a point `function.eval i` as a bundled
  monotone map;
* `order_hom.coe_fn_hom`: coercion to function as a bundled monotone map;
* `order_hom.apply`: application of a `order_hom` at a point as a bundled monotone map;
* `order_hom.pi`: combine a family of monotone maps `f i : α →o π i` into a monotone map
  `α →o Π i, π i`;
* `order_hom.pi_iso`: order isomorphism between `α →o Π i, π i` and `Π i, α →o π i`;
* `order_hom.subtyle.val`: embedding `subtype.val : subtype p → α` as a bundled monotone map;
* `order_hom.dual`: reinterpret a monotone map `α →o β` as a monotone map
  `order_dual α →o order_dual β`;
* `order_hom.dual_iso`: order isomorphism between `α →o β` and
  `order_dual (order_dual α →o order_dual β)`;
* `order_iso.compl`: order isomorphism `α ≃o order_dual α` given by taking complements in a
  boolean algebra;

We also define two functions to convert other bundled maps to `α →o β`:

* `order_embedding.to_order_hom`: convert `α ↪o β` to `α →o β`;
* `rel_hom.to_order_hom`: convert a `rel_hom` between strict orders to a `order_hom`.

## Tags

monotone map, bundled morphism
-/

open order_dual

variables {F α β γ δ : Type*}

/-- Bundled monotone (aka, increasing) function -/
structure order_hom (α β : Type*) [preorder α] [preorder β] :=
(to_fun   : α → β)
(monotone' : monotone to_fun)

infixr ` →o `:25 := order_hom

/-- An order embedding is an embedding `f : α ↪ β` such that `a ≤ b ↔ (f a) ≤ (f b)`.
This definition is an abbreviation of `rel_embedding (≤) (≤)`. -/
abbreviation order_embedding (α β : Type*) [has_le α] [has_le β] :=
@rel_embedding α β (≤) (≤)

infix ` ↪o `:25 := order_embedding

/-- An order isomorphism is an equivalence such that `a ≤ b ↔ (f a) ≤ (f b)`.
This definition is an abbreviation of `rel_iso (≤) (≤)`. -/
abbreviation order_iso (α β : Type*) [has_le α] [has_le β] := @rel_iso α β (≤) (≤)

infix ` ≃o `:25 := order_iso

/-- `order_hom_class F α b` asserts that `F` is a type of `≤`-preserving morphisms. -/
abbreviation order_hom_class (F : Type*) (α β : out_param Type*) [has_le α] [has_le β] :=
rel_hom_class F ((≤) : α → α → Prop) ((≤) : β → β → Prop)

/-- `order_iso_class F α β` states that `F` is a type of order isomorphisms.

You should extend this class when you extend `order_iso`. -/
class order_iso_class (F : Type*) (α β : out_param Type*) [has_le α] [has_le β]
  extends equiv_like F α β :=
(map_le_map_iff (f : F) {a b : α} : f a ≤ f b ↔ a ≤ b)

export order_iso_class (map_le_map_iff)

attribute [simp] map_le_map_iff

instance [has_le α] [has_le β] [order_iso_class F α β] : has_coe_t F (α ≃o β) :=
⟨λ f, ⟨f, λ _ _, map_le_map_iff f⟩⟩

@[priority 100] -- See note [lower instance priority]
instance order_iso_class.to_order_hom_class [has_le α] [has_le β] [order_iso_class F α β] :
  order_hom_class F α β :=
{ map_rel := λ f a b, (map_le_map_iff f).2, ..equiv_like.to_embedding_like }

namespace order_hom_class
variables [preorder α] [preorder β] [order_hom_class F α β]

protected lemma monotone (f : F) : monotone (f : α → β) := λ _ _, map_rel f
protected lemma mono (f : F) : monotone (f : α → β) := λ _ _, map_rel f

instance : has_coe_t F (α →o β) := ⟨λ f, { to_fun := f, monotone' := order_hom_class.mono _ }⟩

end order_hom_class

section order_iso_class
section has_le
variables [has_le α] [has_le β] [order_iso_class F α β]

@[simp] lemma map_inv_le_iff (f : F) {a : α} {b : β} : equiv_like.inv f b ≤ a ↔ b ≤ f a :=
by { convert (map_le_map_iff _).symm, exact (equiv_like.right_inv _ _).symm }

@[simp] lemma le_map_inv_iff (f : F) {a : α} {b : β} : a ≤ equiv_like.inv f b ↔ f a ≤ b :=
by { convert (map_le_map_iff _).symm, exact (equiv_like.right_inv _ _).symm }

end has_le

variables [preorder α] [preorder β] [order_iso_class F α β]
include β

lemma map_lt_map_iff (f : F) {a b : α} : f a < f b ↔ a < b :=
lt_iff_lt_of_le_iff_le' (map_le_map_iff f) (map_le_map_iff f)

@[simp] lemma map_inv_lt_iff (f : F) {a : α} {b : β} : equiv_like.inv f b < a ↔ b < f a :=
by { convert (map_lt_map_iff _).symm, exact (equiv_like.right_inv _ _).symm }

@[simp] lemma lt_map_inv_iff (f : F) {a : α} {b : β} : a < equiv_like.inv f b ↔ f a < b :=
by { convert (map_lt_map_iff _).symm, exact (equiv_like.right_inv _ _).symm }

end order_iso_class

namespace order_hom
variables [preorder α] [preorder β] [preorder γ] [preorder δ]

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (α →o β) (λ _, α → β) := ⟨order_hom.to_fun⟩

initialize_simps_projections order_hom (to_fun → coe)

protected lemma monotone (f : α →o β) : monotone f := f.monotone'
protected lemma mono (f : α →o β) : monotone f := f.monotone

instance : order_hom_class (α →o β) α β :=
{ coe := to_fun,
  coe_injective' := λ f g h, by { cases f, cases g, congr' },
  map_rel := λ f, f.monotone }

@[simp] lemma to_fun_eq_coe {f : α →o β} : f.to_fun = f := rfl
@[simp] lemma coe_fun_mk {f : α → β} (hf : _root_.monotone f) : (mk f hf : α → β) = f := rfl

@[ext] -- See library note [partially-applied ext lemmas]
lemma ext (f g : α →o β) (h : (f : α → β) = g) : f = g := fun_like.coe_injective h

/-- One can lift an unbundled monotone function to a bundled one. -/
instance : can_lift (α → β) (α →o β) :=
{ coe := coe_fn,
  cond := monotone,
  prf := λ f h, ⟨⟨f, h⟩, rfl⟩ }

/-- Copy of an `order_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : α →o β) (f' : α → β) (h : f' = f) : α →o β := ⟨f', h.symm.subst f.monotone'⟩

/-- The identity function as bundled monotone function. -/
@[simps {fully_applied := ff}]
def id : α →o α := ⟨id, monotone_id⟩

instance : inhabited (α →o α) := ⟨id⟩

/-- The preorder structure of `α →o β` is pointwise inequality: `f ≤ g ↔ ∀ a, f a ≤ g a`. -/
instance : preorder (α →o β) :=
@preorder.lift (α →o β) (α → β) _ coe_fn

instance {β : Type*} [partial_order β] : partial_order (α →o β) :=
@partial_order.lift (α →o β) (α → β) _ coe_fn ext

lemma le_def {f g : α →o β} : f ≤ g ↔ ∀ x, f x ≤ g x := iff.rfl

@[simp, norm_cast] lemma coe_le_coe {f g : α →o β} : (f : α → β) ≤ g ↔ f ≤ g := iff.rfl

@[simp] lemma mk_le_mk {f g : α → β} {hf hg} : mk f hf ≤ mk g hg ↔ f ≤ g := iff.rfl

@[mono] lemma apply_mono {f g : α →o β} {x y : α} (h₁ : f ≤ g) (h₂ : x ≤ y) :
  f x ≤ g y :=
(h₁ x).trans $ g.mono h₂

/-- Curry/uncurry as an order isomorphism between `α × β →o γ` and `α →o β →o γ`. -/
def curry : (α × β →o γ) ≃o (α →o β →o γ) :=
{ to_fun := λ f, ⟨λ x, ⟨function.curry f x, λ y₁ y₂ h, f.mono ⟨le_rfl, h⟩⟩,
    λ x₁ x₂ h y, f.mono ⟨h, le_rfl⟩⟩,
  inv_fun := λ f, ⟨function.uncurry (λ x, f x), λ x y h, (f.mono h.1 x.2).trans $ (f y.1).mono h.2⟩,
  left_inv := λ f, by { ext ⟨x, y⟩, refl },
  right_inv := λ f, by { ext x y, refl },
  map_rel_iff' := λ f g, by simp [le_def] }

@[simp] lemma curry_apply (f : α × β →o γ) (x : α) (y : β) : curry f x y = f (x, y) := rfl

@[simp] lemma curry_symm_apply (f : α →o β →o γ) (x : α × β) : curry.symm f x = f x.1 x.2 := rfl

/-- The composition of two bundled monotone functions. -/
@[simps {fully_applied := ff}]
def comp (g : β →o γ) (f : α →o β) : α →o γ := ⟨g ∘ f, g.mono.comp f.mono⟩

@[mono] lemma comp_mono ⦃g₁ g₂ : β →o γ⦄ (hg : g₁ ≤ g₂) ⦃f₁ f₂ : α →o β⦄ (hf : f₁ ≤ f₂) :
  g₁.comp f₁ ≤ g₂.comp f₂ :=
λ x, (hg _).trans (g₂.mono $ hf _)

/-- The composition of two bundled monotone functions, a fully bundled version. -/
@[simps {fully_applied := ff}]
def compₘ : (β →o γ) →o (α →o β) →o α →o γ :=
curry ⟨λ f : (β →o γ) × (α →o β), f.1.comp f.2, λ f₁ f₂ h, comp_mono h.1 h.2⟩

@[simp] lemma comp_id (f : α →o β) : comp f id = f :=
by { ext, refl }

@[simp] lemma id_comp (f : α →o β) : comp id f = f :=
by { ext, refl }

/-- Constant function bundled as a `order_hom`. -/
@[simps {fully_applied := ff}]
def const (α : Type*) [preorder α] {β : Type*} [preorder β] : β →o α →o β :=
{ to_fun := λ b, ⟨function.const α b, λ _ _ _, le_rfl⟩,
  monotone' := λ b₁ b₂ h x, h }

@[simp] lemma const_comp (f : α →o β) (c : γ) : (const β c).comp f = const α c := rfl

@[simp] lemma comp_const (γ : Type*) [preorder γ] (f : α →o β) (c : α) :
  f.comp (const γ c) = const γ (f c) := rfl

/-- Given two bundled monotone maps `f`, `g`, `f.prod g` is the map `x ↦ (f x, g x)` bundled as a
`order_hom`. -/
@[simps] protected def prod (f : α →o β) (g : α →o γ) : α →o (β × γ) :=
⟨λ x, (f x, g x), λ x y h, ⟨f.mono h, g.mono h⟩⟩

@[mono] lemma prod_mono {f₁ f₂ : α →o β} (hf : f₁ ≤ f₂) {g₁ g₂ : α →o γ} (hg : g₁ ≤ g₂) :
  f₁.prod g₁ ≤ f₂.prod g₂ :=
λ x, prod.le_def.2 ⟨hf _, hg _⟩

lemma comp_prod_comp_same (f₁ f₂ : β →o γ) (g : α →o β) :
  (f₁.comp g).prod (f₂.comp g) = (f₁.prod f₂).comp g :=
rfl

/-- Given two bundled monotone maps `f`, `g`, `f.prod g` is the map `x ↦ (f x, g x)` bundled as a
`order_hom`. This is a fully bundled version. -/
@[simps] def prodₘ : (α →o β) →o (α →o γ) →o α →o β × γ :=
curry ⟨λ f : (α →o β) × (α →o γ), f.1.prod f.2, λ f₁ f₂ h, prod_mono h.1 h.2⟩

/-- Diagonal embedding of `α` into `α × α` as a `order_hom`. -/
@[simps] def diag : α →o α × α := id.prod id

/-- Restriction of `f : α →o α →o β` to the diagonal. -/
@[simps {simp_rhs := tt}] def on_diag (f : α →o α →o β) : α →o β := (curry.symm f).comp diag

/-- `prod.fst` as a `order_hom`. -/
@[simps] def fst : α × β →o α := ⟨prod.fst, λ x y h, h.1⟩

/-- `prod.snd` as a `order_hom`. -/
@[simps] def snd : α × β →o β := ⟨prod.snd, λ x y h, h.2⟩

@[simp] lemma fst_prod_snd : (fst : α × β →o α).prod snd = id :=
by { ext ⟨x, y⟩ : 2, refl }

@[simp] lemma fst_comp_prod (f : α →o β) (g : α →o γ) : fst.comp (f.prod g) = f := ext _ _ rfl

@[simp] lemma snd_comp_prod (f : α →o β) (g : α →o γ) : snd.comp (f.prod g) = g := ext _ _ rfl

/-- Order isomorphism between the space of monotone maps to `β × γ` and the product of the spaces
of monotone maps to `β` and `γ`. -/
@[simps] def prod_iso : (α →o β × γ) ≃o (α →o β) × (α →o γ) :=
{ to_fun := λ f, (fst.comp f, snd.comp f),
  inv_fun := λ f, f.1.prod f.2,
  left_inv := λ f, by ext; refl,
  right_inv := λ f, by ext; refl,
  map_rel_iff' := λ f g, forall_and_distrib.symm }

/-- `prod.map` of two `order_hom`s as a `order_hom`. -/
@[simps] def prod_map (f : α →o β) (g : γ →o δ) : α × γ →o β × δ :=
⟨prod.map f g, λ x y h, ⟨f.mono h.1, g.mono h.2⟩⟩

variables {ι : Type*} {π : ι → Type*} [Π i, preorder (π i)]

/-- Evaluation of an unbundled function at a point (`function.eval`) as a `order_hom`. -/
@[simps {fully_applied := ff}]
def _root_.pi.eval_order_hom (i : ι) : (Π j, π j) →o π i :=
⟨function.eval i, function.monotone_eval i⟩

/-- The "forgetful functor" from `α →o β` to `α → β` that takes the underlying function,
is monotone. -/
@[simps {fully_applied := ff}] def coe_fn_hom : (α →o β) →o (α → β) :=
{ to_fun := λ f, f,
  monotone' := λ x y h, h }

/-- Function application `λ f, f a` (for fixed `a`) is a monotone function from the
monotone function space `α →o β` to `β`. See also `pi.eval_order_hom`.  -/
@[simps {fully_applied := ff}] def apply (x : α) : (α →o β) →o β :=
(pi.eval_order_hom x).comp coe_fn_hom

/-- Construct a bundled monotone map `α →o Π i, π i` from a family of monotone maps
`f i : α →o π i`. -/
@[simps] def pi (f : Π i, α →o π i) : α →o (Π i, π i) :=
⟨λ x i, f i x, λ x y h i, (f i).mono h⟩

/-- Order isomorphism between bundled monotone maps `α →o Π i, π i` and families of bundled monotone
maps `Π i, α →o π i`. -/
@[simps] def pi_iso : (α →o Π i, π i) ≃o Π i, α →o π i :=
{ to_fun := λ f i, (pi.eval_order_hom i).comp f,
  inv_fun := pi,
  left_inv := λ f, by { ext x i, refl },
  right_inv := λ f, by { ext x i, refl },
  map_rel_iff' := λ f g, forall_swap }

/-- `subtype.val` as a bundled monotone function.  -/
@[simps {fully_applied := ff}]
def subtype.val (p : α → Prop) : subtype p →o α :=
⟨subtype.val, λ x y h, h⟩

-- TODO[gh-6025]: make this a global instance once safe to do so
/-- There is a unique monotone map from a subsingleton to itself. -/
local attribute [instance]
def unique [subsingleton α] : unique (α →o α) :=
{ default := order_hom.id, uniq := λ a, ext _ _ (subsingleton.elim _ _) }

lemma order_hom_eq_id [subsingleton α] (g : α →o α) : g = order_hom.id :=
subsingleton.elim _ _

/-- Reinterpret a bundled monotone function as a monotone function between dual orders. -/
@[simps] protected def dual : (α →o β) ≃ (order_dual α →o order_dual β) :=
{ to_fun := λ f, ⟨order_dual.to_dual ∘ f ∘ order_dual.of_dual, f.mono.dual⟩,
  inv_fun := λ f, ⟨order_dual.of_dual ∘ f ∘ order_dual.to_dual, f.mono.dual⟩,
  left_inv := λ f, ext _ _ rfl,
  right_inv := λ f, ext _ _ rfl }

@[simp] lemma dual_id : (order_hom.id : α →o α).dual = order_hom.id := rfl
@[simp] lemma dual_comp (g : β →o γ) (f : α →o β) : (g.comp f).dual = g.dual.comp f.dual := rfl

@[simp] lemma symm_dual_id : order_hom.dual.symm order_hom.id = (order_hom.id : α →o α) := rfl
@[simp] lemma symm_dual_comp (g : order_dual β →o order_dual γ)
  (f : order_dual α →o order_dual β) :
  order_hom.dual.symm (g.comp f) = (order_hom.dual.symm g).comp (order_hom.dual.symm f) := rfl

/-- `order_hom.dual` as an order isomorphism. -/
def dual_iso (α β : Type*) [preorder α] [preorder β] :
  (α →o β) ≃o order_dual (order_dual α →o order_dual β) :=
{ to_equiv := order_hom.dual.trans order_dual.to_dual,
  map_rel_iff' := λ f g, iff.rfl }

end order_hom

/-- Embeddings of partial orders that preserve `<` also preserve `≤`. -/
def rel_embedding.order_embedding_of_lt_embedding [partial_order α] [partial_order β]
  (f : ((<) : α → α → Prop) ↪r ((<) : β → β → Prop)) :
  α ↪o β :=
{ map_rel_iff' := by { intros, simp [le_iff_lt_or_eq,f.map_rel_iff, f.injective.eq_iff] }, .. f }

@[simp]
lemma rel_embedding.order_embedding_of_lt_embedding_apply [partial_order α] [partial_order β]
  {f : ((<) : α → α → Prop) ↪r ((<) : β → β → Prop)} {x : α} :
  rel_embedding.order_embedding_of_lt_embedding f x = f x := rfl

namespace order_embedding

variables [preorder α] [preorder β] (f : α ↪o β)

/-- `<` is preserved by order embeddings of preorders. -/
def lt_embedding : ((<) : α → α → Prop) ↪r ((<) : β → β → Prop) :=
{ map_rel_iff' := by intros; simp [lt_iff_le_not_le, f.map_rel_iff], .. f }

@[simp] lemma lt_embedding_apply (x : α) : f.lt_embedding x = f x := rfl

@[simp] theorem le_iff_le {a b} : (f a) ≤ (f b) ↔ a ≤ b := f.map_rel_iff

@[simp] theorem lt_iff_lt {a b} : f a < f b ↔ a < b :=
f.lt_embedding.map_rel_iff

@[simp] lemma eq_iff_eq {a b} : f a = f b ↔ a = b := f.injective.eq_iff

protected theorem monotone : monotone f := order_hom_class.monotone f

protected theorem strict_mono : strict_mono f := λ x y, f.lt_iff_lt.2

protected theorem acc (a : α) : acc (<) (f a) → acc (<) a :=
f.lt_embedding.acc a

protected theorem well_founded :
  well_founded ((<) : β → β → Prop) → well_founded ((<) : α → α → Prop) :=
f.lt_embedding.well_founded

protected theorem is_well_order [is_well_order β (<)] : is_well_order α (<) :=
f.lt_embedding.is_well_order

/-- An order embedding is also an order embedding between dual orders. -/
protected def dual : order_dual α ↪o order_dual β :=
⟨f.to_embedding, λ a b, f.map_rel_iff⟩

/--
To define an order embedding from a partial order to a preorder it suffices to give a function
together with a proof that it satisfies `f a ≤ f b ↔ a ≤ b`.
-/
def of_map_le_iff {α β} [partial_order α] [preorder β] (f : α → β)
  (hf : ∀ a b, f a ≤ f b ↔ a ≤ b) : α ↪o β :=
rel_embedding.of_map_rel_iff f hf

@[simp] lemma coe_of_map_le_iff {α β} [partial_order α] [preorder β] {f : α → β} (h) :
  ⇑(of_map_le_iff f h) = f := rfl

/-- A strictly monotone map from a linear order is an order embedding. --/
def of_strict_mono {α β} [linear_order α] [preorder β] (f : α → β)
  (h : strict_mono f) : α ↪o β :=
of_map_le_iff f (λ _ _, h.le_iff_le)

@[simp] lemma coe_of_strict_mono {α β} [linear_order α] [preorder β] {f : α → β}
  (h : strict_mono f) : ⇑(of_strict_mono f h) = f := rfl

/-- Embedding of a subtype into the ambient type as an `order_embedding`. -/
@[simps {fully_applied := ff}] def subtype (p : α → Prop) : subtype p ↪o α :=
⟨function.embedding.subtype p, λ x y, iff.rfl⟩

/-- Convert an `order_embedding` to a `order_hom`. -/
@[simps {fully_applied := ff}]
def to_order_hom {X Y : Type*} [preorder X] [preorder Y] (f : X ↪o Y) : X →o Y :=
{ to_fun := f,
  monotone' := f.monotone }

end order_embedding
section rel_hom

variables [partial_order α] [preorder β]

namespace rel_hom

variables (f : ((<) : α → α → Prop) →r ((<) : β → β → Prop))

/-- A bundled expression of the fact that a map between partial orders that is strictly monotone
is weakly monotone. -/
@[simps {fully_applied := ff}]
def to_order_hom : α →o β :=
{ to_fun    := f,
  monotone' := strict_mono.monotone (λ x y, f.map_rel), }

end rel_hom

lemma rel_embedding.to_order_hom_injective (f : ((<) : α → α → Prop) ↪r ((<) : β → β → Prop)) :
  function.injective (f : ((<) : α → α → Prop) →r ((<) : β → β → Prop)).to_order_hom :=
λ _ _ h, f.injective h

end rel_hom

namespace order_iso

section has_le

variables [has_le α] [has_le β] [has_le γ]

instance : order_iso_class (α ≃o β) α β :=
{ coe := λ f, f.to_fun,
  inv := λ f, f.inv_fun,
  left_inv := λ f, f.left_inv,
  right_inv := λ f, f.right_inv,
  coe_injective' := λ f g h₁ h₂, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_le_map_iff := λ f, f.map_rel_iff' }

@[simp] lemma to_fun_eq_coe {f : α ≃o β} : f.to_fun = f := rfl

@[ext] -- See note [partially-applied ext lemmas]
lemma ext {f g : α ≃o β} (h : (f : α → β) = g) : f = g := fun_like.coe_injective h

/-- Reinterpret an order isomorphism as an order embedding. -/
def to_order_embedding (e : α ≃o β) : α ↪o β :=
e.to_rel_embedding

@[simp] lemma coe_to_order_embedding (e : α ≃o β) :
  ⇑(e.to_order_embedding) = e := rfl

protected lemma bijective (e : α ≃o β) : function.bijective e := e.to_equiv.bijective
protected lemma injective (e : α ≃o β) : function.injective e := e.to_equiv.injective
protected lemma surjective (e : α ≃o β) : function.surjective e := e.to_equiv.surjective

@[simp] lemma range_eq (e : α ≃o β) : set.range e = set.univ := e.surjective.range_eq

@[simp] lemma apply_eq_iff_eq (e : α ≃o β) {x y : α} : e x = e y ↔ x = y :=
e.to_equiv.apply_eq_iff_eq

/-- Identity order isomorphism. -/
def refl (α : Type*) [has_le α] : α ≃o α := rel_iso.refl (≤)

@[simp] lemma coe_refl : ⇑(refl α) = id := rfl

lemma refl_apply (x : α) : refl α x = x := rfl

@[simp] lemma refl_to_equiv : (refl α).to_equiv = equiv.refl α := rfl

/-- Inverse of an order isomorphism. -/
def symm (e : α ≃o β) : β ≃o α := e.symm

@[simp] lemma apply_symm_apply (e : α ≃o β) (x : β) : e (e.symm x) = x :=
e.to_equiv.apply_symm_apply x

@[simp] lemma symm_apply_apply (e : α ≃o β) (x : α) : e.symm (e x) = x :=
e.to_equiv.symm_apply_apply x

@[simp] lemma symm_refl (α : Type*) [has_le α] : (refl α).symm = refl α := rfl

lemma apply_eq_iff_eq_symm_apply (e : α ≃o β) (x : α) (y : β) : e x = y ↔ x = e.symm y :=
e.to_equiv.apply_eq_iff_eq_symm_apply

theorem symm_apply_eq (e : α ≃o β) {x : α} {y : β} : e.symm y = x ↔ y = e x :=
e.to_equiv.symm_apply_eq

@[simp] lemma symm_symm (e : α ≃o β) : e.symm.symm = e := by { ext, refl }

lemma symm_injective : function.injective (symm : (α ≃o β) → (β ≃o α)) :=
λ e e' h, by rw [← e.symm_symm, h, e'.symm_symm]

@[simp] lemma to_equiv_symm (e : α ≃o β) : e.to_equiv.symm = e.symm.to_equiv := rfl

@[simp] lemma symm_image_image (e : α ≃o β) (s : set α) : e.symm '' (e '' s) = s :=
e.to_equiv.symm_image_image s

@[simp] lemma image_symm_image (e : α ≃o β) (s : set β) : e '' (e.symm '' s) = s :=
e.to_equiv.image_symm_image s

lemma image_eq_preimage (e : α ≃o β) (s : set α) : e '' s = e.symm ⁻¹' s :=
e.to_equiv.image_eq_preimage s

@[simp] lemma preimage_symm_preimage (e : α ≃o β) (s : set α) : e ⁻¹' (e.symm ⁻¹' s) = s :=
e.to_equiv.preimage_symm_preimage s

@[simp] lemma symm_preimage_preimage (e : α ≃o β) (s : set β) : e.symm ⁻¹' (e ⁻¹' s) = s :=
e.to_equiv.symm_preimage_preimage s

@[simp] lemma image_preimage (e : α ≃o β) (s : set β) : e '' (e ⁻¹' s) = s :=
e.to_equiv.image_preimage s

@[simp] lemma preimage_image (e : α ≃o β) (s : set α) : e ⁻¹' (e '' s) = s :=
e.to_equiv.preimage_image s

/-- Composition of two order isomorphisms is an order isomorphism. -/
@[trans] def trans (e : α ≃o β) (e' : β ≃o γ) : α ≃o γ := e.trans e'

@[simp] lemma coe_trans (e : α ≃o β) (e' : β ≃o γ) : ⇑(e.trans e') = e' ∘ e := rfl

lemma trans_apply (e : α ≃o β) (e' : β ≃o γ) (x : α) : e.trans e' x = e' (e x) := rfl

@[simp] lemma refl_trans (e : α ≃o β) : (refl α).trans e = e := by { ext x, refl }

@[simp] lemma trans_refl (e : α ≃o β) : e.trans (refl β) = e := by { ext x, refl }

/-- `prod.swap` as an `order_iso`. -/
def prod_comm : (α × β) ≃o (β × α) :=
{ to_equiv := equiv.prod_comm α β,
  map_rel_iff' := λ a b, prod.swap_le_swap }

@[simp] lemma coe_prod_comm : ⇑(prod_comm : (α × β) ≃o (β × α)) = prod.swap := rfl
@[simp] lemma prod_comm_symm : (prod_comm : (α × β) ≃o (β × α)).symm = prod_comm := rfl

variables (α)

/-- The order isomorphism between a type and its double dual. -/
def dual_dual : α ≃o order_dual (order_dual α) := refl α

@[simp] lemma coe_dual_dual : ⇑(dual_dual α) = to_dual ∘ to_dual := rfl
@[simp] lemma coe_dual_dual_symm : ⇑(dual_dual α).symm = of_dual ∘ of_dual := rfl

variables {α}

@[simp] lemma dual_dual_apply (a : α) : dual_dual α a = to_dual (to_dual a) := rfl

@[simp] lemma dual_dual_symm_apply (a : order_dual (order_dual α)) :
  (dual_dual α).symm a = of_dual (of_dual a) := rfl

end has_le

open set

section le

variables [has_le α] [has_le β] [has_le γ]

@[simp] lemma le_iff_le (e : α ≃o β) {x y : α} : e x ≤ e y ↔ x ≤ y := e.map_rel_iff

lemma le_symm_apply (e : α ≃o β) {x : α} {y : β} : x ≤ e.symm y ↔ e x ≤ y :=
e.rel_symm_apply

lemma symm_apply_le (e : α ≃o β) {x : α} {y : β} : e.symm y ≤ x ↔ y ≤ e x :=
e.symm_apply_rel

end le

variables [preorder α] [preorder β] [preorder γ]

protected lemma monotone (e : α ≃o β) : monotone e := e.to_order_embedding.monotone

protected lemma strict_mono (e : α ≃o β) : strict_mono e := e.to_order_embedding.strict_mono

@[simp] lemma lt_iff_lt (e : α ≃o β) {x y : α} : e x < e y ↔ x < y :=
e.to_order_embedding.lt_iff_lt

/-- To show that `f : α → β`, `g : β → α` make up an order isomorphism of linear orders,
    it suffices to prove `cmp a (g b) = cmp (f a) b`. --/
def of_cmp_eq_cmp {α β} [linear_order α] [linear_order β] (f : α → β) (g : β → α)
  (h : ∀ (a : α) (b : β), cmp a (g b) = cmp (f a) b) : α ≃o β :=
have gf : ∀ (a : α), a = g (f a) := by { intro, rw [←cmp_eq_eq_iff, h, cmp_self_eq_eq] },
{ to_fun := f,
  inv_fun := g,
  left_inv := λ a, (gf a).symm,
  right_inv := by { intro, rw [←cmp_eq_eq_iff, ←h, cmp_self_eq_eq] },
  map_rel_iff' := by { intros, apply le_iff_le_of_cmp_eq_cmp, convert (h _ _).symm, apply gf } }

/-- Order isomorphism between two equal sets. -/
def set_congr (s t : set α) (h : s = t) : s ≃o t :=
{ to_equiv := equiv.set_congr h,
  map_rel_iff' := λ x y, iff.rfl }

/-- Order isomorphism between `univ : set α` and `α`. -/
def set.univ : (set.univ : set α) ≃o α :=
{ to_equiv := equiv.set.univ α,
  map_rel_iff' := λ x y, iff.rfl }

/-- Order isomorphism between `α → β` and `β`, where `α` has a unique element. -/
@[simps to_equiv apply] def fun_unique (α β : Type*) [unique α] [preorder β] :
  (α → β) ≃o β :=
{ to_equiv := equiv.fun_unique α β,
  map_rel_iff' := λ f g, by simp [pi.le_def, unique.forall_iff] }

@[simp] lemma fun_unique_symm_apply {α β : Type*} [unique α] [preorder β] :
  ((fun_unique α β).symm : β → α → β) = function.const α := rfl

end order_iso

namespace equiv

variables [preorder α] [preorder β]

/-- If `e` is an equivalence with monotone forward and inverse maps, then `e` is an
order isomorphism. -/
def to_order_iso (e : α ≃ β) (h₁ : monotone e) (h₂ : monotone e.symm) :
  α ≃o β :=
⟨e, λ x y, ⟨λ h, by simpa only [e.symm_apply_apply] using h₂ h, λ h, h₁ h⟩⟩

@[simp] lemma coe_to_order_iso (e : α ≃ β) (h₁ : monotone e) (h₂ : monotone e.symm) :
  ⇑(e.to_order_iso h₁ h₂) = e := rfl

@[simp] lemma to_order_iso_to_equiv (e : α ≃ β) (h₁ : monotone e) (h₂ : monotone e.symm) :
  (e.to_order_iso h₁ h₂).to_equiv = e := rfl

end equiv

/-- If a function `f` is strictly monotone on a set `s`, then it defines an order isomorphism
between `s` and its image. -/
protected noncomputable def strict_mono_on.order_iso {α β} [linear_order α] [preorder β]
  (f : α → β) (s : set α) (hf : strict_mono_on f s) :
  s ≃o f '' s :=
{ to_equiv := hf.inj_on.bij_on_image.equiv _,
  map_rel_iff' := λ x y, hf.le_iff_le x.2 y.2 }

/-- A strictly monotone function from a linear order is an order isomorphism between its domain and
its range. -/
protected noncomputable def strict_mono.order_iso {α β} [linear_order α] [preorder β] (f : α → β)
  (h_mono : strict_mono f) : α ≃o set.range f :=
{ to_equiv := equiv.of_injective f h_mono.injective,
  map_rel_iff' := λ a b, h_mono.le_iff_le }

/-- A strictly monotone surjective function from a linear order is an order isomorphism. -/
noncomputable def strict_mono.order_iso_of_surjective {α β} [linear_order α] [preorder β]
  (f : α → β) (h_mono : strict_mono f) (h_surj : function.surjective f) : α ≃o β :=
(h_mono.order_iso f).trans $ (order_iso.set_congr _ _ h_surj.range_eq).trans order_iso.set.univ

/-- A strictly monotone function with a right inverse is an order isomorphism. -/
def strict_mono.order_iso_of_right_inverse {α β} [linear_order α] [preorder β]
  (f : α → β) (h_mono : strict_mono f) (g : β → α) (hg : function.right_inverse g f) : α ≃o β :=
{ to_fun := f,
  inv_fun := g,
  left_inv := λ x, h_mono.injective $ hg _,
  right_inv := hg,
  .. order_embedding.of_strict_mono f h_mono }

/-- An order isomorphism is also an order isomorphism between dual orders. -/
protected def order_iso.dual [has_le α] [has_le β] (f : α ≃o β) :
  order_dual α ≃o order_dual β := ⟨f.to_equiv, λ _ _, f.map_rel_iff⟩

section lattice_isos

lemma order_iso.map_bot' [has_le α] [partial_order β] (f : α ≃o β) {x : α} {y : β}
  (hx : ∀ x', x ≤ x') (hy : ∀ y', y ≤ y') : f x = y :=
by { refine le_antisymm _ (hy _), rw [← f.apply_symm_apply y, f.map_rel_iff], apply hx }

lemma order_iso.map_bot [has_le α] [partial_order β] [order_bot α] [order_bot β] (f : α ≃o β) :
  f ⊥ = ⊥ :=
f.map_bot' (λ _, bot_le) (λ _, bot_le)

lemma order_iso.map_top' [has_le α] [partial_order β] (f : α ≃o β) {x : α} {y : β}
  (hx : ∀ x', x' ≤ x) (hy : ∀ y', y' ≤ y) : f x = y :=
f.dual.map_bot' hx hy

lemma order_iso.map_top [has_le α] [partial_order β] [order_top α] [order_top β] (f : α ≃o β) :
  f ⊤ = ⊤ :=
f.dual.map_bot

lemma order_embedding.map_inf_le [semilattice_inf α] [semilattice_inf β]
  (f : α ↪o β) (x y : α) :
  f (x ⊓ y) ≤ f x ⊓ f y :=
f.monotone.map_inf_le x y

lemma order_iso.map_inf [semilattice_inf α] [semilattice_inf β]
  (f : α ≃o β) (x y : α) :
  f (x ⊓ y) = f x ⊓ f y :=
begin
  refine (f.to_order_embedding.map_inf_le x y).antisymm _,
  simpa [← f.symm.le_iff_le] using f.symm.to_order_embedding.map_inf_le (f x) (f y)
end

/-- Note that this goal could also be stated `(disjoint on f) a b` -/
lemma disjoint.map_order_iso [semilattice_inf α] [order_bot α] [semilattice_inf β] [order_bot β]
  {a b : α} (f : α ≃o β) (ha : disjoint a b) : disjoint (f a) (f b) :=
begin
  rw [disjoint, ←f.map_inf, ←f.map_bot],
  exact f.monotone ha,
end

@[simp] lemma disjoint_map_order_iso_iff [semilattice_inf α] [order_bot α] [semilattice_inf β]
  [order_bot β] {a b : α} (f : α ≃o β) : disjoint (f a) (f b) ↔ disjoint a b :=
⟨λ h, f.symm_apply_apply a ▸ f.symm_apply_apply b ▸ h.map_order_iso f.symm, λ h, h.map_order_iso f⟩

lemma order_embedding.le_map_sup [semilattice_sup α] [semilattice_sup β]
  (f : α ↪o β) (x y : α) :
  f x ⊔ f y ≤ f (x ⊔ y) :=
f.monotone.le_map_sup x y

lemma order_iso.map_sup [semilattice_sup α] [semilattice_sup β]
  (f : α ≃o β) (x y : α) :
  f (x ⊔ y) = f x ⊔ f y :=
f.dual.map_inf x y

namespace with_bot

/-- Taking the dual then adding `⊥` is the same as adding `⊤` then taking the dual. -/
protected def to_dual_top [has_le α] : with_bot (order_dual α) ≃o order_dual (with_top α) :=
order_iso.refl _

@[simp] lemma to_dual_top_coe [has_le α] (a : α) :
  with_bot.to_dual_top ↑(to_dual a) = to_dual (a : with_top α) := rfl
@[simp] lemma to_dual_top_symm_coe [has_le α] (a : α) :
  with_bot.to_dual_top.symm (to_dual (a : with_top α)) = ↑(to_dual a) := rfl

end with_bot

namespace with_top

/-- Taking the dual then adding `⊤` is the same as adding `⊥` then taking the dual. -/
protected def to_dual_bot [has_le α] : with_top (order_dual α) ≃o order_dual (with_bot α) :=
order_iso.refl _

@[simp] lemma to_dual_bot_coe [has_le α] (a : α) :
  with_top.to_dual_bot ↑(to_dual a) = to_dual (a : with_bot α) := rfl
@[simp] lemma to_dual_bot_symm_coe [has_le α] (a : α) :
  with_top.to_dual_bot.symm (to_dual (a : with_bot α)) = ↑(to_dual a) := rfl

end with_top

namespace order_iso
variables [partial_order α] [partial_order β] [partial_order γ]

/-- A version of `equiv.option_congr` for `with_top`. -/
@[simps apply]
def with_top_congr (e : α ≃o β) : with_top α ≃o with_top β :=
{ to_equiv := e.to_equiv.option_congr,
  map_rel_iff' := λ x y,
    by induction x using with_top.rec_top_coe; induction y using with_top.rec_top_coe; simp }

@[simp] lemma with_top_congr_refl : (order_iso.refl α).with_top_congr = order_iso.refl _ :=
rel_iso.to_equiv_injective equiv.option_congr_refl

@[simp] lemma with_top_congr_symm (e : α ≃o β) : e.with_top_congr.symm = e.symm.with_top_congr :=
rel_iso.to_equiv_injective e.to_equiv.option_congr_symm

@[simp] lemma with_top_congr_trans (e₁ : α ≃o β) (e₂ : β ≃o γ) :
  e₁.with_top_congr.trans e₂.with_top_congr = (e₁.trans e₂).with_top_congr :=
rel_iso.to_equiv_injective $ e₁.to_equiv.option_congr_trans e₂.to_equiv

/-- A version of `equiv.option_congr` for `with_bot`. -/
@[simps apply]
def with_bot_congr (e : α ≃o β) :
  with_bot α ≃o with_bot β :=
{ to_equiv := e.to_equiv.option_congr,
  map_rel_iff' := λ x y,
    by induction x using with_bot.rec_bot_coe; induction y using with_bot.rec_bot_coe; simp }

@[simp] lemma with_bot_congr_refl : (order_iso.refl α).with_bot_congr = order_iso.refl _ :=
rel_iso.to_equiv_injective equiv.option_congr_refl

@[simp] lemma with_bot_congr_symm (e : α ≃o β) : e.with_bot_congr.symm = e.symm.with_bot_congr :=
rel_iso.to_equiv_injective e.to_equiv.option_congr_symm

@[simp] lemma with_bot_congr_trans (e₁ : α ≃o β) (e₂ : β ≃o γ) :
  e₁.with_bot_congr.trans e₂.with_bot_congr = (e₁.trans e₂).with_bot_congr :=
rel_iso.to_equiv_injective $ e₁.to_equiv.option_congr_trans e₂.to_equiv

end order_iso

section bounded_order

variables [lattice α] [lattice β] [bounded_order α] [bounded_order β] (f : α ≃o β)
include f

lemma order_iso.is_compl {x y : α} (h : is_compl x y) : is_compl (f x) (f y) :=
⟨by { rw [← f.map_bot, ← f.map_inf, f.map_rel_iff], exact h.1 },
  by { rw [← f.map_top, ← f.map_sup, f.map_rel_iff], exact h.2 }⟩

theorem order_iso.is_compl_iff {x y : α} :
  is_compl x y ↔ is_compl (f x) (f y) :=
⟨f.is_compl, λ h, begin
  rw [← f.symm_apply_apply x, ← f.symm_apply_apply y],
  exact f.symm.is_compl h,
end⟩

lemma order_iso.is_complemented
  [is_complemented α] : is_complemented β :=
⟨λ x, begin
  obtain ⟨y, hy⟩ := exists_is_compl (f.symm x),
  rw ← f.symm_apply_apply y at hy,
  refine ⟨f y, f.symm.is_compl_iff.2 hy⟩,
end⟩

theorem order_iso.is_complemented_iff :
  is_complemented α ↔ is_complemented β :=
⟨by { introI, exact f.is_complemented }, by { introI, exact f.symm.is_complemented }⟩

end bounded_order
end lattice_isos

section boolean_algebra
variables (α) [boolean_algebra α]

/-- Taking complements as an order isomorphism to the order dual. -/
@[simps]
def order_iso.compl : α ≃o order_dual α :=
{ to_fun := order_dual.to_dual ∘ compl,
  inv_fun := compl ∘ order_dual.of_dual,
  left_inv := compl_compl,
  right_inv := compl_compl,
  map_rel_iff' := λ x y, compl_le_compl_iff_le }

theorem compl_strict_anti : strict_anti (compl : α → α) :=
(order_iso.compl α).strict_mono

theorem compl_antitone : antitone (compl : α → α) :=
(order_iso.compl α).monotone

end boolean_algebra


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.basic
import Mathlib.PostPort

universes u v

namespace Mathlib

namespace list

/- pairwise relation (generalized no duplicate) -/

theorem pairwise_iff {α : Type u} (R : α → α → Prop) : ∀ (ᾰ : List α),
  pairwise R ᾰ ↔
    ᾰ = [] ∨ Exists fun {a : α} => Exists fun {l : List α} => (∀ (a' : α), a' ∈ l → R a a') ∧ pairwise R l ∧ ᾰ = a :: l := sorry

theorem rel_of_pairwise_cons {α : Type u} {R : α → α → Prop} {a : α} {l : List α} (p : pairwise R (a :: l)) {a' : α} : a' ∈ l → R a a' :=
  and.left (iff.mp pairwise_cons p)

theorem pairwise_of_pairwise_cons {α : Type u} {R : α → α → Prop} {a : α} {l : List α} (p : pairwise R (a :: l)) : pairwise R l :=
  and.right (iff.mp pairwise_cons p)

theorem pairwise.tail {α : Type u} {R : α → α → Prop} {l : List α} (p : pairwise R l) : pairwise R (tail l) := sorry

theorem pairwise.imp_of_mem {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {l : List α} (H : ∀ {a b : α}, a ∈ l → b ∈ l → R a b → S a b) (p : pairwise R l) : pairwise S l := sorry

theorem pairwise.imp {α : Type u} {R : α → α → Prop} {S : α → α → Prop} (H : ∀ (a b : α), R a b → S a b) {l : List α} : pairwise R l → pairwise S l :=
  pairwise.imp_of_mem fun (a b : α) (_x : a ∈ l) (_x : b ∈ l) => H a b

theorem pairwise.and {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {l : List α} : pairwise (fun (a b : α) => R a b ∧ S a b) l ↔ pairwise R l ∧ pairwise S l := sorry

theorem pairwise.imp₂ {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {T : α → α → Prop} (H : ∀ (a b : α), R a b → S a b → T a b) {l : List α} (hR : pairwise R l) (hS : pairwise S l) : pairwise T l :=
  pairwise.imp (fun (a b : α) => And._oldrec (H a b)) (iff.mpr pairwise.and { left := hR, right := hS })

theorem pairwise.iff_of_mem {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {l : List α} (H : ∀ {a b : α}, a ∈ l → b ∈ l → (R a b ↔ S a b)) : pairwise R l ↔ pairwise S l :=
  { mp := pairwise.imp_of_mem fun (a b : α) (m : a ∈ l) (m' : b ∈ l) => iff.mp (H m m'),
    mpr := pairwise.imp_of_mem fun (a b : α) (m : a ∈ l) (m' : b ∈ l) => iff.mpr (H m m') }

theorem pairwise.iff {α : Type u} {R : α → α → Prop} {S : α → α → Prop} (H : ∀ (a b : α), R a b ↔ S a b) {l : List α} : pairwise R l ↔ pairwise S l :=
  pairwise.iff_of_mem fun (a b : α) (_x : a ∈ l) (_x : b ∈ l) => H a b

theorem pairwise_of_forall {α : Type u} {R : α → α → Prop} {l : List α} (H : ∀ (x y : α), R x y) : pairwise R l := sorry

theorem pairwise.and_mem {α : Type u} {R : α → α → Prop} {l : List α} : pairwise R l ↔ pairwise (fun (x y : α) => x ∈ l ∧ y ∈ l ∧ R x y) l := sorry

theorem pairwise.imp_mem {α : Type u} {R : α → α → Prop} {l : List α} : pairwise R l ↔ pairwise (fun (x y : α) => x ∈ l → y ∈ l → R x y) l := sorry

theorem pairwise_of_sublist {α : Type u} {R : α → α → Prop} {l₁ : List α} {l₂ : List α} : l₁ <+ l₂ → pairwise R l₂ → pairwise R l₁ := sorry

theorem forall_of_forall_of_pairwise {α : Type u} {R : α → α → Prop} (H : symmetric R) {l : List α} (H₁ : ∀ (x : α), x ∈ l → R x x) (H₂ : pairwise R l) (x : α) : x ∈ l → ∀ (y : α), y ∈ l → R x y := sorry

theorem forall_of_pairwise {α : Type u} {R : α → α → Prop} (H : symmetric R) {l : List α} (hl : pairwise R l) (a : α) : a ∈ l → ∀ (b : α), b ∈ l → a ≠ b → R a b :=
  forall_of_forall_of_pairwise (fun (a b : α) (h : a ≠ b → R a b) (hne : b ≠ a) => H (h (ne.symm hne)))
    (fun (_x : α) (_x_1 : _x ∈ l) (h : _x ≠ _x) => false.elim (h rfl))
    (pairwise.imp (fun (_x _x_1 : α) (h : R _x _x_1) (_x : _x ≠ _x_1) => h) hl)

theorem pairwise_singleton {α : Type u} (R : α → α → Prop) (a : α) : pairwise R [a] := sorry

theorem pairwise_pair {α : Type u} {R : α → α → Prop} {a : α} {b : α} : pairwise R [a, b] ↔ R a b := sorry

theorem pairwise_append {α : Type u} {R : α → α → Prop} {l₁ : List α} {l₂ : List α} : pairwise R (l₁ ++ l₂) ↔ pairwise R l₁ ∧ pairwise R l₂ ∧ ∀ (x : α), x ∈ l₁ → ∀ (y : α), y ∈ l₂ → R x y := sorry

theorem pairwise_append_comm {α : Type u} {R : α → α → Prop} (s : symmetric R) {l₁ : List α} {l₂ : List α} : pairwise R (l₁ ++ l₂) ↔ pairwise R (l₂ ++ l₁) := sorry

theorem pairwise_middle {α : Type u} {R : α → α → Prop} (s : symmetric R) {a : α} {l₁ : List α} {l₂ : List α} : pairwise R (l₁ ++ a :: l₂) ↔ pairwise R (a :: (l₁ ++ l₂)) := sorry

theorem pairwise_map {α : Type u} {β : Type v} {R : α → α → Prop} (f : β → α) {l : List β} : pairwise R (map f l) ↔ pairwise (fun (a b : β) => R (f a) (f b)) l := sorry

theorem pairwise_of_pairwise_map {α : Type u} {β : Type v} {R : α → α → Prop} {S : β → β → Prop} (f : α → β) (H : ∀ (a b : α), S (f a) (f b) → R a b) {l : List α} (p : pairwise S (map f l)) : pairwise R l :=
  pairwise.imp H (iff.mp (pairwise_map f) p)

theorem pairwise_map_of_pairwise {α : Type u} {β : Type v} {R : α → α → Prop} {S : β → β → Prop} (f : α → β) (H : ∀ (a b : α), R a b → S (f a) (f b)) {l : List α} (p : pairwise R l) : pairwise S (map f l) :=
  iff.mpr (pairwise_map f) (pairwise.imp H p)

theorem pairwise_filter_map {α : Type u} {β : Type v} {R : α → α → Prop} (f : β → Option α) {l : List β} : pairwise R (filter_map f l) ↔ pairwise (fun (a a' : β) => ∀ (b : α), b ∈ f a → ∀ (b' : α), b' ∈ f a' → R b b') l := sorry

theorem pairwise_filter_map_of_pairwise {α : Type u} {β : Type v} {R : α → α → Prop} {S : β → β → Prop} (f : α → Option β) (H : ∀ (a a' : α), R a a' → ∀ (b : β), b ∈ f a → ∀ (b' : β), b' ∈ f a' → S b b') {l : List α} (p : pairwise R l) : pairwise S (filter_map f l) :=
  iff.mpr (pairwise_filter_map f) (pairwise.imp H p)

theorem pairwise_filter {α : Type u} {R : α → α → Prop} (p : α → Prop) [decidable_pred p] {l : List α} : pairwise R (filter p l) ↔ pairwise (fun (x y : α) => p x → p y → R x y) l := sorry

theorem pairwise_filter_of_pairwise {α : Type u} {R : α → α → Prop} (p : α → Prop) [decidable_pred p] {l : List α} : pairwise R l → pairwise R (filter p l) :=
  pairwise_of_sublist (filter_sublist l)

theorem pairwise_pmap {α : Type u} {β : Type v} {R : α → α → Prop} {p : β → Prop} {f : (b : β) → p b → α} {l : List β} (h : ∀ (x : β), x ∈ l → p x) : pairwise R (pmap f l h) ↔ pairwise (fun (b₁ b₂ : β) => ∀ (h₁ : p b₁) (h₂ : p b₂), R (f b₁ h₁) (f b₂ h₂)) l := sorry

theorem pairwise.pmap {α : Type u} {β : Type v} {R : α → α → Prop} {l : List α} (hl : pairwise R l) {p : α → Prop} {f : (a : α) → p a → β} (h : ∀ (x : α), x ∈ l → p x) {S : β → β → Prop} (hS : ∀ {x : α} (hx : p x) {y : α} (hy : p y), R x y → S (f x hx) (f y hy)) : pairwise S (pmap f l h) :=
  iff.mpr (pairwise_pmap h)
    (pairwise.imp_of_mem (fun (a b : α) (ᾰ : a ∈ l) (ᾰ_1 : b ∈ l) (ᾰ_2 : R a b) (h₁ : p a) (h₂ : p b) => hS h₁ h₂ ᾰ_2) hl)

theorem pairwise_join {α : Type u} {R : α → α → Prop} {L : List (List α)} : pairwise R (join L) ↔
  (∀ (l : List α), l ∈ L → pairwise R l) ∧
    pairwise (fun (l₁ l₂ : List α) => ∀ (x : α), x ∈ l₁ → ∀ (y : α), y ∈ l₂ → R x y) L := sorry

@[simp] theorem pairwise_reverse {α : Type u} {R : α → α → Prop} {l : List α} : pairwise R (reverse l) ↔ pairwise (fun (x y : α) => R y x) l := sorry

theorem pairwise_iff_nth_le {α : Type u} {R : α → α → Prop} {l : List α} : pairwise R l ↔ ∀ (i j : ℕ) (h₁ : j < length l) (h₂ : i < j), R (nth_le l i (lt_trans h₂ h₁)) (nth_le l j h₁) := sorry

theorem pairwise_sublists' {α : Type u} {R : α → α → Prop} {l : List α} : pairwise R l → pairwise (lex (function.swap R)) (sublists' l) := sorry

theorem pairwise_sublists {α : Type u} {R : α → α → Prop} {l : List α} (H : pairwise R l) : pairwise (fun (l₁ l₂ : List α) => lex R (reverse l₁) (reverse l₂)) (sublists l) := sorry

/- pairwise reduct -/

@[simp] theorem pw_filter_nil {α : Type u} {R : α → α → Prop} [DecidableRel R] : pw_filter R [] = [] :=
  rfl

@[simp] theorem pw_filter_cons_of_pos {α : Type u} {R : α → α → Prop} [DecidableRel R] {a : α} {l : List α} (h : ∀ (b : α), b ∈ pw_filter R l → R a b) : pw_filter R (a :: l) = a :: pw_filter R l :=
  if_pos h

@[simp] theorem pw_filter_cons_of_neg {α : Type u} {R : α → α → Prop} [DecidableRel R] {a : α} {l : List α} (h : ¬∀ (b : α), b ∈ pw_filter R l → R a b) : pw_filter R (a :: l) = pw_filter R l :=
  if_neg h

theorem pw_filter_map {α : Type u} {β : Type v} {R : α → α → Prop} [DecidableRel R] (f : β → α) (l : List β) : pw_filter R (map f l) = map f (pw_filter (fun (x y : β) => R (f x) (f y)) l) := sorry

theorem pw_filter_sublist {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) : pw_filter R l <+ l := sorry

theorem pw_filter_subset {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) : pw_filter R l ⊆ l :=
  sublist.subset (pw_filter_sublist l)

theorem pairwise_pw_filter {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) : pairwise R (pw_filter R l) := sorry

theorem pw_filter_eq_self {α : Type u} {R : α → α → Prop} [DecidableRel R] {l : List α} : pw_filter R l = l ↔ pairwise R l := sorry

@[simp] theorem pw_filter_idempotent {α : Type u} {R : α → α → Prop} [DecidableRel R] {l : List α} : pw_filter R (pw_filter R l) = pw_filter R l :=
  iff.mpr pw_filter_eq_self (pairwise_pw_filter l)

theorem forall_mem_pw_filter {α : Type u} {R : α → α → Prop} [DecidableRel R] (neg_trans : ∀ {x y z : α}, R x z → R x y ∨ R y z) (a : α) (l : List α) : (∀ (b : α), b ∈ pw_filter R l → R a b) ↔ ∀ (b : α), b ∈ l → R a b := sorry


/-
Copyright (c) 2020 Johan Commelin, Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Damiano Testa, Yaël Dillies

! This file was ported from Lean 3 source module order.synonym
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Equiv.Defs
import Mathbin.Logic.Nontrivial
import Mathbin.Order.Basic

/-!
# Type synonyms

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

This file provides two type synonyms for order theory:
* `order_dual α`: Type synonym of `α` to equip it with the dual order (`a ≤ b` becomes `b ≤ a`).
* `lex α`: Type synonym of `α` to equip it with its lexicographic order. The precise meaning depends
  on the type we take the lex of. Examples include `prod`, `sigma`, `list`, `finset`.

## Notation

`αᵒᵈ` is notation for `order_dual α`.

The general rule for notation of `lex` types is to append `ₗ` to the usual notation.

## Implementation notes

One should not abuse definitional equality between `α` and `αᵒᵈ`/`lex α`. Instead, explicit
coercions should be inserted:
* `order_dual`: `order_dual.to_dual : α → αᵒᵈ` and `order_dual.of_dual : αᵒᵈ → α`
* `lex`: `to_lex : α → lex α` and `of_lex : lex α → α`.

In fact, those are bundled as `equiv`s to put goals in the right syntactic form for rewriting with
the `equiv` API (`⇑to_lex a` where `⇑` is `coe_fn : (α ≃ lex α) → α → lex α`, instead of a bare
`to_lex a`).

## See also

This file is similar to `algebra.group.type_tags`.
-/

variable {α β γ : Type _}

/-! ### Order dual -/

namespace OrderDual

instance [h : Nontrivial α] : Nontrivial αᵒᵈ :=
  h

#print OrderDual.toDual /-
/-- `to_dual` is the identity function to the `order_dual` of a linear order.  -/
def toDual : α ≃ αᵒᵈ :=
  Equiv.refl _
#align order_dual.to_dual OrderDual.toDual
-/

#print OrderDual.ofDual /-
/-- `of_dual` is the identity function from the `order_dual` of a linear order.  -/
def ofDual : αᵒᵈ ≃ α :=
  Equiv.refl _
#align order_dual.of_dual OrderDual.ofDual
-/

#print OrderDual.toDual_symm_eq /-
@[simp]
theorem toDual_symm_eq : (@toDual α).symm = ofDual :=
  rfl
#align order_dual.to_dual_symm_eq OrderDual.toDual_symm_eq
-/

#print OrderDual.ofDual_symm_eq /-
@[simp]
theorem ofDual_symm_eq : (@ofDual α).symm = toDual :=
  rfl
#align order_dual.of_dual_symm_eq OrderDual.ofDual_symm_eq
-/

#print OrderDual.toDual_ofDual /-
@[simp]
theorem toDual_ofDual (a : αᵒᵈ) : toDual (ofDual a) = a :=
  rfl
#align order_dual.to_dual_of_dual OrderDual.toDual_ofDual
-/

#print OrderDual.ofDual_toDual /-
@[simp]
theorem ofDual_toDual (a : α) : ofDual (toDual a) = a :=
  rfl
#align order_dual.of_dual_to_dual OrderDual.ofDual_toDual
-/

#print OrderDual.toDual_inj /-
@[simp]
theorem toDual_inj {a b : α} : toDual a = toDual b ↔ a = b :=
  Iff.rfl
#align order_dual.to_dual_inj OrderDual.toDual_inj
-/

#print OrderDual.ofDual_inj /-
@[simp]
theorem ofDual_inj {a b : αᵒᵈ} : ofDual a = ofDual b ↔ a = b :=
  Iff.rfl
#align order_dual.of_dual_inj OrderDual.ofDual_inj
-/

#print OrderDual.toDual_le_toDual /-
@[simp]
theorem toDual_le_toDual [LE α] {a b : α} : toDual a ≤ toDual b ↔ b ≤ a :=
  Iff.rfl
#align order_dual.to_dual_le_to_dual OrderDual.toDual_le_toDual
-/

#print OrderDual.toDual_lt_toDual /-
@[simp]
theorem toDual_lt_toDual [LT α] {a b : α} : toDual a < toDual b ↔ b < a :=
  Iff.rfl
#align order_dual.to_dual_lt_to_dual OrderDual.toDual_lt_toDual
-/

#print OrderDual.ofDual_le_ofDual /-
@[simp]
theorem ofDual_le_ofDual [LE α] {a b : αᵒᵈ} : ofDual a ≤ ofDual b ↔ b ≤ a :=
  Iff.rfl
#align order_dual.of_dual_le_of_dual OrderDual.ofDual_le_ofDual
-/

#print OrderDual.ofDual_lt_ofDual /-
@[simp]
theorem ofDual_lt_ofDual [LT α] {a b : αᵒᵈ} : ofDual a < ofDual b ↔ b < a :=
  Iff.rfl
#align order_dual.of_dual_lt_of_dual OrderDual.ofDual_lt_ofDual
-/

#print OrderDual.le_toDual /-
theorem le_toDual [LE α] {a : αᵒᵈ} {b : α} : a ≤ toDual b ↔ b ≤ ofDual a :=
  Iff.rfl
#align order_dual.le_to_dual OrderDual.le_toDual
-/

#print OrderDual.lt_toDual /-
theorem lt_toDual [LT α] {a : αᵒᵈ} {b : α} : a < toDual b ↔ b < ofDual a :=
  Iff.rfl
#align order_dual.lt_to_dual OrderDual.lt_toDual
-/

#print OrderDual.toDual_le /-
theorem toDual_le [LE α] {a : α} {b : αᵒᵈ} : toDual a ≤ b ↔ ofDual b ≤ a :=
  Iff.rfl
#align order_dual.to_dual_le OrderDual.toDual_le
-/

#print OrderDual.toDual_lt /-
theorem toDual_lt [LT α] {a : α} {b : αᵒᵈ} : toDual a < b ↔ ofDual b < a :=
  Iff.rfl
#align order_dual.to_dual_lt OrderDual.toDual_lt
-/

#print OrderDual.rec /-
/-- Recursor for `αᵒᵈ`. -/
@[elab_as_elim]
protected def rec {C : αᵒᵈ → Sort _} (h₂ : ∀ a : α, C (toDual a)) : ∀ a : αᵒᵈ, C a :=
  h₂
#align order_dual.rec OrderDual.rec
-/

#print OrderDual.forall /-
@[simp]
protected theorem forall {p : αᵒᵈ → Prop} : (∀ a, p a) ↔ ∀ a, p (toDual a) :=
  Iff.rfl
#align order_dual.forall OrderDual.forall
-/

#print OrderDual.exists /-
@[simp]
protected theorem exists {p : αᵒᵈ → Prop} : (∃ a, p a) ↔ ∃ a, p (toDual a) :=
  Iff.rfl
#align order_dual.exists OrderDual.exists
-/

alias to_dual_le_to_dual ↔ _ _root_.has_le.le.dual
#align has_le.le.dual LE.le.dual

alias to_dual_lt_to_dual ↔ _ _root_.has_lt.lt.dual
#align has_lt.lt.dual LT.lt.dual

alias of_dual_le_of_dual ↔ _ _root_.has_le.le.of_dual
#align has_le.le.of_dual LE.le.ofDual

alias of_dual_lt_of_dual ↔ _ _root_.has_lt.lt.of_dual
#align has_lt.lt.of_dual LT.lt.ofDual

end OrderDual

/-! ### Lexicographic order -/

#print Lex /-
/-- A type synonym to equip a type with its lexicographic order. -/
def Lex (α : Type _) :=
  α
#align lex Lex
-/

#print toLex /-
/-- `to_lex` is the identity function to the `lex` of a type.  -/
@[match_pattern]
def toLex : α ≃ Lex α :=
  Equiv.refl _
#align to_lex toLex
-/

#print ofLex /-
/-- `of_lex` is the identity function from the `lex` of a type.  -/
@[match_pattern]
def ofLex : Lex α ≃ α :=
  Equiv.refl _
#align of_lex ofLex
-/

#print toLex_symm_eq /-
@[simp]
theorem toLex_symm_eq : (@toLex α).symm = ofLex :=
  rfl
#align to_lex_symm_eq toLex_symm_eq
-/

#print ofLex_symm_eq /-
@[simp]
theorem ofLex_symm_eq : (@ofLex α).symm = toLex :=
  rfl
#align of_lex_symm_eq ofLex_symm_eq
-/

#print toLex_ofLex /-
@[simp]
theorem toLex_ofLex (a : Lex α) : toLex (ofLex a) = a :=
  rfl
#align to_lex_of_lex toLex_ofLex
-/

#print ofLex_toLex /-
@[simp]
theorem ofLex_toLex (a : α) : ofLex (toLex a) = a :=
  rfl
#align of_lex_to_lex ofLex_toLex
-/

#print toLex_inj /-
@[simp]
theorem toLex_inj {a b : α} : toLex a = toLex b ↔ a = b :=
  Iff.rfl
#align to_lex_inj toLex_inj
-/

#print ofLex_inj /-
@[simp]
theorem ofLex_inj {a b : Lex α} : ofLex a = ofLex b ↔ a = b :=
  Iff.rfl
#align of_lex_inj ofLex_inj
-/

#print Lex.rec /-
/-- A recursor for `lex`. Use as `induction x using lex.rec`. -/
protected def Lex.rec {β : Lex α → Sort _} (h : ∀ a, β (toLex a)) : ∀ a, β a := fun a => h (ofLex a)
#align lex.rec Lex.rec
-/


import lambda_calculus.notation
import tactic.linarith

namespace lambda_calculus
/- Inductive definition of untyped lambda calculus using De Bruijn indexing
 - (https://en.wikipedia.org/wiki/De_Bruijn_index)
 -/
@[derive decidable_eq]
inductive utlc : Type
| index (n: ℕ): utlc
| abstraction (f: utlc) : utlc
| application (f g: utlc) : utlc

namespace utlc

@[pattern] instance : has_down utlc := ⟨ index ⟩
@[pattern] instance : has_lambda utlc := ⟨ abstraction ⟩
@[pattern] instance : has_dot utlc := ⟨ application ⟩
attribute [pattern] has_down.down has_lambda.lambda has_dot.dot

instance : inhabited utlc := ⟨ ↓0 ⟩

section -- Theorems so that we can use the notation instead of the raw names

@[simp] theorem ne_down_lambda (n : ℕ) (f: utlc) : ↓n ≠ Λ f :=
by apply utlc.no_confusion
@[simp] theorem ne_down_dot (n : ℕ) (f g : utlc) : ↓n ≠ f·g:=
by apply utlc.no_confusion
@[simp] theorem ne_lambda_down (f : utlc) (n : ℕ) : Λ f ≠ ↓n :=
by apply utlc.no_confusion
@[simp] theorem ne_lambda_dot (f g h: utlc): Λ f ≠ g·h :=
by apply utlc.no_confusion
@[simp] theorem ne_dot_down (f g: utlc) (n : ℕ) : f·g ≠ ↓n :=
by apply utlc.no_confusion
@[simp] theorem ne_dot_lambda (f g h: utlc) : f·g ≠ Λ h :=
by apply utlc.no_confusion

@[simp] theorem down_eq_down_iff {n m : ℕ}: (↓n : utlc) = ↓m ↔ n = m :=
begin
  split,
  intro p,
  exact utlc.no_confusion p (assume neq, neq),
  intro p,
  rw [p]
end

@[simp] theorem lambda_eq_lambda_iff {f g : utlc}: Λ f = Λ g ↔ f = g :=
begin
  split,
  intro p,
  exact utlc.no_confusion p (assume neq, neq),
  intro p,
  rw [p]
end

@[simp] theorem dot_eq_dot_iff {f f' g g': utlc}: f·g = f'·g' ↔ f = f' ∧ g = g' :=
begin
  split,
  intros p,
  exact utlc.no_confusion p (assume feq geq, and.intro feq geq),
  intro p,
  simp [p]
end

@[simp] theorem below_down (n: ℕ): (↓n:utlc).sizeof = 1 + n :=
begin
  unfold has_down.down,
  unfold_wf,
end

@[simp] theorem below_lambda (f: utlc): (Λ f).sizeof = 1 + f.sizeof :=
begin
  unfold has_lambda.lambda,
  unfold_wf,
end

@[simp] theorem below_dot (f g: utlc): (f·g).sizeof = 1 + f.sizeof + g.sizeof :=
begin
  unfold has_dot.dot,
  unfold_wf,
end

def repr: utlc → bool → string
| (↓n) := λ parens, "↓" ++ nat.repr n
| (Λ f) := λ parens, (ite parens "(" "") ++ "Λ " ++ (repr f false) ++ (ite parens ")" "")
| (f·g) := λ parens, (ite parens "(" "") ++ (repr f false) ++ "·" ++ (repr g true) ++ (ite parens ")" "")

instance : has_repr utlc := ⟨ λ f, repr f false ⟩

@[simp] theorem down_notation (n: ℕ): index n = ↓ n := rfl
@[simp] theorem lambda_notation (f: utlc): f.abstraction = Λ f  := rfl
@[simp] theorem dot_notation (f g: utlc): f.application g = f · g := rfl
end

@[simp] def is_down: utlc → Prop
| (↓_) := true
| (Λ _) := false
| (_·_) := false

@[simp] def is_lambda: utlc → Prop
| (↓_) := false
| (Λ _) := true
| (_·_) := false

@[simp] def is_dot: utlc → Prop
| (↓_) := false
| (Λ _) := false
| (_·_) := true

@[simp] def size : utlc → ℕ
| (↓ _) := 1
| (Λ f) := f.size + 1
| (f · g) := f.size + g.size + 1

@[simp] def uses : utlc → ℕ → ℕ
| (↓ m) := λ n, if m = n then 1 else 0
| (Λ f) := λ n, uses f (n + 1)
| (f · g) := λ n, uses f n + uses g n

theorem lambda_uses (f: utlc) (n: ℕ): (Λ f).uses n = f.uses (n+1) := rfl

theorem dot_uses (f g: utlc) (n: ℕ): (f·g).uses n = f.uses n + g.uses n := rfl

section

def closed_below : utlc → ℕ → bool
| (↓m) := λ n, m < n
| (Λ f) := λ n, f.closed_below (n+1)
| (f·g) := λ n, f.closed_below n ∧ g.closed_below n

local attribute [simp] closed_below

@[simp] theorem down_closed_below (n m: ℕ): closed_below (↓n) m ↔ n < m := by simp

@[simp] theorem lambda_closed_below (f: utlc) (n: ℕ): closed_below (Λ f) n = closed_below f (n + 1) := rfl

@[simp] theorem dot_closed_below (f g: utlc) (n: ℕ): closed_below (f·g) n = (closed_below f n ∧ closed_below g n) := rfl

def closed (f : utlc) := closed_below f 0

local attribute [simp] closed

@[simp] theorem down_not_closed (n: ℕ): ¬ closed (↓n) := by simp

@[simp] theorem lambda_closed (f: utlc): closed (Λ f) = closed_below f 1 := rfl

@[simp] theorem dot_closed (f g: utlc): closed (f·g) = (closed f ∧ closed g) := rfl
end

section
def shift : utlc → ℕ → utlc
| (↓ m) := λ n, if m < n then ↓ m else ↓(m + 1)
| (Λ f) := λ n, Λ (shift f (n + 1))
| (f · g) := λ n, (shift f n) · (shift g n)

local attribute [simp] shift

instance : has_shift utlc := ⟨ shift ⟩

theorem down_shift (m n: ℕ): (↓m)↑¹n = (↓(if m < n then m else m + 1):utlc) :=
by split_ifs; simp [h, has_shift.shift]

@[simp] theorem lambda_shift (f: utlc) (n: ℕ):  (Λ f) ↑¹ n = Λ(f ↑¹ (n+1)) :=
by simp [has_shift.shift]

@[simp] theorem dot_shift (f f': utlc) (n: ℕ):  (f·f') ↑¹ n = (f ↑¹ n)·(f' ↑¹ n) :=
by simp [has_shift.shift]

theorem shift_eq_lambda_iff (f: utlc) (n: ℕ) (g: utlc): f ↑¹ n = Λ g ↔ ∃ x, f = Λ x ∧ x ↑¹ (n + 1) = g :=
by cases f; simp[down_shift]

theorem shift_eq_dot_iff (f: utlc) (n: ℕ) (g g': utlc): f ↑¹ n = g·g' ↔ ∃ x x', f = x·x' ∧ x ↑¹ n = g ∧ x' ↑¹ n = g' :=
by cases f; simp[and.assoc, down_shift]

@[simp] theorem shift_notation (f: utlc) (n: ℕ): f.shift n = f ↑¹ n := rfl
end

section
def substitution : utlc → ℕ → utlc → utlc
| (↓m) := λ n x, if m < n then ↓ m else if m = n then x else ↓ (m-1)
| (Λ f) := λ n x, Λ (substitution f (n + 1) (x ↑¹ 0))
| (f · g) := λ n x, (substitution f n x) · (substitution g n x)

instance : has_substitution utlc := ⟨ substitution ⟩
local attribute [simp] substitution

local notation a `[` b `:=` c  `]` : 70 := has_substitution.substitution a b c

@[simp] theorem down_substitution (m n: ℕ) (g: utlc): (↓m)[n:=g] = if m < n then ↓m else if m = n then g else ↓(m-1) :=
by simp[has_substitution.substitution]

@[simp] theorem lambda_substitution (f: utlc) (n: ℕ) (g: utlc): (Λ f)[n:=g] = Λ f[n+1:=g ↑¹ 0] :=
by simp[has_substitution.substitution]

@[simp] theorem dot_substitution (f f': utlc) (n: ℕ) (g: utlc): (f·f')[n:=g] = f[n:=g]·f'[n:=g] :=
by simp[has_substitution.substitution]

@[simp] theorem substitution_notation (f: utlc) (n: ℕ) (g: utlc): f.substitution n g = f[n:=g] := rfl
end

theorem notation_induction_on (p: utlc → Prop): Π (f: utlc)
  (down: Π n, p ↓n)
  (lambda: Π f (ih: p f), p (Λ f))
  (dot: Π f g (ih_f: p f) (ih_g: p g), p (f·g)),
  (p f)
| (↓n) := λ hn _ _, hn n
| (Λ f) := λ hn hl hd, hl f (notation_induction_on f hn hl hd)
| (f·g) := λ hn hl hd, hd f g (notation_induction_on f hn hl hd) (notation_induction_on g hn hl hd)

def notation_cases_on (p: utlc → Sort*): Π (f: utlc)
  (down: Π n, p ↓n)
  (lambda: Π f, p (Λ f))
  (dot: Π f g, p (f·g)),
  (p f)
| (↓n) := λ hn _ _, hn n
| (Λ f) := λ _ hl _, hl f
| (f·g) := λ _ _ hd, hd f g

def simp_rec {α: Type} (down: ℕ → α) (lambda: utlc → α → α) (dot: utlc → utlc → α → α → α): utlc → α
| (↓n) := down n
| (Λ f) := lambda f (simp_rec f)
| (f·g) := dot f g (simp_rec f) (simp_rec g)

@[simp] theorem simp_rec_down {α: Type} (down: ℕ → α) (lambda: utlc → α → α) (dot: utlc → utlc → α → α → α) (n: ℕ):
  simp_rec down lambda dot (↓n) = down n := by simp[simp_rec]

@[simp] theorem simp_rec_lambda {α: Type} (down: ℕ → α) (lambda: utlc → α → α) (dot: utlc → utlc → α → α → α) (f: utlc):
  simp_rec down lambda dot (Λ f) = lambda f (simp_rec down lambda dot f) := by simp[simp_rec]

@[simp] theorem simp_rec_dot {α: Type} (down: ℕ → α) (lambda: utlc → α → α) (dot: utlc → utlc → α → α → α) (f g: utlc):
  simp_rec down lambda dot (f·g) =  dot f g (simp_rec down lambda dot f) (simp_rec down lambda dot g) := by simp[simp_rec]

instance is_lambda_decidable (f: utlc): decidable (is_lambda f) :=
begin
  induction f using lambda_calculus.utlc.notation_cases_on;
  unfold is_lambda;
  apply_instance
end

end utlc
end lambda_calculus


--- Q[-1,1] is the set of all rationals p such that -1  p  1.
import data.rat
import set_theory.zfc.basic
import data.vector
import data.rat
import tactic
import tactic.rewrite_all.basic
open vector
open_locale big_operators
 namespace emulators

def in_range (q:ℚ) : Prop := (( q > -1) ∧  (q < 1))
local notation `Q[-11]` := {x : ℚ // in_range x}
--We will use a,b,c,d,e,p,q,r,s,t,u,v,w for rational numbers in Q[-1,1] unless indicated otherwise.
variables (a b c d e p q r s t u v w : Q[-11])
-- We use n,m,i,j,k for positive integers unless otherwise indicated.
variables (n m i j k : ℕ)
-- We use A,B,C,D,E,S,T,U,V for subsets of Q[-1,1]2 unless indicated otherwise. We use  for subset.
-- variables (A B C D E S T U V :  set ( Q[-11] ×  Q[-11]) )

--A
-- k is the set of all k-tuples of elements of A. They are written (x1,...,xk), where x1,...,xk  A. Usually, we focus on small k, say k = 1,2,3,4.
-- def type_tuple (t:Type ) (n : ℕ )  : Type := vector t n
-- def tuple (n : ℕ ) : Type := vector  ℚ n

variables (A B C D E S T U V :   set (vector ℚ k )) [fintype ↥S]
variables (v1 v2 v3 :   vector ℚ k)

-- start of the first file. put other stuff in a new file

-- definition of order equivalence
def order_equivalent (k : ℕ) (x y : vector ℚ k) : Prop :=
  ∀ (i j : fin k), (x.nth i) < (x.nth j) ↔ (y.nth i) < (y.nth j)

-- order equivalence is an equivalence relation
theorem order_equiv_is_equiv (k : ℕ) : equivalence (order_equivalent k) :=
begin
  split,
  intros x i j,
  refl,
  split,
  intros x y h i j,
  rw h i j,
  intros x y z h1 h2 i j,
  rw h1 i j,
  rw h2 i j,
end

-- equivalence classes under order equivalence
def oe (k : ℕ) : setoid (vector ℚ k) := {
  r := order_equivalent k,
  iseqv := order_equiv_is_equiv k
}
attribute [instance] oe

-- QoL
lemma quotient_eq {k : ℕ} (a b : vector ℚ k) : ⟦a⟧ = ⟦b⟧ ↔ order_equivalent k a b :=
begin
  rw quotient.eq,
  refl,
end

-- E is an emulator of S iff the concatenation of any two elements of E
-- is order equivalent to a concatenation of some two elements of S
def is_emulator {k : ℕ} (E S : set (vector ℚ k)): Prop :=
∀ (x y ∈ E), ∃ (z w ∈ S), order_equivalent (k+k) (vector.append x y) (vector.append z w)

-- The EC is the set of equivalence classes of concatenations
def EC {k : ℕ} (S : set (vector ℚ k)) : set (quotient (oe (k+k))) :=
{c : quotient (oe (k+k)) | ∃ (x y ∈ S), c = ⟦vector.append x y⟧}

-- E is an emulator of S iff the EC of E is a subset of the EC of S
theorem emulator_iff_EC_subset {k : ℕ} (E S : set (vector ℚ k)) :
  is_emulator E S ↔ EC E ⊆ EC S :=
begin
  split,
  intros h x,
  apply quotient.induction_on x,
  intros a hE,
  rcases hE with ⟨x,y,hxE,hyE,he⟩,
  rcases h x y hxE hyE with ⟨z,w,hzS,hwS,h⟩,
  rw ← quotient_eq at h,
  rw he,
  exact ⟨z,w,⟨hzS,hwS,by rw h⟩⟩,

  intros h x hxE y hyE,
  have hEC : ⟦vector.append x y⟧ ∈ EC E,
    from ⟨x, hxE, y, hyE,by refl⟩,
  rcases h hEC with ⟨z,w,hzS,hwS,h⟩,
  rw quotient_eq at h,
  exact ⟨z,w,hzS,hwS,h⟩,
end

-- The EC of a subset is a subset of the EC
theorem subset_EC_subset {k : ℕ} (E S : set (vector ℚ k)) :
  E ⊆ S → EC E ⊆ EC S :=
begin
  intros hES x,
  apply quotient.induction_on x,
  intros a haE,
  rcases haE with ⟨x,hxE,y,hyE,h⟩,
  -- exact x,
  exact ⟨x,hES hxE,y,hES hyE,by rw h⟩,
end

-- Every subset is an emulator
theorem subset_emulator {k : ℕ} (E S : set (vector ℚ k)) :
  E ⊆ S → is_emulator E S :=
begin
  rw emulator_iff_EC_subset,
  exact subset_EC_subset E S,
end

-- Anything is an emulator of itself
theorem emulator_refl {k : ℕ} (S : set (vector ℚ k)) :
  is_emulator S S :=
begin
  apply subset_emulator,
  exact rfl.subset,
end

-- Emulator-ness is transitive
theorem emulator_trans {k : ℕ} (A B C : set (vector ℚ k)) :
  is_emulator A B → is_emulator B C → is_emulator A C :=
begin
  intros h1 h2,
  rw emulator_iff_EC_subset at h1 h2 ⊢,
  exact set.subset.trans h1 h2,
end

-- Two sets are related iff they are emulators of each other
def related {k : ℕ} (S T : set (vector ℚ k)) : Prop :=
  is_emulator S T ∧ is_emulator T S

-- Two sets are related iff the ECs are equal
theorem related_iff_EC_eq {k : ℕ} (S T : set (vector ℚ k)) :
  related S T ↔ EC S = EC T :=
begin
  split,
  rintro ⟨h1,h2⟩,
  rw emulator_iff_EC_subset at h1 h2,
  exact set.subset.antisymm h1 h2,

  intro h,
  split,
  rw emulator_iff_EC_subset,
  exact eq.subset h,
  rw emulator_iff_EC_subset,
  exact (eq.symm h).subset,
end

-- Two sets are related iff they have the same emulators
theorem related_iff_same_emulator {k : ℕ} (S T : set (vector ℚ k)) :
  related S T ↔ ∀ (E : set (vector ℚ k)), (is_emulator E S ↔ is_emulator E T) :=
begin
  split,
  rintros ⟨h1,h2⟩ E,
  rw emulator_iff_EC_subset at h1 h2 ⊢,
  rw emulator_iff_EC_subset,
  split,
    intro h,
    exact set.subset.trans h h1,
    intro h,
    exact set.subset.trans h h2,

  intro h,
  have h1 := (h S).1 (emulator_refl S),
  have h2 := (h T).2 (emulator_refl T),
  exact ⟨h1,h2⟩,
end

-- Two sets have the same emulators iff the ECs are equal
theorem same_emulator_iff_EC_eq {k : ℕ} (S T : set (vector ℚ k)) :
  (∀ (E : set (vector ℚ k)), (is_emulator E S ↔ is_emulator E T)) ↔ EC S = EC T :=
begin
  rw ← related_iff_same_emulator,
  rw related_iff_EC_eq,
end

-- Related-ness is an equivalence relation
theorem related_refl {k : ℕ} (S : set (vector ℚ k)) :
  related S S :=
begin
  exact ⟨emulator_refl S,emulator_refl S⟩,
end

theorem related_symm {k : ℕ} (S T : set (vector ℚ k)) :
  related S T → related T S :=
begin
  rintro ⟨h1,h2⟩,
  exact ⟨h2,h1⟩,
end

theorem related_trans {k : ℕ} (A B C : set (vector ℚ k)) :
  related A B → related B C → related A C :=
begin
  rintros ⟨h1,h2⟩ ⟨h3,h4⟩,
  exact ⟨emulator_trans A B C h1 h3,
        emulator_trans C B A h4 h2⟩,
end

-- new file here

/-
--ORDER INVARIANT. S  Q[-1,1]2 is order invariant if and only if for all order equivalent x,y  Q[-1,1]2, x  S  y  S.

def is_order_invaraint (S:set (vector ℚ k )) : Prop :=
   ∀ (x y : vector ℚ k ), (order_equivalent k x y) → (x ∈ S ↔ y ∈ S )

def is_linear (f : vector ℚ k  → Prop): Prop := ∃(c :ℚ), ∃(n m:fin k),
(f =λ x, x.nth n > c)
∨
(f =λ x, x.nth n < c)
∨
(f =λ x, x.nth n < x.nth m)

def is_linear_comb (f : vector ℚ k  → Prop): Prop := ∃ (g h :  vector ℚ k  → Prop),
f =λx, g x ∧ h x ∧ is_linear k g ∧ is_linear k h
def is_order_theoretic (S:set (vector ℚ k )):Prop
:= ∃ (f : (vector ℚ k  → Prop)),  is_linear_comb k f
-/
def EM {k} (S: set (vector ℚ k)): set (set (vector ℚ k)) := {E : set (vector ℚ k)| is_emulator E S }
lemma EC_implies_Same_emulators: (EC E = EC S ↔ (EM E = EM S)) := begin
sorry,
end
end emulators


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.algebra_map
import Mathlib.data.polynomial.div
import Mathlib.topology.metric_space.cau_seq_filter
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Polynomials and limits

In this file we prove the following lemmas.

* `polynomial.continuous_eval₂: `polynomial.eval₂` defines a continuous function.
* `polynomial.continuous_aeval: `polynomial.aeval` defines a continuous function;
  we also prove convenience lemmas `polynomial.continuous_at_aeval`,
  `polynomial.continuous_within_at_aeval`, `polynomial.continuous_on_aeval`.
* `polynomial.continuous`:  `polynomial.eval` defines a continuous functions;
  we also prove convenience lemmas `polynomial.continuous_at`, `polynomial.continuous_within_at`,
  `polynomial.continuous_on`.
* `polynomial.tendsto_norm_at_top`: `λ x, ∥polynomial.eval (z x) p∥` tends to infinity provided that
  `λ x, ∥z x∥` tends to infinity and `0 < degree p`;
* `polynomial.tendsto_abv_eval₂_at_top`, `polynomial.tendsto_abv_at_top`,
  `polynomial.tendsto_abv_aeval_at_top`: a few versions of the previous statement for
  `is_absolute_value abv` instead of norm.

## Tags

polynomial, continuity
-/

namespace polynomial

protected theorem continuous_eval₂ {R : Type u_1} {S : Type u_2} [semiring R] [topological_space R] [topological_semiring R] [semiring S] (p : polynomial S) (f : S →+* R) : continuous fun (x : R) => eval₂ f x p :=
  id
    (continuous_finset_sum (finsupp.support p)
      fun (c : ℕ) (hc : c ∈ finsupp.support p) => continuous.mul continuous_const (continuous_pow c))

protected theorem continuous {R : Type u_1} [semiring R] [topological_space R] [topological_semiring R] (p : polynomial R) : continuous fun (x : R) => eval x p :=
  polynomial.continuous_eval₂ p (ring_hom.id R)

protected theorem continuous_at {R : Type u_1} [semiring R] [topological_space R] [topological_semiring R] (p : polynomial R) {a : R} : continuous_at (fun (x : R) => eval x p) a :=
  continuous.continuous_at (polynomial.continuous p)

protected theorem continuous_within_at {R : Type u_1} [semiring R] [topological_space R] [topological_semiring R] (p : polynomial R) {s : set R} {a : R} : continuous_within_at (fun (x : R) => eval x p) s a :=
  continuous.continuous_within_at (polynomial.continuous p)

protected theorem continuous_on {R : Type u_1} [semiring R] [topological_space R] [topological_semiring R] (p : polynomial R) {s : set R} : continuous_on (fun (x : R) => eval x p) s :=
  continuous.continuous_on (polynomial.continuous p)

protected theorem continuous_aeval {R : Type u_1} {A : Type u_2} [comm_semiring R] [semiring A] [algebra R A] [topological_space A] [topological_semiring A] (p : polynomial R) : continuous fun (x : A) => coe_fn (aeval x) p :=
  polynomial.continuous_eval₂ p (algebra_map R A)

protected theorem continuous_at_aeval {R : Type u_1} {A : Type u_2} [comm_semiring R] [semiring A] [algebra R A] [topological_space A] [topological_semiring A] (p : polynomial R) {a : A} : continuous_at (fun (x : A) => coe_fn (aeval x) p) a :=
  continuous.continuous_at (polynomial.continuous_aeval p)

protected theorem continuous_within_at_aeval {R : Type u_1} {A : Type u_2} [comm_semiring R] [semiring A] [algebra R A] [topological_space A] [topological_semiring A] (p : polynomial R) {s : set A} {a : A} : continuous_within_at (fun (x : A) => coe_fn (aeval x) p) s a :=
  continuous.continuous_within_at (polynomial.continuous_aeval p)

protected theorem continuous_on_aeval {R : Type u_1} {A : Type u_2} [comm_semiring R] [semiring A] [algebra R A] [topological_space A] [topological_semiring A] (p : polynomial R) {s : set A} : continuous_on (fun (x : A) => coe_fn (aeval x) p) s :=
  continuous.continuous_on (polynomial.continuous_aeval p)

theorem tendsto_abv_eval₂_at_top {R : Type u_1} {S : Type u_2} {k : Type u_3} {α : Type u_4} [semiring R] [ring S] [linear_ordered_field k] (f : R →+* S) (abv : S → k) [is_absolute_value abv] (p : polynomial R) (hd : 0 < degree p) (hf : coe_fn f (leading_coeff p) ≠ 0) {l : filter α} {z : α → S} (hz : filter.tendsto (abv ∘ z) l filter.at_top) : filter.tendsto (fun (x : α) => abv (eval₂ f (z x) p)) l filter.at_top := sorry

theorem tendsto_abv_at_top {R : Type u_1} {k : Type u_2} {α : Type u_3} [ring R] [linear_ordered_field k] (abv : R → k) [is_absolute_value abv] (p : polynomial R) (h : 0 < degree p) {l : filter α} {z : α → R} (hz : filter.tendsto (abv ∘ z) l filter.at_top) : filter.tendsto (fun (x : α) => abv (eval (z x) p)) l filter.at_top :=
  tendsto_abv_eval₂_at_top (ring_hom.id R) abv p h (mt (iff.mp leading_coeff_eq_zero) (ne_zero_of_degree_gt h)) hz

theorem tendsto_abv_aeval_at_top {R : Type u_1} {A : Type u_2} {k : Type u_3} {α : Type u_4} [comm_semiring R] [ring A] [algebra R A] [linear_ordered_field k] (abv : A → k) [is_absolute_value abv] (p : polynomial R) (hd : 0 < degree p) (h₀ : coe_fn (algebra_map R A) (leading_coeff p) ≠ 0) {l : filter α} {z : α → A} (hz : filter.tendsto (abv ∘ z) l filter.at_top) : filter.tendsto (fun (x : α) => abv (coe_fn (aeval (z x)) p)) l filter.at_top :=
  tendsto_abv_eval₂_at_top (algebra_map R A) abv p hd h₀ hz

theorem tendsto_norm_at_top {α : Type u_1} {R : Type u_2} [normed_ring R] [is_absolute_value norm] (p : polynomial R) (h : 0 < degree p) {l : filter α} {z : α → R} (hz : filter.tendsto (fun (x : α) => norm (z x)) l filter.at_top) : filter.tendsto (fun (x : α) => norm (eval (z x) p)) l filter.at_top :=
  tendsto_abv_at_top norm p h hz

theorem exists_forall_norm_le {R : Type u_2} [normed_ring R] [is_absolute_value norm] [proper_space R] (p : polynomial R) : ∃ (x : R), ∀ (y : R), norm (eval x p) ≤ norm (eval y p) := sorry


example : ∀l: list nat, l ++ [0] ≠ [] := begin
    intro l,
    cases l;
    contradiction
end


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.nat.preterm
import Mathlib.PostPort

universes l

namespace Mathlib

/-
Linear natural number arithmetic preformulas in pre-normalized preform.
-/

namespace omega

namespace nat

/-- Intermediate shadow syntax for LNA formulas that includes unreified exprs -/
/-- Intermediate shadow syntax for LNA formulas that includes non-canonical terms -/
inductive preform
where
| eq : preterm → preterm → preform
| le : preterm → preterm → preform
| not : preform → preform
| or : preform → preform → preform
| and : preform → preform → preform

namespace preform

/-- Evaluate a preform into prop using the valuation `v`. -/
@[simp] def holds (v : ℕ → ℕ) : preform → Prop :=
  sorry

end preform

/-- `univ_close p n` := `p` closed by prepending `n` universal quantifiers -/
@[simp] def univ_close (p : preform) : (ℕ → ℕ) → ℕ → Prop :=
  sorry

namespace preform

/-- Argument is free of negations -/
def neg_free : preform → Prop :=
  sorry

/-- Return expr of proof that argument is free of subtractions -/
def sub_free : preform → Prop :=
  sorry

/-- Fresh de Brujin index not used by any variable in argument -/
def fresh_index : preform → ℕ :=
  sorry

theorem holds_constant {v : ℕ → ℕ} {w : ℕ → ℕ} (p : preform) : (∀ (x : ℕ), x < fresh_index p → v x = w x) → (holds v p ↔ holds w p) := sorry

/-- All valuations satisfy argument -/
def valid (p : preform) :=
  ∀ (v : ℕ → ℕ), holds v p

/-- There exists some valuation that satisfies argument -/
def sat (p : preform) :=
  ∃ (v : ℕ → ℕ), holds v p

/-- `implies p q` := under any valuation, `q` holds if `p` holds -/
def implies (p : preform) (q : preform) :=
  ∀ (v : ℕ → ℕ), holds v p → holds v q

/-- `equiv p q` := under any valuation, `p` holds iff `q` holds -/
def equiv (p : preform) (q : preform) :=
  ∀ (v : ℕ → ℕ), holds v p ↔ holds v q

theorem sat_of_implies_of_sat {p : preform} {q : preform} : implies p q → sat p → sat q :=
  fun (h1 : implies p q) (h2 : sat p) => exists_imp_exists h1 h2

theorem sat_or {p : preform} {q : preform} : sat (or p q) ↔ sat p ∨ sat q := sorry

/-- There does not exist any valuation that satisfies argument -/
def unsat (p : preform) :=
  ¬sat p

def repr : preform → string :=
  sorry

protected instance has_repr : has_repr preform :=
  has_repr.mk repr

end preform

theorem univ_close_of_valid {p : preform} {m : ℕ} {v : ℕ → ℕ} : preform.valid p → univ_close p v m := sorry

theorem valid_of_unsat_not {p : preform} : preform.unsat (preform.not p) → preform.valid p := sorry


import set_theory.surreal

open pgame

universe u

local infix ` ≈ ` := pgame.equiv

#check numeric
-- def numeric : pgame → Prop
-- | ⟨l, r, L, R⟩ :=
--   (∀ i j, L i < R j) ∧ (∀ i, numeric (L i)) ∧ (∀ i, numeric (R i))

lemma numeric_aux (x : pgame) :
  (∀ i, x.move_left i < x ∧ numeric (x.move_left i)) ∧
  (∀ i, x < x.move_right i ∧ numeric (x.move_right i)) → x.numeric := sorry

#check @le_def_lt
-- ⊢ ∀ {x y : pgame},
--     x ≤ y ↔
--     ∀ (i : x.left_moves), x.move_left i < y ∧
--     ∀ (j : y.right_moves), x < y.move_right j

theorem zero_le' {x : pgame} : 0 ≤ x ↔
  (∀ j : x.right_moves, 0 < x.move_right j) :=
begin
  rw le_def_lt,
  split,
  rintros ⟨hi,hj⟩ j,
  exact hj j,
  rintros hj,
  split,
  rintros ⟨⟩,
  exact hj,
end

-- theorem le_def_lt {x y : pgame} : x ≤ y ↔
--   (∀ i : x.left_moves, x.move_left i < y) ∧
--   (∀ j : y.right_moves, x < y.move_right j) :=
-- by { cases x, cases y, refl }

theorem le_zero' {x : pgame} : x ≤ 0 ↔
  (∀ i : x.left_moves, x.move_left i < 0) :=
begin
  rw le_def_lt,
  split,
  rintros ⟨hi,hj⟩ i,
  exact hi i,
  rintros hj,
  split,
  exact hj,
  rintros ⟨⟩,
end

theorem zero_lt' {x : pgame} : 0 < x ↔
  (∃ i : x.left_moves, 0 ≤ x.move_left i) :=
by {rw lt_def_le, dsimp, simp[forall_pempty] }
-- (xL i < (mk xl xr xL xR)) ∧ ((mk xl xr xL xR) < xR j) ∧ numeric (xL i) ∧ numeric (xR j) → (mk xl xr xL xR).numeric := sorry

example ( a b : ℤ ) : (0 < a) → (0 < b) → (0 < a * b) :=
begin
  exact mul_pos,
end

theorem foo (x : pgame) (ox : numeric x) : ¬ (x ≈ 0) → (0 < x) ∨ (x < 0) := sorry

theorem numeric_mul_pos : Π {x y z w : pgame} (ox : numeric x) (oy : numeric y) (oz : numeric z) (ow : numeric w),
(0 < x → 0 < y → 0 < x * y) ∧
(w ≈ 0 → w * z ≈ 0)
| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) (mk wl wr wL wR) ox oy oz ow :=
begin
  set x := mk xl xr xL xR with hx,
  set y := mk yl yr yL yR with hy,
  set w := mk wl wr wL wR with hw,
  split,
  intros pos_x pos_y,
  rw zero_lt',
  cases zero_lt'.1 pos_x with i hi,
  cases zero_lt'.1 pos_y with j hj,
  dsimp at *,
  use sum.inl (i,j),
  dsimp,
  rw ←hx at *,
  rw ←hy at *,
  by_cases h : xL i ≈ 0,
  sorry,
  cases foo (xL i) (ox.2.1 i) h,
  sorry,
  sorry,

  intro hw,
  split,
  rw le_zero',
  rintros (⟨i,j⟩|⟨i,j⟩),
  dsimp,
  rw ←hx at *,
sorry,
dsimp,
sorry,
rw zero_le',
  rintros (⟨i,j⟩|⟨i,j⟩),
  dsimp,
  sorry,
  dsimp,
  sorry,

end

theorem numeric_mul_pos' : Π {x y : pgame} (ox : numeric x) (oy : numeric y) (oxy : numeric (x * y)) (neg_x : x < 0) (neg_y : y < 0), 0 < x * y := sorry

theorem numeric_mul_neg : Π {x y : pgame} (ox : numeric x) (oy : numeric y) (oxy : numeric (x * y)) (pos_x : 0 < x) (neg_y : y < 0), x * y < 0 := sorry

theorem numeric_sub : Π {x y : pgame} (ox : numeric x) (oy : numeric y), numeric (x - y)
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ox oy := sorry

theorem numeric_mul : Π {x y z : pgame} (ox : x.numeric) (oy : y.numeric),
((x * y).numeric ) ∧
((x ≈ y) → ⟦x * z⟧ = ⟦y * z⟧) ∧
(Π {a b A B : pgame} (oA : numeric A) (oB : numeric B) (oa : numeric a) (ob : numeric b), a < A → b < B → a * B + b * A < a * b + A * B )
| (mk xl xr xL xR) (mk yl yr yL yR)
:=
begin
    set x := mk xl xr xL xR with hx,
    set y := mk yl yr yL yR with hy,
  split,
  {
    intros ox oy,
      fsplit,
      rintro (⟨i, j⟩ | ⟨i, j⟩) (⟨k, l⟩ | ⟨j_fst, j_snd⟩),
      {
        change xL i * y + x * yL j - xL i * yL j < xL k * y + x * yR l - xL k * yR l,
      }, sorry, sorry, sorry, sorry,
  },

end


import order.boolean_algebra
import order.zorn
import tactic.ext
import .extensionality
open_locale classical

universe u

namespace order.boolean_algebra

variables {α : Type*} [boolean_algebra α] {x y : α}

@[ext] structure filter (α : Type*) [boolean_algebra α] :=
(pred : set α)
(pred_top : pred ⊤)
(pred_inf : ∀ (x y : α), pred x → pred y → pred (x ⊓ y))
(pred_monotone : ∀ (x y : α), x ≤ y → pred x → pred y)

namespace filter

instance : partial_order (filter α) :=
{ le          := λ f g, f.pred ⊆ g.pred,
  le_refl     := λ f, set.subset.rfl,
  le_trans    := λ f g h, set.subset.trans,
  le_antisymm := λ f g h₁ h₂, filter.ext _ _ (set.subset.antisymm h₁ h₂) }

instance : has_inf (filter α) :=
⟨λ f g,
{ pred          := f.pred ∩ g.pred,
  pred_top      := by split; apply filter.pred_top,
  pred_inf      := λ x y ⟨h₁, h₂⟩ ⟨h₃, h₄⟩, by split; apply filter.pred_inf; assumption,
  pred_monotone := λ x y h₁ ⟨h₂, h₃⟩, by split; apply filter.pred_monotone; assumption }⟩

instance : semilattice_inf (filter α) :=
{ inf_le_left  := λ f g, set.inter_subset_left _ _,
  inf_le_right := λ f g, set.inter_subset_right _ _,
  le_inf       := λ f g h, set.subset_inter,
  .. filter.has_inf, .. filter.partial_order }

def principal (x : α) : filter α :=
{ pred          := λ y, x ≤ y,
  pred_top      := le_top,
  pred_inf      := λ y z, le_inf,
  pred_monotone := λ y z, function.swap le_trans }

instance : order_top (filter α) :=
{ top := principal ⊥,
  le_top := λ f x (h : f.pred x), bot_le,
  .. filter.partial_order }

instance : order_bot (filter α) :=
{ bot := principal ⊤,
  bot_le := λ f x (h : ⊤ ≤ x), (top_unique h).substr f.pred_top,
  .. filter.partial_order }

def insert (x : α) (f : filter α) : filter α :=
{ pred          := λ y, ∃ z, (f.pred z) ∧ (x ⊓ z ≤ y),
  pred_top      := ⟨⊤, f.pred_top, inf_le_right⟩,
  pred_inf      := λ y z ⟨y', h_fy', h_xy'⟩ ⟨z', h_fz', h_xz'⟩,
    ⟨y' ⊓ z',
     f.pred_inf _ _ h_fy' h_fz',
     le_inf
       (calc x ⊓ (y' ⊓ z') ≤ x ⊓ y' : inf_le_inf_left _ inf_le_left
        ...                ≤ y      : h_xy')
       (calc x ⊓ (y' ⊓ z') ≤ x ⊓ z' : inf_le_inf_left _ inf_le_right
        ...                ≤ z      : h_xz')⟩,
  pred_monotone := λ y z h_yz ⟨y', h_fy', h_xy'⟩, ⟨y', h_fy', le_trans h_xy' h_yz⟩ }

lemma mem_insert (x : α) (f : filter α) : (insert x f).pred x :=
⟨⊤, f.pred_top, inf_le_left⟩

lemma le_insert (x : α) (f : filter α) : f ≤ (insert x f) :=
λ y h, ⟨y, h, inf_le_right⟩

end filter

structure ultrafilter (α : Type*) [boolean_algebra α] extends filter α :=
(or_compl      : ∀ (x : α),   pred x ∨ pred xᶜ)
(not_and_compl : ∀ (x : α), ¬(pred x ∧ pred xᶜ))

variables {u : ultrafilter α}

namespace ultrafilter

@[priority 0] instance : has_mem (ultrafilter α) α := ⟨λ u x, u.pred x⟩

lemma mem_monotone : x ≤ y → u ∈ x → u ∈ y :=
u.pred_monotone x y

lemma mem_top : u ∈ (⊤ : α) :=
u.pred_top

lemma not_mem_bot : u ∉ (⊥ : α) :=
λ h, u.not_and_compl ⊥ ⟨h, compl_bot.substr mem_top⟩

lemma mem_sup_left : u ∈ x → u ∈ (x ⊔ y) :=
mem_monotone le_sup_left

lemma mem_sup_right : u ∈ y → u ∈ (x ⊔ y) :=
mem_monotone le_sup_right

lemma or_of_mem_sup : u ∈ (x ⊔ y) → (u ∈ x) ∨ (u ∈ y) :=
λ h, or.imp_right
  (λ hc, mem_monotone
    (calc
      (x ⊔ y) ⊓ xᶜ = y ⊓ xᶜ : by rw [inf_sup_right, inf_compl_eq_bot, bot_sup_eq]
      ...          ≤ y      : inf_le_left)
    (u.pred_inf _ _ h hc))
  (u.or_compl x)

lemma inf_mem_left : u ∈ (x ⊓ y) → u ∈ x :=
λ h, mem_monotone inf_le_left h

lemma inf_mem_right : u ∈ (x ⊓ y) → u ∈ y :=
λ h, mem_monotone inf_le_right h

lemma mem_inf : u ∈ x → u ∈ y → u ∈ (x ⊓ y) :=
u.pred_inf x y

lemma exists_of_not_le : ¬(x ≤ y) → ∃ u, (u ∈ x) ∧ (u ∉ y) :=
λ h_not_le,
let filters := {f : filter α // f.pred x ∧ ¬(f.pred y)},
    le : filters → filters → Prop :=
      λ f g, f.val ≤ g.val,
    bot : filters :=
      ⟨filter.principal x, le_refl x, h_not_le⟩,
    bot_le {f : filters} : le bot f :=
      λ z (h_le : x ≤ z), f.val.pred_monotone x z h_le f.prop.left,
    bound c (hc : zorn.chain le c) : filters :=
      let c' := insert bot c,
          hc' := zorn.chain_insert hc (λ f _ _, or.inl bot_le),
          h_bot : c' bot := set.mem_insert bot c in
      ⟨{ pred          := λ z, ∃ f, (c' f) ∧ (f.val.pred z),
         pred_top      := ⟨bot, h_bot, (le_top : x ≤ ⊤)⟩,
         pred_inf      := λ z w ⟨f, h_cf, h_fz⟩ ⟨g, h_cg, h_gw⟩,
           or.elim
             (zorn.chain.total hc' h_cf h_cg)
             (λ h_fg, ⟨g, h_cg, g.val.pred_inf _ _ (h_fg h_fz) h_gw⟩)
             (λ h_gf, ⟨f, h_cf, f.val.pred_inf _ _ h_fz (h_gf h_gw)⟩),
         pred_monotone := λ z w h_zw ⟨f, h_cf, h_fz⟩,
           ⟨f, h_cf, f.val.pred_monotone _ _ h_zw h_fz⟩ },
       ⟨bot, h_bot, bot.prop.left⟩,
       (λ ⟨f, h_cf, h_fy⟩, f.prop.right h_fy)⟩,
    ⟨⟨m, h_mx, h_my⟩, is_max⟩ := zorn.exists_maximal_of_chains_bounded
      (λ c hc, ⟨bound c hc, λ f h_cf z h_fz, ⟨f, set.mem_insert_of_mem _ h_cf, h_fz⟩⟩)
      (λ f g h, set.subset.trans) in
⟨{ or_compl      := λ z,
     if h_z : (filter.insert z m).pred y
     then if h_zc : (filter.insert zᶜ m).pred y
          then let ⟨w,  h_mw,  h_zw⟩  := h_z,
                   ⟨wc, h_mwc, h_zwc⟩ := h_zc in
               false.elim (h_my (m.pred_monotone _ _
                 (calc
                   w ⊓ wc = (z ⊔ zᶜ) ⊓ (w ⊓ wc)              : by simp
                   ...    = (z ⊓ (w ⊓ wc)) ⊔ (zᶜ ⊓ (w ⊓ wc)) : inf_sup_right
                   ...    ≤ (z ⊓ w)        ⊔ (zᶜ ⊓ wc)       : sup_le_sup
                                                               (inf_le_inf_left _ inf_le_left)
                                                               (inf_le_inf_left _ inf_le_right)
                   ...    ≤ y                                : sup_le h_zw h_zwc)
                 (m.pred_inf _ _ h_mw h_mwc)))
          else or.inr
            ((is_max
              ⟨filter.insert zᶜ m, filter.le_insert zᶜ m h_mx, h_zc⟩
              (filter.le_insert zᶜ m))
            (filter.mem_insert zᶜ m))
     else or.inl
       ((is_max
          ⟨filter.insert z m, filter.le_insert z m h_mx, h_z⟩
          (filter.le_insert z m))
        (filter.mem_insert z m)),
   not_and_compl := λ z ⟨h_z, h_zc⟩,
     h_my (m.pred_monotone _ _ (by simp) (m.pred_inf _ _ h_z h_zc)),
   .. m },
 h_mx,
 h_my⟩

end ultrafilter

namespace extensionality
open ultrafilter

lemma rw_eq : (x = y) ↔ (x ≤ y) ∧ (y ≤ x) :=
le_antisymm_iff

lemma rw_le : (x ≤ y) ↔ ∀ u, u ∈ x → u ∈ y :=
⟨λ h u, mem_monotone h,
 λ h_forall, not_not.mp (λ h_not_le,
   let ⟨u, hx, hy⟩ := exists_of_not_le h_not_le in hy (h_forall u hx))⟩

lemma rw_bot : u ∈ (⊥ : α) ↔ false :=
iff_false_intro not_mem_bot

lemma rw_top : u ∈ (⊤ : α) ↔ true :=
iff_true_intro mem_top

lemma rw_sup : u ∈ (x ⊔ y) ↔ (u ∈ x) ∨ (u ∈ y) :=
⟨or_of_mem_sup,
 or.rec mem_sup_left mem_sup_right⟩

lemma rw_inf : u ∈ (x ⊓ y) ↔ (u ∈ x) ∧ (u ∈ y) :=
⟨λ h, ⟨inf_mem_left h, inf_mem_right h⟩,
 λ h, mem_inf h.left h.right⟩

lemma rw_compl : u ∈ xᶜ ↔ ¬(u ∈ x) :=
⟨(λ hc h, u.not_and_compl x ⟨h, hc⟩),
 (or.resolve_left (u.or_compl x))⟩

lemma rw_sdiff : u ∈ x \ y ↔ u ∈ x ∧ u ∉ y := begin
  rewrite sdiff_eq,
  rewrite <- rw_compl,
  rw rw_inf,
end

instance boolalg_base_ext_lemmas (α : Type*) [boolean_algebra α]
  : (boolalg_ext_lemmas α (ultrafilter α)) :=
{
  simpl_eq := by apply rw_eq,
  simpl_lt := by apply lt_iff_le_not_le,
  ext_bot := by apply rw_bot,
  ext_sdiff := by apply rw_sdiff,
  ext_le := by apply rw_le,
  ext_meet := by apply rw_sup,
  ext_join := by apply rw_inf,
}

instance boolalg_base_ext_lemmas_compl (α : Type*) [boolean_algebra α]  :
  (boolalg_ext_lemmas_compl  α (ultrafilter α)) :=
{
  ext_compl := by apply rw_compl,
}

instance boolalg_base_ext_lemmas_top (α : Type*) [boolean_algebra α]  :
  (boolalg_ext_lemmas_top  α (ultrafilter α)) :=
{
  ext_top := by apply rw_top,
}

end extensionality

end order.boolean_algebra


/-
Copyright (c) 2021 Justus Springer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Justus Springer, Andrew Yang
-/
import algebra.category.CommRing.filtered_colimits
import algebraic_geometry.sheafed_space
import topology.sheaves.stalks
import algebra.category.CommRing.colimits
import algebra.category.CommRing.limits

/-!
# Ringed spaces

We introduce the category of ringed spaces, as an alias for `SheafedSpace CommRing`.

The facts collected in this file are typically stated for locally ringed spaces, but never actually
make use of the locality of stalks. See for instance https://stacks.math.columbia.edu/tag/01HZ.

-/

universe v

open category_theory
open topological_space
open opposite
open Top
open Top.presheaf

namespace algebraic_geometry

/-- The type of Ringed spaces, as an abbreviation for `SheafedSpace CommRing`. -/
abbreviation RingedSpace : Type* := SheafedSpace CommRing

namespace RingedSpace

open SheafedSpace

variables (X : RingedSpace.{v})

/--
If the germ of a section `f` is a unit in the stalk at `x`, then `f` must be a unit on some small
neighborhood around `x`.
-/
lemma is_unit_res_of_is_unit_germ (U : opens X) (f : X.presheaf.obj (op U)) (x : U)
  (h : is_unit (X.presheaf.germ x f)) :
  ∃ (V : opens X) (i : V ⟶ U) (hxV : x.1 ∈ V), is_unit (X.presheaf.map i.op f) :=
begin
  obtain ⟨g', heq⟩ := h.exists_right_inv,
  obtain ⟨V, hxV, g, rfl⟩ := X.presheaf.germ_exist x.1 g',
  let W := U ⊓ V,
  have hxW : x.1 ∈ W := ⟨x.2, hxV⟩,
  erw [← X.presheaf.germ_res_apply (opens.inf_le_left U V) ⟨x.1, hxW⟩ f,
    ← X.presheaf.germ_res_apply (opens.inf_le_right U V) ⟨x.1, hxW⟩ g,
    ← ring_hom.map_mul, ← ring_hom.map_one (X.presheaf.germ (⟨x.1, hxW⟩ : W))] at heq,
  obtain ⟨W', hxW', i₁, i₂, heq'⟩ := X.presheaf.germ_eq x.1 hxW hxW _ _ heq,
  use [W', i₁ ≫ opens.inf_le_left U V, hxW'],
  rw [ring_hom.map_one, ring_hom.map_mul, ← comp_apply, ← X.presheaf.map_comp, ← op_comp] at heq',
  exact is_unit_of_mul_eq_one _ _ heq',
end

/-- If a section `f` is a unit in each stalk, `f` must be a unit. -/
lemma is_unit_of_is_unit_germ (U : opens X) (f : X.presheaf.obj (op U))
  (h : ∀ x : U, is_unit (X.presheaf.germ x f)) :
  is_unit f :=
begin
  -- We pick a cover of `U` by open sets `V x`, such that `f` is a unit on each `V x`.
  choose V iVU m h_unit using λ x : U, X.is_unit_res_of_is_unit_germ U f x (h x),
  have hcover : U ≤ supr V,
  { intros x hxU,
    rw [opens.mem_coe, opens.mem_supr],
    exact ⟨⟨x, hxU⟩, m ⟨x, hxU⟩⟩ },
  -- Let `g x` denote the inverse of `f` in `U x`.
  choose g hg using λ x : U, is_unit.exists_right_inv (h_unit x),
  -- We claim that these local inverses glue together to a global inverse of `f`.
  obtain ⟨gl, gl_spec, -⟩ := X.sheaf.exists_unique_gluing' V U iVU hcover g _,
  swap,
  { intros x y,
    apply section_ext X.sheaf (V x ⊓ V y),
    rintro ⟨z, hzVx, hzVy⟩,
    rw [germ_res_apply, germ_res_apply],
    apply (is_unit.mul_right_inj (h ⟨z, (iVU x).le hzVx⟩)).mp,
    erw [← X.presheaf.germ_res_apply (iVU x) ⟨z, hzVx⟩ f, ← ring_hom.map_mul,
      congr_arg (X.presheaf.germ (⟨z, hzVx⟩ : V x)) (hg x), germ_res_apply,
      ← X.presheaf.germ_res_apply (iVU y) ⟨z, hzVy⟩ f, ← ring_hom.map_mul,
      congr_arg (X.presheaf.germ (⟨z, hzVy⟩ : V y)) (hg y),
      ring_hom.map_one, ring_hom.map_one] },
  apply is_unit_of_mul_eq_one f gl,
  apply X.sheaf.eq_of_locally_eq' V U iVU hcover,
  intro i,
  rw [ring_hom.map_one, ring_hom.map_mul, gl_spec],
  exact hg i,
end

/--
The basic open of a section `f` is the set of all points `x`, such that the germ of `f` at
`x` is a unit.
-/
def basic_open {U : opens X} (f : X.presheaf.obj (op U)) : opens X :=
{ val := coe '' { x : U | is_unit (X.presheaf.germ x f) },
  property := begin
    rw is_open_iff_forall_mem_open,
    rintros _ ⟨x, hx, rfl⟩,
    obtain ⟨V, i, hxV, hf⟩ := X.is_unit_res_of_is_unit_germ U f x hx,
    use V.1,
    refine ⟨_, V.2, hxV⟩,
    intros y hy,
    use (⟨y, i.le hy⟩ : U),
    rw set.mem_set_of_eq,
    split,
    { convert ring_hom.is_unit_map (X.presheaf.germ ⟨y, hy⟩) hf,
      exact (X.presheaf.germ_res_apply i ⟨y, hy⟩ f).symm },
    { refl }
  end }

@[simp]
lemma mem_basic_open {U : opens X} (f : X.presheaf.obj (op U)) (x : U) :
  ↑x ∈ X.basic_open f ↔ is_unit (X.presheaf.germ x f) :=
begin
  split,
  { rintro ⟨x, hx, a⟩, cases subtype.eq a, exact hx },
  { intro h, exact ⟨x, h, rfl⟩ },
end

lemma basic_open_subset {U : opens X} (f : X.presheaf.obj (op U)) : X.basic_open f ⊆ U :=
by { rintros _ ⟨x, hx, rfl⟩, exact x.2 }

/-- The restriction of a section `f` to the basic open of `f` is a unit. -/

lemma basic_open_res {U V : (opens X)ᵒᵖ} (i : U ⟶ V) (f : X.presheaf.obj U) :
  @basic_open X (unop V) (X.presheaf.map i f) = (unop V) ∩ @basic_open X (unop U) f :=
begin
  induction U using opposite.rec,
  induction V using opposite.rec,
  let g := i.unop, have : i = g.op := rfl, clear_value g, subst this,
  ext, split,
  { rintro ⟨x, (hx : is_unit _), rfl⟩, rw germ_res_apply at hx,
    exact ⟨x.2, g x, hx, rfl⟩ },
  { rintros ⟨hxV, x, hx, rfl⟩,
    use ⟨x, hxV⟩,
    split,
    { change is_unit _, rw germ_res_apply, exact hx },
    { refl } }
end

end RingedSpace

end algebraic_geometry