/-
Copyright (c) 2022 Alex J. Best, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best, Yaël Dillies
-/
import algebra.order.hom.monoid
import algebra.order.ring
import algebra.ring.equiv

/-!
# Ordered ring homomorphisms

Homomorphisms between ordered (semi)rings that respect the ordering.

## Main definitions

* `order_ring_hom` : Monotone semiring homomorphisms.
* `order_ring_iso` : Monotone semiring isomorphisms.

## Notation

* `→+*o`: Ordered ring homomorphisms.
* `≃+*o`: Ordered ring isomorphisms.

## Tags

ordered ring homomorphism, order homomorphism
-/

open function

variables {F α β γ δ : Type*}

/-- `order_ring_hom α β` is the type of monotone semiring homomorphisms from `α` to `β`.

When possible, instead of parametrizing results over `(f : order_ring_hom α β)`,
you should parametrize over `(F : Type*) [order_ring_hom_class F α β] (f : F)`.

When you extend this structure, make sure to extend `order_ring_hom_class`. -/
structure order_ring_hom (α β : Type*) [non_assoc_semiring α] [preorder α] [non_assoc_semiring β]
  [preorder β]
  extends α →+* β :=
(monotone' : monotone to_fun)

/-- Reinterpret an ordered ring homomorphism as a ring homomorphism. -/
add_decl_doc order_ring_hom.to_ring_hom

infix ` →+*o `:25 := order_ring_hom

/-- `order_ring_hom α β` is the type of order-preserving semiring isomorphisms between `α` and `β`.

When possible, instead of parametrizing results over `(f : order_ring_iso α β)`,
you should parametrize over `(F : Type*) [order_ring_iso_class F α β] (f : F)`.

When you extend this structure, make sure to extend `order_ring_iso_class`. -/
structure order_ring_iso (α β : Type*) [has_mul α] [has_add α] [has_le α] [has_mul β] [has_add β]
  [has_le β] extends α ≃+* β :=
(map_le_map_iff' {a b : α} : to_fun a ≤ to_fun b ↔ a ≤ b)

infix ` ≃+*o `:25 := order_ring_iso

/-- `order_ring_hom_class F α β` states that `F` is a type of ordered semiring homomorphisms.
You should extend this typeclass when you extend `order_ring_hom`. -/
class order_ring_hom_class (F : Type*) (α β : out_param $ Type*) [non_assoc_semiring α] [preorder α]
  [non_assoc_semiring β] [preorder β] extends ring_hom_class F α β :=
(monotone (f : F) : monotone f)

/-- `order_ring_iso_class F α β` states that `F` is a type of ordered semiring isomorphisms.
You should extend this class when you extend `order_ring_iso`. -/
class order_ring_iso_class (F : Type*) (α β : out_param Type*) [has_mul α] [has_add α] [has_le α]
  [has_mul β] [has_add β] [has_le β]
  extends ring_equiv_class F α β :=
(map_le_map_iff (f : F) {a b : α} : f a ≤ f b ↔ a ≤ b)

@[priority 100] -- See note [lower priority instance]
instance order_ring_hom_class.to_order_add_monoid_hom_class [non_assoc_semiring α] [preorder α]
  [non_assoc_semiring β] [preorder β] [order_ring_hom_class F α β] :
  order_add_monoid_hom_class F α β :=
{ .. ‹order_ring_hom_class F α β› }

@[priority 100] -- See note [lower priority instance]
instance order_ring_hom_class.to_order_monoid_with_zero_hom_class [non_assoc_semiring α]
  [preorder α] [non_assoc_semiring β] [preorder β] [order_ring_hom_class F α β] :
  order_monoid_with_zero_hom_class F α β :=
{ .. ‹order_ring_hom_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance order_ring_iso_class.to_order_iso_class [has_mul α] [has_add α] [has_le α] [has_mul β]
  [has_add β] [has_le β] [order_ring_iso_class F α β] :
  order_iso_class F α β :=
{ ..‹order_ring_iso_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance order_ring_iso_class.to_order_ring_hom_class [non_assoc_semiring α] [preorder α]
  [non_assoc_semiring β] [preorder β] [order_ring_iso_class F α β] :
  order_ring_hom_class F α β :=
{ monotone := λ f, order_hom_class.mono f, ..‹order_ring_iso_class F α β› }

instance [non_assoc_semiring α] [preorder α] [non_assoc_semiring β] [preorder β]
  [order_ring_hom_class F α β] :
  has_coe_t F (α →+*o β) :=
⟨λ f, ⟨f, order_hom_class.mono f⟩⟩

instance [has_mul α] [has_add α] [has_le α] [has_mul β] [has_add β] [has_le β]
  [order_ring_iso_class F α β] :
  has_coe_t F (α ≃+*o β) :=
⟨λ f, ⟨f, λ a b, map_le_map_iff f⟩⟩

/-! ### Ordered ring homomorphisms -/

namespace order_ring_hom
variables [non_assoc_semiring α] [preorder α]

section preorder
variables [non_assoc_semiring β] [preorder β] [non_assoc_semiring γ] [preorder γ]
  [non_assoc_semiring δ] [preorder δ]

/-- Reinterpret an ordered ring homomorphism as an ordered additive monoid homomorphism. -/
def to_order_add_monoid_hom (f : α →+*o β) : α →+o β := { ..f }

/-- Reinterpret an ordered ring homomorphism as an order homomorphism. -/
def to_order_monoid_with_zero_hom (f : α →+*o β) : α →*₀o β := { ..f }

instance : order_ring_hom_class (α →+*o β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by obtain ⟨⟨_, _⟩, _⟩ := f; obtain ⟨⟨_, _⟩, _⟩ := g; congr',
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  map_add := λ f, f.map_add',
  map_zero := λ f, f.map_zero',
  monotone := λ f, f.monotone' }

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

lemma to_fun_eq_coe (f : α →+*o β) : f.to_fun = ⇑f := rfl
@[ext] lemma ext {f g : α →+*o β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

@[simp] lemma to_ring_hom_eq_coe (f : α →+*o β) : f.to_ring_hom = f := ring_hom.ext $ λ _, rfl
@[simp] lemma to_order_add_monoid_hom_eq_coe (f : α →+*o β) : f.to_order_add_monoid_hom = f := rfl
@[simp] lemma to_order_monoid_with_zero_hom_eq_coe (f : α →+*o β) :
  f.to_order_monoid_with_zero_hom = f := rfl

@[simp] lemma coe_coe_ring_hom (f : α →+*o β) : ⇑(f : α →+* β) = f := rfl
@[simp] lemma coe_coe_order_add_monoid_hom (f : α →+*o β) : ⇑(f : α →+o β) = f := rfl
@[simp] lemma coe_coe_order_monoid_with_zero_hom (f : α →+*o β) : ⇑(f : α →*₀o β) = f := rfl

@[norm_cast] lemma coe_ring_hom_apply (f : α →+*o β) (a : α) : (f : α →+* β) a = f a := rfl
@[norm_cast] lemma coe_order_add_monoid_hom_apply (f : α →+*o β) (a : α) : (f : α →+o β) a = f a :=
rfl
@[norm_cast] lemma coe_order_monoid_with_zero_hom_apply (f : α →+*o β) (a : α) :
  (f : α →*₀o β) a = f a := rfl

/-- Copy of a `order_ring_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.to_ring_hom.copy f' h, .. f.to_order_add_monoid_hom.copy f' h }

variable (α)

/-- The identity as an ordered ring homomorphism. -/
protected def id : α →+*o α := { ..ring_hom.id _, ..order_hom.id }

instance : inhabited (α →+*o α) := ⟨order_ring_hom.id α⟩

@[simp] lemma coe_id : ⇑(order_ring_hom.id α) = id := rfl

variable {α}

@[simp] lemma id_apply (a : α) : order_ring_hom.id α a = a := rfl

@[simp] lemma coe_ring_hom_id : (order_ring_hom.id α : α →+* α) = ring_hom.id α := rfl
@[simp] lemma coe_order_add_monoid_hom_id :
  (order_ring_hom.id α : α →+o α) = order_add_monoid_hom.id α := rfl
@[simp] lemma coe_order_monoid_with_zero_hom_id :
  (order_ring_hom.id α : α →*₀o α) = order_monoid_with_zero_hom.id α := rfl

/-- Composition of two `order_ring_hom`s as an `order_ring_hom`. -/
protected def comp (f : β →+*o γ) (g : α →+*o β) : α →+*o γ :=
{ ..f.to_ring_hom.comp g.to_ring_hom, ..f.to_order_add_monoid_hom.comp g.to_order_add_monoid_hom }

@[simp] lemma coe_comp (f : β →+*o γ) (g : α →+*o β) : ⇑(f.comp g) = f ∘ g := rfl
@[simp]

lemma cancel_right {f₁ f₂ : β →+*o γ} {g : α →+*o β} (hg : surjective g) :
  f₁.comp g = f₂.comp g ↔ f₁ = f₂ :=
⟨λ h, ext $ hg.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {f : β →+*o γ} {g₁ g₂ : α →+*o β} (hf : injective f) :
  f.comp g₁ = f.comp g₂ ↔ g₁ = g₂ :=
⟨λ h, ext $ λ a, hf $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩

end preorder

variables [non_assoc_semiring β]

instance [preorder β] : preorder (order_ring_hom α β) := preorder.lift (coe_fn : _ → α → β)

instance [partial_order β] : partial_order (order_ring_hom α β) :=
partial_order.lift _ fun_like.coe_injective

end order_ring_hom

/-! ### Ordered ring isomorphisms -/

namespace order_ring_iso
section has_le
variables [has_mul α] [has_add α] [has_le α] [has_mul β] [has_add β] [has_le β] [has_mul γ]
  [has_add γ] [has_le γ] [has_mul δ] [has_add δ] [has_le δ]

/-- Reinterpret an ordered ring isomorphism as an order isomorphism. -/
def to_order_iso (f : α ≃+*o β) : α ≃o β := ⟨f.to_ring_equiv.to_equiv, f.map_le_map_iff'⟩

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

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

lemma to_fun_eq_coe (f : α ≃+*o β) : f.to_fun = f := rfl

@[ext] lemma ext {f g : α ≃+*o β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

@[simp] lemma coe_mk (e : α ≃+* β) (h) : ⇑(⟨e, h⟩ : α ≃+*o β) = e := rfl
@[simp] lemma mk_coe (e : α ≃+*o β) (h) : (⟨e, h⟩ : α ≃+*o β) = e := ext $ λ _, rfl

@[simp] lemma to_ring_equiv_eq_coe (f : α ≃+*o β) : f.to_ring_equiv = f := ring_equiv.ext $ λ _, rfl
@[simp] lemma to_order_iso_eq_coe (f : α ≃+*o β) : f.to_order_iso = f := order_iso.ext rfl

@[simp, norm_cast] lemma coe_to_ring_equiv (f : α ≃+*o β) : ⇑(f : α ≃+* β) = f := rfl
@[simp, norm_cast] lemma coe_to_order_iso (f : α ≃+*o β) : ⇑(f : α ≃o β) = f := rfl

variable (α)

/-- The identity map as an ordered ring isomorphism. -/
@[refl] protected def refl : α ≃+*o α := ⟨ring_equiv.refl α, λ _ _, iff.rfl⟩

instance : inhabited (α ≃+*o α) := ⟨order_ring_iso.refl α⟩

@[simp] lemma refl_apply (x : α) : order_ring_iso.refl α x = x := rfl
@[simp] lemma coe_ring_equiv_refl : (order_ring_iso.refl α : α ≃+* α) = ring_equiv.refl α := rfl
@[simp] lemma coe_order_iso_refl : (order_ring_iso.refl α : α ≃o α) = order_iso.refl α := rfl

variables {α}

/-- The inverse of an ordered ring isomorphism as an ordered ring isomorphism. -/
@[symm] protected def symm (e : α ≃+*o β) : β ≃+*o α :=
⟨e.to_ring_equiv.symm,
  λ a b, by erw [←map_le_map_iff e, e.1.apply_symm_apply, e.1.apply_symm_apply]⟩

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : α ≃+*o β) : β → α := e.symm

@[simp] lemma symm_symm (e : α ≃+*o β) : e.symm.symm = e := ext $ λ _, rfl

/-- Composition of `order_ring_iso`s as an `order_ring_iso`. -/
@[trans, simps] protected def trans (f : α ≃+*o β) (g : β ≃+*o γ) : α ≃+*o γ :=
⟨f.to_ring_equiv.trans g.to_ring_equiv, λ a b, (map_le_map_iff g).trans (map_le_map_iff f)⟩

@[simp] lemma trans_apply (f : α ≃+*o β) (g : β ≃+*o γ) (a : α) : f.trans g a = g (f a) := rfl

@[simp] lemma self_trans_symm (e : α ≃+*o β) : e.trans e.symm = order_ring_iso.refl α :=
ext e.left_inv
@[simp] lemma symm_trans_self (e : α ≃+*o β) : e.symm.trans e = order_ring_iso.refl β :=
ext e.right_inv

end has_le

section non_assoc_semiring
variables [non_assoc_semiring α] [preorder α] [non_assoc_semiring β] [preorder β]
  [non_assoc_semiring γ] [preorder γ]

/-- Reinterpret an ordered ring isomorphism as an ordered ring homomorphism. -/
def to_order_ring_hom (f : α ≃+*o β) : α →+*o β :=
⟨f.to_ring_equiv.to_ring_hom, λ a b, (map_le_map_iff f).2⟩

@[simp] lemma to_order_ring_hom_eq_coe (f : α ≃+*o β) : f.to_order_ring_hom = f := rfl

@[simp, norm_cast] lemma coe_to_order_ring_hom (f : α ≃+*o β) : ⇑(f : α →+*o β) = f := rfl

@[simp]
lemma coe_to_order_ring_hom_refl : (order_ring_iso.refl α : α →+*o α) = order_ring_hom.id α := rfl

end non_assoc_semiring
end order_ring_iso


/-
Copyright (c) 2020 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.basic
import Mathlib.PostPort

universes u l u_1 v

namespace Mathlib

/-!
# Unbundled relation classes

In this file we prove some properties of `is_*` classes defined in `init.algebra.classes`. The main
difference between these classes and the usual order classes (`preorder` etc) is that usual classes
extend `has_le` and/or `has_lt` while these classes take a relation as an explicit argument.

-/

theorem is_refl.swap {α : Type u} (r : α → α → Prop) [is_refl α r] : is_refl α (function.swap r) :=
  is_refl.mk (refl_of r)

theorem is_irrefl.swap {α : Type u} (r : α → α → Prop) [is_irrefl α r] :
    is_irrefl α (function.swap r) :=
  is_irrefl.mk (irrefl_of r)

theorem is_trans.swap {α : Type u} (r : α → α → Prop) [is_trans α r] :
    is_trans α (function.swap r) :=
  is_trans.mk
    fun (a b c : α) (h₁ : function.swap r a b) (h₂ : function.swap r b c) => trans_of r h₂ h₁

theorem is_antisymm.swap {α : Type u} (r : α → α → Prop) [is_antisymm α r] :
    is_antisymm α (function.swap r) :=
  is_antisymm.mk
    fun (a b : α) (h₁ : function.swap r a b) (h₂ : function.swap r b a) => antisymm h₂ h₁

theorem is_asymm.swap {α : Type u} (r : α → α → Prop) [is_asymm α r] :
    is_asymm α (function.swap r) :=
  is_asymm.mk
    fun (a b : α) (h₁ : function.swap r a b) (h₂ : function.swap r b a) => asymm_of r h₂ h₁

theorem is_total.swap {α : Type u} (r : α → α → Prop) [is_total α r] :
    is_total α (function.swap r) :=
  is_total.mk fun (a b : α) => or.swap (total_of r a b)

theorem is_trichotomous.swap {α : Type u} (r : α → α → Prop) [is_trichotomous α r] :
    is_trichotomous α (function.swap r) :=
  sorry

theorem is_preorder.swap {α : Type u} (r : α → α → Prop) [is_preorder α r] :
    is_preorder α (function.swap r) :=
  is_preorder.mk

theorem is_strict_order.swap {α : Type u} (r : α → α → Prop) [is_strict_order α r] :
    is_strict_order α (function.swap r) :=
  is_strict_order.mk

theorem is_partial_order.swap {α : Type u} (r : α → α → Prop) [is_partial_order α r] :
    is_partial_order α (function.swap r) :=
  is_partial_order.mk

theorem is_total_preorder.swap {α : Type u} (r : α → α → Prop) [is_total_preorder α r] :
    is_total_preorder α (function.swap r) :=
  is_total_preorder.mk

theorem is_linear_order.swap {α : Type u} (r : α → α → Prop) [is_linear_order α r] :
    is_linear_order α (function.swap r) :=
  is_linear_order.mk

protected theorem is_asymm.is_antisymm {α : Type u} (r : α → α → Prop) [is_asymm α r] :
    is_antisymm α r :=
  is_antisymm.mk fun (x y : α) (h₁ : r x y) (h₂ : r y x) => false.elim (asymm h₁ h₂)

protected theorem is_asymm.is_irrefl {α : Type u} {r : α → α → Prop} [is_asymm α r] :
    is_irrefl α r :=
  is_irrefl.mk fun (a : α) (h : r a a) => asymm h h

/- Convert algebraic structure style to explicit relation style typeclasses -/

protected instance has_le.le.is_refl {α : Type u} [preorder α] : is_refl α LessEq :=
  is_refl.mk le_refl

protected instance ge.is_refl {α : Type u} [preorder α] : is_refl α ge :=
  is_refl.swap fun (b a : α) => b ≤ a

protected instance has_le.le.is_trans {α : Type u} [preorder α] : is_trans α LessEq :=
  is_trans.mk le_trans

protected instance ge.is_trans {α : Type u} [preorder α] : is_trans α ge :=
  is_trans.swap fun (b a : α) => b ≤ a

protected instance has_le.le.is_preorder {α : Type u} [preorder α] : is_preorder α LessEq :=
  is_preorder.mk

protected instance ge.is_preorder {α : Type u} [preorder α] : is_preorder α ge := is_preorder.mk

protected instance has_lt.lt.is_irrefl {α : Type u} [preorder α] : is_irrefl α Less :=
  is_irrefl.mk lt_irrefl

protected instance gt.is_irrefl {α : Type u} [preorder α] : is_irrefl α gt :=
  is_irrefl.swap fun (b a : α) => b < a

protected instance has_lt.lt.is_trans {α : Type u} [preorder α] : is_trans α Less :=
  is_trans.mk lt_trans

protected instance gt.is_trans {α : Type u} [preorder α] : is_trans α gt :=
  is_trans.swap fun (b a : α) => b < a

protected instance has_lt.lt.is_asymm {α : Type u} [preorder α] : is_asymm α Less :=
  is_asymm.mk lt_asymm

protected instance gt.is_asymm {α : Type u} [preorder α] : is_asymm α gt :=
  is_asymm.swap fun (b a : α) => b < a

protected instance has_lt.lt.is_antisymm {α : Type u} [preorder α] : is_antisymm α Less :=
  is_asymm.is_antisymm Less

protected instance gt.is_antisymm {α : Type u} [preorder α] : is_antisymm α gt :=
  is_asymm.is_antisymm gt

protected instance has_lt.lt.is_strict_order {α : Type u} [preorder α] : is_strict_order α Less :=
  is_strict_order.mk

protected instance gt.is_strict_order {α : Type u} [preorder α] : is_strict_order α gt :=
  is_strict_order.mk

protected instance preorder.is_total_preorder {α : Type u} [preorder α] [is_total α LessEq] :
    is_total_preorder α LessEq :=
  is_total_preorder.mk

protected instance has_le.le.is_antisymm {α : Type u} [partial_order α] : is_antisymm α LessEq :=
  is_antisymm.mk le_antisymm

protected instance ge.is_antisymm {α : Type u} [partial_order α] : is_antisymm α ge :=
  is_antisymm.swap fun (b a : α) => b ≤ a

protected instance has_le.le.is_partial_order {α : Type u} [partial_order α] :
    is_partial_order α LessEq :=
  is_partial_order.mk

protected instance ge.is_partial_order {α : Type u} [partial_order α] : is_partial_order α ge :=
  is_partial_order.mk

protected instance has_le.le.is_total {α : Type u} [linear_order α] : is_total α LessEq :=
  is_total.mk le_total

protected instance ge.is_total {α : Type u} [linear_order α] : is_total α ge :=
  is_total.swap fun (b a : α) => b ≤ a

protected instance linear_order.is_total_preorder {α : Type u} [linear_order α] :
    is_total_preorder α LessEq :=
  preorder.is_total_preorder

protected instance ge.is_total_preorder {α : Type u} [linear_order α] : is_total_preorder α ge :=
  is_total_preorder.mk

protected instance has_le.le.is_linear_order {α : Type u} [linear_order α] :
    is_linear_order α LessEq :=
  is_linear_order.mk

protected instance ge.is_linear_order {α : Type u} [linear_order α] : is_linear_order α ge :=
  is_linear_order.mk

protected instance has_lt.lt.is_trichotomous {α : Type u} [linear_order α] :
    is_trichotomous α Less :=
  is_trichotomous.mk lt_trichotomy

protected instance gt.is_trichotomous {α : Type u} [linear_order α] : is_trichotomous α gt :=
  is_trichotomous.swap fun (b a : α) => b < a

protected instance order_dual.is_total_le {α : Type u} [HasLessEq α] [is_total α LessEq] :
    is_total (order_dual α) LessEq :=
  is_total.swap fun (x y : α) => x ≤ y

theorem ne_of_irrefl {α : Type u} {r : α → α → Prop} [is_irrefl α r] {x : α} {y : α} :
    r x y → x ≠ y :=
  sorry

theorem trans_trichotomous_left {α : Type u} {r : α → α → Prop} [is_trans α r] [is_trichotomous α r]
    {a : α} {b : α} {c : α} : ¬r b a → r b c → r a c :=
  sorry

theorem trans_trichotomous_right {α : Type u} {r : α → α → Prop} [is_trans α r]
    [is_trichotomous α r] {a : α} {b : α} {c : α} : r a b → ¬r c b → r a c :=
  sorry

/-- Construct a partial order from a `is_strict_order` relation -/
def partial_order_of_SO {α : Type u} (r : α → α → Prop) [is_strict_order α r] : partial_order α :=
  partial_order.mk (fun (x y : α) => x = y ∨ r x y) r sorry sorry sorry

/-- This is basically the same as `is_strict_total_order`, but that definition is
  in Type (probably by mistake) and also has redundant assumptions. -/
class is_strict_total_order' (α : Type u) (lt : α → α → Prop)
    extends is_trichotomous α lt, is_strict_order α lt where

/-- Construct a linear order from an `is_strict_total_order'` relation -/
def linear_order_of_STO' {α : Type u} (r : α → α → Prop) [is_strict_total_order' α r]
    [(x y : α) → Decidable (¬r x y)] : linear_order α :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry
    (fun (x y : α) => decidable_of_iff (¬r y x) sorry) Mathlib.decidable_eq_of_decidable_le
    Mathlib.decidable_lt_of_decidable_le

theorem is_strict_total_order'.swap {α : Type u} (r : α → α → Prop) [is_strict_total_order' α r] :
    is_strict_total_order' α (function.swap r) :=
  is_strict_total_order'.mk

protected instance has_lt.lt.is_strict_total_order' {α : Type u} [linear_order α] :
    is_strict_total_order' α Less :=
  is_strict_total_order'.mk

/-- A connected order is one satisfying the condition `a < c → a < b ∨ b < c`.
  This is recognizable as an intuitionistic substitute for `a ≤ b ∨ b ≤ a` on
  the constructive reals, and is also known as negative transitivity,
  since the contrapositive asserts transitivity of the relation `¬ a < b`.  -/
class is_order_connected (α : Type u) (lt : α → α → Prop) where
  conn : ∀ (a b c : α), lt a c → lt a b ∨ lt b c

theorem is_order_connected.neg_trans {α : Type u} {r : α → α → Prop} [is_order_connected α r]
    {a : α} {b : α} {c : α} (h₁ : ¬r a b) (h₂ : ¬r b c) : ¬r a c :=
  sorry

theorem is_strict_weak_order_of_is_order_connected {α : Type u} {r : α → α → Prop} [is_asymm α r]
    [is_order_connected α r] : is_strict_weak_order α r :=
  is_strict_weak_order.mk

protected instance is_order_connected_of_is_strict_total_order' {α : Type u} {r : α → α → Prop}
    [is_strict_total_order' α r] : is_order_connected α r :=
  is_order_connected.mk
    fun (a b c : α) (h : r a c) =>
      or.imp_right
        (fun (o : a = b ∨ r b a) =>
          or.elim o (fun (e : a = b) => e ▸ h) fun (h' : r b a) => trans h' h)
        (trichotomous a b)

protected instance is_strict_total_order_of_is_strict_total_order' {α : Type u} {r : α → α → Prop}
    [is_strict_total_order' α r] : is_strict_total_order α r :=
  is_strict_total_order.mk

protected instance has_lt.lt.is_strict_total_order {α : Type u} [linear_order α] :
    is_strict_total_order α Less :=
  Mathlib.is_strict_total_order_of_is_strict_total_order'

protected instance has_lt.lt.is_order_connected {α : Type u} [linear_order α] :
    is_order_connected α Less :=
  Mathlib.is_order_connected_of_is_strict_total_order'

protected instance has_lt.lt.is_incomp_trans {α : Type u} [linear_order α] :
    is_incomp_trans α Less :=
  is_strict_weak_order.to_is_incomp_trans

protected instance has_lt.lt.is_strict_weak_order {α : Type u} [linear_order α] :
    is_strict_weak_order α Less :=
  Mathlib.is_strict_weak_order_of_linear_order

/-- An extensional relation is one in which an element is determined by its set
  of predecessors. It is named for the `x ∈ y` relation in set theory, whose
  extensionality is one of the first axioms of ZFC. -/
class is_extensional (α : Type u) (r : α → α → Prop) where
  ext : ∀ (a b : α), (∀ (x : α), r x a ↔ r x b) → a = b

protected instance is_extensional_of_is_strict_total_order' {α : Type u} {r : α → α → Prop}
    [is_strict_total_order' α r] : is_extensional α r :=
  is_extensional.mk
    fun (a b : α) (H : ∀ (x : α), r x a ↔ r x b) =>
      or.resolve_right (or.resolve_left (trichotomous a b) (mt (iff.mpr (H a)) (irrefl a)))
        (mt (iff.mp (H b)) (irrefl b))

/-- A well order is a well-founded linear order. -/
class is_well_order (α : Type u) (r : α → α → Prop) extends is_strict_total_order' α r where
  wf : well_founded r

protected instance is_well_order.is_strict_total_order {α : Type u_1} (r : α → α → Prop)
    [is_well_order α r] : is_strict_total_order α r :=
  Mathlib.is_strict_total_order_of_is_strict_total_order'

protected instance is_well_order.is_extensional {α : Type u_1} (r : α → α → Prop)
    [is_well_order α r] : is_extensional α r :=
  Mathlib.is_extensional_of_is_strict_total_order'

protected instance is_well_order.is_trichotomous {α : Type u_1} (r : α → α → Prop)
    [is_well_order α r] : is_trichotomous α r :=
  is_strict_total_order'.to_is_trichotomous

protected instance is_well_order.is_trans {α : Type u_1} (r : α → α → Prop) [is_well_order α r] :
    is_trans α r :=
  is_strict_order.to_is_trans

protected instance is_well_order.is_irrefl {α : Type u_1} (r : α → α → Prop) [is_well_order α r] :
    is_irrefl α r :=
  is_strict_order.to_is_irrefl

protected instance is_well_order.is_asymm {α : Type u_1} (r : α → α → Prop) [is_well_order α r] :
    is_asymm α r :=
  Mathlib.is_asymm_of_is_trans_of_is_irrefl

/-- Construct a decidable linear order from a well-founded linear order. -/
def is_well_order.linear_order {α : Type u} (r : α → α → Prop) [is_well_order α r] :
    linear_order α :=
  let _inst : (x y : α) → Decidable (¬r x y) := fun (x y : α) => classical.dec (¬r x y);
  linear_order_of_STO' r

protected instance empty_relation.is_well_order {α : Type u} [subsingleton α] :
    is_well_order α empty_relation :=
  is_well_order.mk (well_founded.intro fun (a : α) => acc.intro a fun (y : α) => false.elim)

protected instance nat.lt.is_well_order : is_well_order ℕ Less := is_well_order.mk nat.lt_wf

protected instance sum.lex.is_well_order {α : Type u} {β : Type v} {r : α → α → Prop}
    {s : β → β → Prop} [is_well_order α r] [is_well_order β s] :
    is_well_order (α ⊕ β) (sum.lex r s) :=
  is_well_order.mk (sum.lex_wf is_well_order.wf is_well_order.wf)

protected instance prod.lex.is_well_order {α : Type u} {β : Type v} {r : α → α → Prop}
    {s : β → β → Prop} [is_well_order α r] [is_well_order β s] :
    is_well_order (α × β) (prod.lex r s) :=
  is_well_order.mk (prod.lex_wf is_well_order.wf is_well_order.wf)

/-- An unbounded or cofinal set -/
/-- A bounded or final set -/
def unbounded {α : Type u} (r : α → α → Prop) (s : set α) :=
  ∀ (a : α), ∃ (b : α), ∃ (H : b ∈ s), ¬r b a

def bounded {α : Type u} (r : α → α → Prop) (s : set α) := ∃ (a : α), ∀ (b : α), b ∈ s → r b a

@[simp] theorem not_bounded_iff {α : Type u} {r : α → α → Prop} (s : set α) :
    ¬bounded r s ↔ unbounded r s :=
  sorry

@[simp] theorem not_unbounded_iff {α : Type u} {r : α → α → Prop} (s : set α) :
    ¬unbounded r s ↔ bounded r s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (¬unbounded r s ↔ bounded r s)) (propext not_iff_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬bounded r s ↔ unbounded r s)) (propext (not_bounded_iff s))))
      (iff.refl (unbounded r s)))

end Mathlib


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/
import data.finset.basic

/-!
# Constructions involving sets of sets.

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

## Finite Intersections

We define a structure `has_finite_inter` which asserts that a set `S` of subsets of `α` is
closed under finite intersections.

We define `finite_inter_closure` which, given a set `S` of subsets of `α`, is the smallest
set of subsets of `α` which is closed under finite intersections.

`finite_inter_closure S` is endowed with a term of type `has_finite_inter` using
`finite_inter_closure_has_finite_inter`.

-/

variables {α : Type*} (S : set (set α))

/-- A structure encapsulating the fact that a set of sets is closed under finite intersection. -/
structure has_finite_inter : Prop :=
(univ_mem : set.univ ∈ S)
(inter_mem : ∀ ⦃s⦄, s ∈ S → ∀ ⦃t⦄, t ∈ S → s ∩ t ∈ S)

namespace has_finite_inter

/-- The smallest set of sets containing `S` which is closed under finite intersections. -/
inductive finite_inter_closure : set (set α)
| basic {s} : s ∈ S → finite_inter_closure s
| univ : finite_inter_closure set.univ
| inter {s t} : finite_inter_closure s → finite_inter_closure t → finite_inter_closure (s ∩ t)

lemma finite_inter_closure_has_finite_inter : has_finite_inter (finite_inter_closure S) :=
{ univ_mem := finite_inter_closure.univ,
  inter_mem := λ _ h _, finite_inter_closure.inter h }

variable {S}
lemma finite_inter_mem (cond : has_finite_inter S) (F : finset (set α)) :
  ↑F ⊆ S → ⋂₀ (↑F : set (set α)) ∈ S :=
begin
  classical,
  refine finset.induction_on F (λ _, _) _,
  { simp [cond.univ_mem] },
  { intros a s h1 h2 h3,
    suffices : a ∩ ⋂₀ ↑s ∈ S, by simpa,
    exact cond.inter_mem (h3 (finset.mem_insert_self a s))
                         (h2 $ λ x hx, h3 $ finset.mem_insert_of_mem hx) }
end

lemma finite_inter_closure_insert {A : set α} (cond : has_finite_inter S)
  (P ∈ finite_inter_closure (insert A S)) : P ∈ S ∨ ∃ Q ∈ S, P = A ∩ Q :=
begin
  induction H with S h T1 T2 _ _ h1 h2,
  { cases h,
    { exact or.inr ⟨set.univ, cond.univ_mem, by simpa⟩ },
    { exact or.inl h } },
  { exact or.inl cond.univ_mem },
  { rcases h1 with (h | ⟨Q, hQ, rfl⟩); rcases h2 with (i | ⟨R, hR, rfl⟩),
    { exact or.inl (cond.inter_mem h i) },
    { exact or.inr ⟨T1 ∩ R, cond.inter_mem h hR,
        by simp only [ ←set.inter_assoc, set.inter_comm _ A]⟩ },
    { exact or.inr ⟨Q ∩ T2, cond.inter_mem hQ i, by simp only [set.inter_assoc]⟩ },
    { exact or.inr ⟨Q ∩ R, cond.inter_mem hQ hR,
        by { ext x, split; simp { contextual := tt} }⟩ } }
end

end has_finite_inter