/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.subtype
import Mathlib.data.prod
import Mathlib.PostPort

universes u_1 u_2 u v w l

namespace Mathlib

/-!
# Basic definitions about `≤` and `<`

## Definitions

### Predicates on functions

- `monotone f`: a function between two types equipped with `≤` is monotone
  if `a ≤ b` implies `f a ≤ f b`.
- `strict_mono f` : a function between two types equipped with `<` is strictly monotone
  if `a < b` implies `f a < f b`.
- `order_dual α` : a type tag reversing the meaning of all inequalities.

### Transfering orders

- `order.preimage`, `preorder.lift`: transfer a (pre)order on `β` to an order on `α`
  using a function `f : α → β`.
- `partial_order.lift`, `linear_order.lift`: transfer a partial (resp., linear) order on `β` to a
  partial (resp., linear) order on `α` using an injective function `f`.

### Extra classes

- `no_top_order`, `no_bot_order`: an order without a maximal/minimal element.
- `densely_ordered`: an order with no gaps, i.e. for any two elements `a<b` there exists
  `c`, `a<c<b`.

## Main theorems

- `monotone_of_monotone_nat`: if `f : ℕ → α` and `f n ≤ f (n + 1)` for all `n`, then
  `f` is monotone;
- `strict_mono.nat`: if `f : ℕ → α` and `f n < f (n + 1)` for all `n`, then f is strictly monotone.

## TODO

- expand module docs
- automatic construction of dual definitions / theorems

## See also
- `algebra.order` for basic lemmas about orders, and projection notation for orders

## Tags

preorder, order, partial order, linear order, monotone, strictly monotone
-/

theorem preorder.ext {α : Type u_1} {A : preorder α} {B : preorder α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B := sorry

theorem partial_order.ext {α : Type u_1} {A : partial_order α} {B : partial_order α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B := sorry

theorem linear_order.ext {α : Type u_1} {A : linear_order α} {B : linear_order α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B := sorry

/-- Given a relation `R` on `β` and a function `f : α → β`,
  the preimage relation on `α` is defined by `x ≤ y ↔ f x ≤ f y`.
  It is the unique relation on `α` making `f` a `rel_embedding`
  (assuming `f` is injective). -/
@[simp] def order.preimage {α : Sort u_1} {β : Sort u_2} (f : α → β) (s : β → β → Prop) (x : α) (y : α) :=
  s (f x) (f y)

infixl:80 " ⁻¹'o " => Mathlib.order.preimage

/-- The preimage of a decidable order is decidable. -/
protected instance order.preimage.decidable {α : Sort u_1} {β : Sort u_2} (f : α → β) (s : β → β → Prop) [H : DecidableRel s] : DecidableRel (f ⁻¹'o s) :=
  fun (x y : α) => H (f x) (f y)

/-- A function between preorders is monotone if
  `a ≤ b` implies `f a ≤ f b`. -/
def monotone {α : Type u} {β : Type v} [preorder α] [preorder β] (f : α → β) :=
  ∀ {a b : α}, a ≤ b → f a ≤ f b

theorem monotone_id {α : Type u} [preorder α] : monotone id :=
  fun (x y : α) (h : x ≤ y) => h

theorem monotone_const {α : Type u} {β : Type v} [preorder α] [preorder β] {b : β} : monotone fun (a : α) => b :=
  fun (x y : α) (h : x ≤ y) => le_refl b

protected theorem monotone.comp {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β} (m_g : monotone g) (m_f : monotone f) : monotone (g ∘ f) :=
  fun (a b : α) (h : a ≤ b) => m_g (m_f h)

protected theorem monotone.iterate {α : Type u} [preorder α] {f : α → α} (hf : monotone f) (n : ℕ) : monotone (nat.iterate f n) :=
  nat.rec_on n monotone_id fun (n : ℕ) (ihn : monotone (nat.iterate f n)) => monotone.comp ihn hf

theorem monotone_of_monotone_nat {α : Type u} [preorder α] {f : ℕ → α} (hf : ∀ (n : ℕ), f n ≤ f (n + 1)) : monotone f := sorry

theorem monotone.reflect_lt {α : Type u_1} {β : Type u_2} [linear_order α] [preorder β] {f : α → β} (hf : monotone f) {x : α} {x' : α} (h : f x < f x') : x < x' :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x < x')) (Eq.symm (propext not_le)))) (id fun (h' : x' ≤ x) => not_le_of_lt h (hf h'))

/-- If `f` is a monotone function from `ℕ` to a preorder such that `y` lies between `f x` and
  `f (x + 1)`, then `y` doesn't lie in the range of `f`. -/
theorem monotone.ne_of_lt_of_lt_nat {α : Type u_1} [preorder α] {f : ℕ → α} (hf : monotone f) (x : ℕ) (x' : ℕ) {y : α} (h1 : f x < y) (h2 : y < f (x + 1)) : f x' ≠ y := sorry

/-- If `f` is a monotone function from `ℤ` to a preorder such that `y` lies between `f x` and
  `f (x + 1)`, then `y` doesn't lie in the range of `f`. -/
theorem monotone.ne_of_lt_of_lt_int {α : Type u_1} [preorder α] {f : ℤ → α} (hf : monotone f) (x : ℤ) (x' : ℤ) {y : α} (h1 : f x < y) (h2 : y < f (x + 1)) : f x' ≠ y := sorry

/-- A function `f` is strictly monotone if `a < b` implies `f a < f b`. -/
def strict_mono {α : Type u} {β : Type v} [HasLess α] [HasLess β] (f : α → β) :=
  ∀ {a b : α}, a < b → f a < f b

theorem strict_mono_id {α : Type u} [HasLess α] : strict_mono id :=
  fun (a b : α) => id

/-- A function `f` is strictly monotone increasing on `t` if `x < y` for `x,y ∈ t` implies
`f x < f y`. -/
def strict_mono_incr_on {α : Type u} {β : Type v} [HasLess α] [HasLess β] (f : α → β) (t : set α) :=
  ∀ {x : α}, x ∈ t → ∀ {y : α}, y ∈ t → x < y → f x < f y

/-- A function `f` is strictly monotone decreasing on `t` if `x < y` for `x,y ∈ t` implies
`f y < f x`. -/
def strict_mono_decr_on {α : Type u} {β : Type v} [HasLess α] [HasLess β] (f : α → β) (t : set α) :=
  ∀ {x : α}, x ∈ t → ∀ {y : α}, y ∈ t → x < y → f y < f x

/-- Type tag for a set with dual order: `≤` means `≥` and `<` means `>`. -/
def order_dual (α : Type u_1) :=
  α

namespace order_dual

protected instance nonempty (α : Type u_1) [h : Nonempty α] : Nonempty (order_dual α) :=
  h

protected instance subsingleton (α : Type u_1) [h : subsingleton α] : subsingleton (order_dual α) :=
  h

protected instance has_le (α : Type u_1) [HasLessEq α] : HasLessEq (order_dual α) :=
  { LessEq := fun (x y : α) => y ≤ x }

protected instance has_lt (α : Type u_1) [HasLess α] : HasLess (order_dual α) :=
  { Less := fun (x y : α) => y < x }

-- `dual_le` and `dual_lt` should not be simp lemmas:

-- they cause a loop since `α` and `order_dual α` are definitionally equal

theorem dual_le {α : Type u} [HasLessEq α] {a : α} {b : α} : a ≤ b ↔ b ≤ a :=
  iff.rfl

theorem dual_lt {α : Type u} [HasLess α] {a : α} {b : α} : a < b ↔ b < a :=
  iff.rfl

theorem dual_compares {α : Type u} [HasLess α] {a : α} {b : α} {o : ordering} : ordering.compares o a b ↔ ordering.compares o b a :=
  ordering.cases_on o iff.rfl eq_comm iff.rfl

protected instance preorder (α : Type u_1) [preorder α] : preorder (order_dual α) :=
  preorder.mk LessEq Less sorry sorry

protected instance partial_order (α : Type u_1) [partial_order α] : partial_order (order_dual α) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

protected instance linear_order (α : Type u_1) [linear_order α] : linear_order (order_dual α) :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry
    ((fun (this : DecidableRel fun (a b : α) => b ≤ a) => this) fun (a b : α) => has_le.le.decidable b a)
    Mathlib.decidable_eq_of_decidable_le
    ((fun (this : DecidableRel fun (a b : α) => b < a) => this) fun (a b : α) => has_lt.lt.decidable b a)

protected instance inhabited {α : Type u} [Inhabited α] : Inhabited (order_dual α) :=
  id

theorem preorder.dual_dual (α : Type u_1) [H : preorder α] : order_dual.preorder (order_dual α) = H :=
  preorder.ext fun (_x _x_1 : order_dual (order_dual α)) => iff.rfl

theorem partial_order.dual_dual (α : Type u_1) [H : partial_order α] : order_dual.partial_order (order_dual α) = H :=
  partial_order.ext fun (_x _x_1 : order_dual (order_dual α)) => iff.rfl

theorem linear_order.dual_dual (α : Type u_1) [H : linear_order α] : order_dual.linear_order (order_dual α) = H :=
  linear_order.ext fun (_x _x_1 : order_dual (order_dual α)) => iff.rfl

theorem cmp_le_flip {α : Type u_1} [HasLessEq α] [DecidableRel LessEq] (x : α) (y : α) : cmp_le x y = cmp_le y x :=
  rfl

end order_dual

namespace strict_mono_incr_on

protected theorem dual {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α} (H : strict_mono_incr_on f s) : strict_mono_incr_on f s :=
  fun (x : order_dual α) (hx : x ∈ s) (y : order_dual α) (hy : y ∈ s) => H hy hx

protected theorem dual_right {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α} (H : strict_mono_incr_on f s) : strict_mono_decr_on f s :=
  H

theorem le_iff_le {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α} {x : α} {y : α} (H : strict_mono_incr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x ≤ f y ↔ x ≤ y := sorry

theorem lt_iff_lt {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α} {x : α} {y : α} (H : strict_mono_incr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x < f y ↔ x < y := sorry

protected theorem compares {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α} {x : α} {y : α} (H : strict_mono_incr_on f s) (hx : x ∈ s) (hy : y ∈ s) {o : ordering} : ordering.compares o (f x) (f y) ↔ ordering.compares o x y := sorry

end strict_mono_incr_on

namespace strict_mono_decr_on

protected theorem dual {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α} (H : strict_mono_decr_on f s) : strict_mono_decr_on f s :=
  fun (x : order_dual α) (hx : x ∈ s) (y : order_dual α) (hy : y ∈ s) => H hy hx

protected theorem dual_right {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α} (H : strict_mono_decr_on f s) : strict_mono_incr_on f s :=
  H

theorem le_iff_le {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α} {x : α} {y : α} (H : strict_mono_decr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x ≤ f y ↔ y ≤ x :=
  strict_mono_incr_on.le_iff_le (strict_mono_decr_on.dual_right H) hy hx

theorem lt_iff_lt {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α} {x : α} {y : α} (H : strict_mono_decr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x < f y ↔ y < x :=
  strict_mono_incr_on.lt_iff_lt (strict_mono_decr_on.dual_right H) hy hx

protected theorem compares {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α} {x : α} {y : α} (H : strict_mono_decr_on f s) (hx : x ∈ s) (hy : y ∈ s) {o : ordering} : ordering.compares o (f x) (f y) ↔ ordering.compares o y x :=
  iff.trans order_dual.dual_compares (strict_mono_incr_on.compares (strict_mono_decr_on.dual_right H) hy hx)

end strict_mono_decr_on

namespace strict_mono

protected theorem strict_mono_incr_on {α : Type u} {β : Type v} [HasLess α] [HasLess β] {f : α → β} (hf : strict_mono f) (s : set α) : strict_mono_incr_on f s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) (hxy : x < y) => hf hxy

theorem comp {α : Type u} {β : Type v} {γ : Type w} [HasLess α] [HasLess β] [HasLess γ] {g : β → γ} {f : α → β} (hg : strict_mono g) (hf : strict_mono f) : strict_mono (g ∘ f) :=
  fun (a b : α) (h : a < b) => hg (hf h)

protected theorem iterate {α : Type u} [HasLess α] {f : α → α} (hf : strict_mono f) (n : ℕ) : strict_mono (nat.iterate f n) :=
  nat.rec_on n strict_mono_id fun (n : ℕ) (ihn : strict_mono (nat.iterate f n)) => comp ihn hf

theorem id_le {φ : ℕ → ℕ} (h : strict_mono φ) (n : ℕ) : n ≤ φ n :=
  nat.rec_on n (nat.zero_le (φ 0))
    fun (n : ℕ) (hn : n ≤ φ n) => nat.succ_le_of_lt (lt_of_le_of_lt hn (h (nat.lt_succ_self n)))

protected theorem ite' {α : Type u} {β : Type v} [preorder α] [HasLess β] {f : α → β} {g : α → β} (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop} [decidable_pred p] (hp : ∀ {x y : α}, x < y → p y → p x) (hfg : ∀ {x y : α}, p x → ¬p y → x < y → f x < g y) : strict_mono fun (x : α) => ite (p x) (f x) (g x) := sorry

protected theorem ite {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {g : α → β} (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop} [decidable_pred p] (hp : ∀ {x y : α}, x < y → p y → p x) (hfg : ∀ (x : α), f x ≤ g x) : strict_mono fun (x : α) => ite (p x) (f x) (g x) :=
  strict_mono.ite' hf hg hp fun (x y : α) (hx : p x) (hy : ¬p y) (h : x < y) => has_lt.lt.trans_le (hf h) (hfg y)

theorem lt_iff_lt {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} (H : strict_mono f) {a : α} {b : α} : f a < f b ↔ a < b :=
  strict_mono_incr_on.lt_iff_lt (strict_mono.strict_mono_incr_on H set.univ) trivial trivial

protected theorem compares {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} (H : strict_mono f) {a : α} {b : α} {o : ordering} : ordering.compares o (f a) (f b) ↔ ordering.compares o a b :=
  strict_mono_incr_on.compares (strict_mono.strict_mono_incr_on H set.univ) trivial trivial

theorem injective {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} (H : strict_mono f) : function.injective f :=
  fun (x y : α) (h : f x = f y) =>
    (fun (this : ordering.compares ordering.eq x y) => this) (iff.mp (strict_mono.compares H) h)

theorem le_iff_le {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} (H : strict_mono f) {a : α} {b : α} : f a ≤ f b ↔ a ≤ b :=
  strict_mono_incr_on.le_iff_le (strict_mono.strict_mono_incr_on H set.univ) trivial trivial

theorem top_preimage_top {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} (H : strict_mono f) {a : α} (h_top : ∀ (p : β), p ≤ f a) (x : α) : x ≤ a :=
  iff.mp (le_iff_le H) (h_top (f x))

theorem bot_preimage_bot {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} (H : strict_mono f) {a : α} (h_bot : ∀ (p : β), f a ≤ p) (x : α) : a ≤ x :=
  iff.mp (le_iff_le H) (h_bot (f x))

protected theorem nat {β : Type u_1} [preorder β] {f : ℕ → β} (h : ∀ (n : ℕ), f n < f (n + 1)) : strict_mono f := sorry

-- `preorder α` isn't strong enough: if the preorder on α is an equivalence relation,

-- then `strict_mono f` is vacuously true.

theorem monotone {α : Type u} {β : Type v} [partial_order α] [preorder β] {f : α → β} (H : strict_mono f) : monotone f :=
  fun (a b : α) (h : a ≤ b) =>
    Or._oldrec (le_of_lt ∘ H) (fun (h_1 : a = b) => Eq._oldrec (fun (h : a ≤ a) => le_refl (f a)) h_1 h)
      (lt_or_eq_of_le h)

end strict_mono

theorem injective_of_lt_imp_ne {α : Type u} {β : Type v} [linear_order α] {f : α → β} (h : ∀ (x y : α), x < y → f x ≠ f y) : function.injective f := sorry

theorem strict_mono_of_monotone_of_injective {α : Type u} {β : Type v} [partial_order α] [partial_order β] {f : α → β} (h₁ : monotone f) (h₂ : function.injective f) : strict_mono f := sorry

theorem monotone.strict_mono_iff_injective {α : Type u} {β : Type v} [linear_order α] [partial_order β] {f : α → β} (h : monotone f) : strict_mono f ↔ function.injective f :=
  { mp := fun (h : strict_mono f) => strict_mono.injective h, mpr := strict_mono_of_monotone_of_injective h }

theorem strict_mono_of_le_iff_le {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} (h : ∀ (x y : α), x ≤ y ↔ f x ≤ f y) : strict_mono f := sorry

/-! ### Order instances on the function space -/

protected instance pi.preorder {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] : preorder ((i : ι) → α i) :=
  preorder.mk (fun (x y : (i : ι) → α i) => ∀ (i : ι), x i ≤ y i)
    (fun (a b : (i : ι) → α i) => (∀ (i : ι), a i ≤ b i) ∧ ¬∀ (i : ι), b i ≤ a i) sorry sorry

theorem pi.le_def {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] {x : (i : ι) → α i} {y : (i : ι) → α i} : x ≤ y ↔ ∀ (i : ι), x i ≤ y i :=
  iff.rfl

theorem le_update_iff {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] [DecidableEq ι] {x : (i : ι) → α i} {y : (i : ι) → α i} {i : ι} {a : α i} : x ≤ function.update y i a ↔ x i ≤ a ∧ ∀ (j : ι), j ≠ i → x j ≤ y j :=
  function.forall_update_iff y fun (j : ι) (z : α j) => x j ≤ z

theorem update_le_iff {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] [DecidableEq ι] {x : (i : ι) → α i} {y : (i : ι) → α i} {i : ι} {a : α i} : function.update x i a ≤ y ↔ a ≤ y i ∧ ∀ (j : ι), j ≠ i → x j ≤ y j :=
  function.forall_update_iff x fun (j : ι) (z : α j) => z ≤ y j

protected instance pi.partial_order {ι : Type u} {α : ι → Type v} [(i : ι) → partial_order (α i)] : partial_order ((i : ι) → α i) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

theorem comp_le_comp_left_of_monotone {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder β] {f : β → α} {g : γ → β} {h : γ → β} (m_f : monotone f) (le_gh : g ≤ h) : f ∘ g ≤ f ∘ h :=
  fun (x : γ) => m_f (le_gh x)

protected theorem monotone.order_dual {α : Type u} {γ : Type w} [preorder α] [preorder γ] {f : α → γ} (hf : monotone f) : monotone f :=
  fun (x y : order_dual α) (hxy : x ≤ y) => hf hxy

theorem monotone_lam {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder γ] {f : α → β → γ} (m : ∀ (b : β), monotone fun (a : α) => f a b) : monotone f :=
  fun (a a' : α) (h : a ≤ a') (b : β) => m b h

theorem monotone_app {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder γ] (f : β → α → γ) (b : β) (m : monotone fun (a : α) (b : β) => f b a) : monotone (f b) :=
  fun (a a' : α) (h : a ≤ a') => m h b

theorem strict_mono.order_dual {α : Type u} {β : Type v} [HasLess α] [HasLess β] {f : α → β} (hf : strict_mono f) : strict_mono f :=
  fun (x y : order_dual α) (hxy : x < y) => hf hxy

/-- Transfer a `preorder` on `β` to a `preorder` on `α` using a function `f : α → β`. -/
def preorder.lift {α : Type u_1} {β : Type u_2} [preorder β] (f : α → β) : preorder α :=
  preorder.mk (fun (x y : α) => f x ≤ f y) (fun (x y : α) => f x < f y) sorry sorry

/-- Transfer a `partial_order` on `β` to a `partial_order` on `α` using an injective
function `f : α → β`. -/
def partial_order.lift {α : Type u_1} {β : Type u_2} [partial_order β] (f : α → β) (inj : function.injective f) : partial_order α :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

/-- Transfer a `linear_order` on `β` to a `linear_order` on `α` using an injective
function `f : α → β`. -/
def linear_order.lift {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (inj : function.injective f) : linear_order α :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry (fun (x y : α) => infer_instance)
    (fun (x y : α) => decidable_of_iff (f x = f y) (function.injective.eq_iff inj)) fun (x y : α) => infer_instance

protected instance subtype.preorder {α : Type u_1} [preorder α] (p : α → Prop) : preorder (Subtype p) :=
  preorder.lift subtype.val

@[simp] theorem subtype.mk_le_mk {α : Type u_1} [preorder α] {p : α → Prop} {x : α} {y : α} {hx : p x} {hy : p y} : { val := x, property := hx } ≤ { val := y, property := hy } ↔ x ≤ y :=
  iff.rfl

@[simp] theorem subtype.mk_lt_mk {α : Type u_1} [preorder α] {p : α → Prop} {x : α} {y : α} {hx : p x} {hy : p y} : { val := x, property := hx } < { val := y, property := hy } ↔ x < y :=
  iff.rfl

@[simp] theorem subtype.coe_le_coe {α : Type u_1} [preorder α] {p : α → Prop} {x : Subtype p} {y : Subtype p} : ↑x ≤ ↑y ↔ x ≤ y :=
  iff.rfl

@[simp] theorem subtype.coe_lt_coe {α : Type u_1} [preorder α] {p : α → Prop} {x : Subtype p} {y : Subtype p} : ↑x < ↑y ↔ x < y :=
  iff.rfl

protected instance subtype.partial_order {α : Type u_1} [partial_order α] (p : α → Prop) : partial_order (Subtype p) :=
  partial_order.lift subtype.val subtype.val_injective

protected instance subtype.linear_order {α : Type u_1} [linear_order α] (p : α → Prop) : linear_order (Subtype p) :=
  linear_order.lift subtype.val subtype.val_injective

theorem subtype.mono_coe {α : Type u} [preorder α] (t : set α) : monotone coe :=
  fun (x y : Subtype t) => id

theorem subtype.strict_mono_coe {α : Type u} [preorder α] (t : set α) : strict_mono coe :=
  fun (x y : Subtype t) => id

protected instance prod.has_le (α : Type u) (β : Type v) [HasLessEq α] [HasLessEq β] : HasLessEq (α × β) :=
  { LessEq := fun (p q : α × β) => prod.fst p ≤ prod.fst q ∧ prod.snd p ≤ prod.snd q }

protected instance prod.preorder (α : Type u) (β : Type v) [preorder α] [preorder β] : preorder (α × β) :=
  preorder.mk LessEq (fun (a b : α × β) => a ≤ b ∧ ¬b ≤ a) sorry sorry

/-- The pointwise partial order on a product.
    (The lexicographic ordering is defined in order/lexicographic.lean, and the instances are
    available via the type synonym `lex α β = α × β`.) -/
protected instance prod.partial_order (α : Type u) (β : Type v) [partial_order α] [partial_order β] : partial_order (α × β) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

/-!
### Additional order classes
-/

/-- order without a top element; somtimes called cofinal -/
class no_top_order (α : Type u) [preorder α]
where
  no_top : ∀ (a : α), ∃ (a' : α), a < a'

theorem no_top {α : Type u} [preorder α] [no_top_order α] (a : α) : ∃ (a' : α), a < a' :=
  no_top_order.no_top

protected instance nonempty_gt {α : Type u} [preorder α] [no_top_order α] (a : α) : Nonempty (Subtype fun (x : α) => a < x) :=
  iff.mpr nonempty_subtype (no_top a)

/-- order without a bottom element; somtimes called coinitial or dense -/
class no_bot_order (α : Type u) [preorder α]
where
  no_bot : ∀ (a : α), ∃ (a' : α), a' < a

theorem no_bot {α : Type u} [preorder α] [no_bot_order α] (a : α) : ∃ (a' : α), a' < a :=
  no_bot_order.no_bot

protected instance order_dual.no_top_order (α : Type u) [preorder α] [no_bot_order α] : no_top_order (order_dual α) :=
  no_top_order.mk fun (a : order_dual α) => no_bot a

protected instance order_dual.no_bot_order (α : Type u) [preorder α] [no_top_order α] : no_bot_order (order_dual α) :=
  no_bot_order.mk fun (a : order_dual α) => no_top a

protected instance nonempty_lt {α : Type u} [preorder α] [no_bot_order α] (a : α) : Nonempty (Subtype fun (x : α) => x < a) :=
  iff.mpr nonempty_subtype (no_bot a)

/-- An order is dense if there is an element between any pair of distinct elements. -/
class densely_ordered (α : Type u) [preorder α]
where
  dense : ∀ (a₁ a₂ : α), a₁ < a₂ → ∃ (a : α), a₁ < a ∧ a < a₂

theorem exists_between {α : Type u} [preorder α] [densely_ordered α] {a₁ : α} {a₂ : α} : a₁ < a₂ → ∃ (a : α), a₁ < a ∧ a < a₂ :=
  densely_ordered.dense

protected instance order_dual.densely_ordered (α : Type u) [preorder α] [densely_ordered α] : densely_ordered (order_dual α) :=
  densely_ordered.mk fun (a₁ a₂ : order_dual α) (ha : a₁ < a₂) => Exists.imp (fun (a : α) => and.symm) (exists_between ha)

theorem le_of_forall_le_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α} {a₂ : α} (h : ∀ (a₃ : α), a₃ > a₂ → a₁ ≤ a₃) : a₁ ≤ a₂ := sorry

theorem eq_of_le_of_forall_le_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α} {a₂ : α} (h₁ : a₂ ≤ a₁) (h₂ : ∀ (a₃ : α), a₃ > a₂ → a₁ ≤ a₃) : a₁ = a₂ :=
  le_antisymm (le_of_forall_le_of_dense h₂) h₁

theorem le_of_forall_ge_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α} {a₂ : α} (h : ∀ (a₃ : α), a₃ < a₁ → a₃ ≤ a₂) : a₁ ≤ a₂ := sorry

theorem eq_of_le_of_forall_ge_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α} {a₂ : α} (h₁ : a₂ ≤ a₁) (h₂ : ∀ (a₃ : α), a₃ < a₁ → a₃ ≤ a₂) : a₁ = a₂ :=
  le_antisymm (le_of_forall_ge_of_dense h₂) h₁

theorem dense_or_discrete {α : Type u} [linear_order α] (a₁ : α) (a₂ : α) : (∃ (a : α), a₁ < a ∧ a < a₂) ∨ (∀ (a : α), a > a₁ → a₂ ≤ a) ∧ ∀ (a : α), a < a₂ → a ≤ a₁ := sorry

/-- Type synonym to create an instance of `linear_order` from a
`partial_order` and `[is_total α (≤)]` -/
def as_linear_order (α : Type u) :=
  α

protected instance as_linear_order.inhabited {α : Type u_1} [Inhabited α] : Inhabited (as_linear_order α) :=
  { default := Inhabited.default }

protected instance as_linear_order.linear_order {α : Type u_1} [partial_order α] [is_total α LessEq] : linear_order (as_linear_order α) :=
  linear_order.mk partial_order.le partial_order.lt partial_order.le_refl partial_order.le_trans partial_order.le_antisymm
    sorry (classical.dec_rel LessEq) Mathlib.decidable_eq_of_decidable_le Mathlib.decidable_lt_of_decidable_le


import o_minimal.Def

/-
Definable sheaves.

Here we provide just enough definitions, instances and lemmas
to set up the tactic environment. The eventual frontend for all this
is intended to consist of `definable` and the `definable_sheaf` class,
but there is still plenty of construction to do.
-/

namespace o_minimal

universe u

variables {R : Type u} (S : struc R)

class definable_sheaf (X : Type*) :=
(definable : Π {K : Def S}, (K → X) → Prop)
(definable_precomp : ∀ {L K : Def S} (φ : L ⟶ K) (f : K → X),
  definable f → definable (f ∘ φ))
(definable_cover : ∀ {K : Def S} (f : K → X) (𝓛 : Def.cover K),
  (∀ i, definable (f ∘ 𝓛.map i)) → definable f)

namespace definable_sheaf

variables {S}

def rep {W : Type*} [has_coordinates R W] [is_definable S W] :
  definable_sheaf S W :=
{ definable := λ K f, def_fun S f,
  definable_precomp := λ L K φ f hf, hf.comp φ.is_definable,
  definable_cover := λ K f 𝓛 h, Def.subcanonical 𝓛 f h }

instance Def.definable_sheaf {X : Def S} : definable_sheaf S X :=
definable_sheaf.rep

variables {X Y : Type*} [definable_sheaf S X] [definable_sheaf S Y]

instance prod.definable_sheaf : definable_sheaf S (X × Y) :=
{ definable := λ K f,
    definable_sheaf.definable (prod.fst ∘ f) ∧
    definable_sheaf.definable (prod.snd ∘ f),
  definable_precomp := λ L K φ _ h,
    ⟨definable_sheaf.definable_precomp φ _ h.1,
     definable_sheaf.definable_precomp φ _ h.2⟩,
  definable_cover := λ K f 𝓛 h,
    ⟨definable_sheaf.definable_cover _ 𝓛 (λ i, (h i).1),
     definable_sheaf.definable_cover _ 𝓛 (λ i, (h i).2)⟩ }

instance fun.definable_sheaf : definable_sheaf S (X → Y) :=
{ definable := λ K f,
    ∀ (L : Def S) (g : L → K × X) (h : definable_sheaf.definable g),
      definable_sheaf.definable (function.uncurry f ∘ g),
  definable_precomp := λ L K φ f hf M g hg,
    hf M (λ m, (φ (g m).1, (g m).2))
      ⟨definable_sheaf.definable_precomp ⟨λ m, (g m).1, hg.1⟩ φ φ.is_definable, hg.2⟩,
  definable_cover := λ K f 𝓛 h K' g hg, begin
    let g₁ : K' ⟶ K := ⟨λ k', (g k').1, hg.1⟩,
    let 𝓛' := 𝓛.pullback g₁,
    apply definable_sheaf.definable_cover _ 𝓛',
    intro i,
    specialize h i (𝓛'.obj i)
      (λ l', (Def.pullback.π₂ g₁ _ l', (g (𝓛'.map i l')).2))
      ⟨(Def.pullback.π₂ g₁ _).is_definable, definable_sheaf.definable_precomp _ _ hg.2⟩,
    dsimp only [function.uncurry, function.comp] at ⊢ h,
    convert h,
    ext x,
    congr,
    exact x.property.snd.snd,
  end }

/-- Intended to be an implementation detail of the tactic mode.
In "user code", use `definable` instead. -/
structure sect (Γ : Def S) (X : Type*) [definable_sheaf S X] :=
(to_fun : Γ → X)
(definable : definable_sheaf.definable to_fun)

def sect.precomp {Γ' Γ : Def S} (σ : sect Γ X) (φ : Γ' ⟶ Γ) : sect Γ' X :=
{ to_fun := σ.to_fun ∘ φ.to_fun,
  definable := definable_sheaf.definable_precomp φ σ.to_fun σ.definable }

lemma definable_fun_iff {Γ : Def S} {f : Γ → X → Y} :
  definable_sheaf.definable f ↔
  ∀ (Γ' : Def S) (π : Hom Γ' Γ) (σ : sect Γ' X),
    definable_sheaf.definable (λ i', f (π.to_fun i') (σ.to_fun i')) :=
⟨λ H Γ' π σ, H Γ' (λ γ', (π.to_fun γ', σ.to_fun γ')) ⟨π.is_definable, σ.definable⟩,
 λ H M g hg, H M ⟨_, hg.1⟩ ⟨_, hg.2⟩⟩

/- The weird binder types are because this lemma is intended to be applied
by a special `defin` tactic. -/
lemma definable_app {Γ : Def S}
  (f : Γ → X → Y) {hf : definable_sheaf.definable f}
  (x : Γ → X) {hx : definable_sheaf.definable x} :
  definable_sheaf.definable (λ i, f i (x i)) :=
hf Γ (λ γ, (γ, x γ)) ⟨def_fun.id, hx⟩

end definable_sheaf

structure definable {X : Type*} [definable_sheaf S X] (x : X) : Prop :=
(definable : ∀ (K : Def S), definable_sheaf.definable (λ (i : K), x))

end o_minimal


/- Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Douglas, Floris van Doorn
-/

import order.zorn algebra.module

universe variable u

namespace tactic
namespace interactive
setup_tactic_parser
open tactic.interactive
meta def dunfold_coes (loc : parse location) : tactic unit :=
dunfold [
  ``coe, ``coe_t, ``has_coe_t.coe, ``coe_b,``has_coe.coe,
  ``lift, ``has_lift.lift, ``lift_t, ``has_lift_t.lift,
  ``coe_fn, ``has_coe_to_fun.coe, ``coe_sort, ``has_coe_to_sort.coe,
  ``coe_base_aux, ``has_coe_t_aux.coe] loc
  -- note: this adds extra arguments
  -- todo: we need to repeat it, it is not idempotent.
end interactive
end tactic

@[simp] lemma inv_smul_smul {K V : Type*} [field K] [add_comm_group V] [vector_space K V]
  {k : K} {x : V} (h : k ≠ 0) : k⁻¹ • k • x = x :=
by rw [←mul_smul, inv_mul_cancel h, one_smul]

@[simp] lemma smul_inv_smul {K V : Type*} [field K] [add_comm_group V] [vector_space K V]
  {k : K} {x : V} (h : k ≠ 0) : k • k⁻¹ • x = x :=
by rw [←mul_smul, mul_inv_cancel h, one_smul]

lemma subtype.le_def {α : Type*} [partial_order α] {P : α → Prop} {x y : α}
  {hx : P x} {hy : P y} : (⟨x, hx⟩ : subtype P) ≤ ⟨y, hy⟩ ↔ x ≤ y :=
iff.refl _

lemma subtype.prop {α} {p : α → Prop} (x : subtype p) : p x := x.2

namespace zorn

/- A version of Zorn's lemma for partial orders where we only have to find an upper bound for nonempty chains -/
theorem zorn_partial_order_nonempty {α : Type u} [partial_order α] [nonempty α]
  (h : ∀c:set α, chain (≤) c → c.nonempty → ∃ub, ∀a∈c, a ≤ ub) : ∃m:α, ∀a, m ≤ a → a = m :=
begin
  apply zorn_partial_order,
  intros c hc, classical,
  cases c.eq_empty_or_nonempty with h2c h2c,
  { have := _inst_2, cases this with x, use x, intro y, rw h2c, rintro ⟨⟩ },
  { exact h c hc h2c },
end

end zorn

section lattice
variables {α : Type*} [semilattice_sup_top α]

/-- Two elements of a lattice are covering if their sup is the top element. -/
def covering (a b : α) : Prop := ⊤ ≤ a ⊔ b

theorem covering.eq_top {a b : α} (h : covering a b) : a ⊔ b = ⊤ :=
eq_top_iff.2 h

theorem covering_iff {a b : α} : covering a b ↔ a ⊔ b = ⊤ :=
eq_top_iff.symm

theorem covering.comm {a b : α} : covering a b ↔ covering b a :=
by rw [covering, covering, sup_comm]

theorem covering.symm {a b : α} : covering a b → covering b a :=
covering.comm.1

@[simp] theorem covering_top_left {a : α} : covering ⊤ a := covering_iff.2 top_sup_eq
@[simp] theorem covering_top_right {a : α} : covering a ⊤ := covering_iff.2 sup_top_eq

theorem covering.mono {a b c d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) (h : covering a c) : covering b d :=
le_trans h (sup_le_sup h₁ h₂)

theorem covering.mono_left {a b c : α} (h : a ≤ b) : covering a c → covering b c :=
covering.mono h (le_refl _)

theorem covering.mono_right {a b c : α} (h : b ≤ c) : covering a b → covering a c :=
covering.mono (le_refl _) h

@[simp] lemma covering_self {a : α} : covering a a ↔ a = ⊤ :=
by simp [covering]

lemma covering.ne {a b : α} (ha : a ≠ ⊤) (hab : covering a b) : a ≠ b :=
by { intro h, rw [←h, covering_self] at hab, exact ha hab }

end lattice


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import category_theory.fin_category
import category_theory.limits.cones
import category_theory.adjunction.basic
import category_theory.category.preorder
import category_theory.category.ulift

/-!
# Filtered categories

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

A category is filtered if every finite diagram admits a cocone.
We give a simple characterisation of this condition as
1. for every pair of objects there exists another object "to the right",
2. for every pair of parallel morphisms there exists a morphism to the right so the compositions
   are equal, and
3. there exists some object.

Filtered colimits are often better behaved than arbitrary colimits.
See `category_theory/limits/types` for some details.

Filtered categories are nice because colimits indexed by filtered categories tend to be
easier to describe than general colimits (and more often preserved by functors).

In this file we show that any functor from a finite category to a filtered category admits a cocone:
* `cocone_nonempty [fin_category J] [is_filtered C] (F : J ⥤ C) : nonempty (cocone F)`
More generally,
for any finite collection of objects and morphisms between them in a filtered category
(even if not closed under composition) there exists some object `Z` receiving maps from all of them,
so that all the triangles (one edge from the finite set, two from morphisms to `Z`) commute.
This formulation is often more useful in practice and is available via `sup_exists`,
which takes a finset of objects, and an indexed family (indexed by source and target)
of finsets of morphisms.

Furthermore, we give special support for two diagram categories: The `bowtie` and the `tulip`.
This is because these shapes show up in the proofs that forgetful functors of algebraic categories
(e.g. `Mon`, `CommRing`, ...) preserve filtered colimits.

All of the above API, except for the `bowtie` and the `tulip`, is also provided for cofiltered
categories.

## See also
In `category_theory.limits.filtered_colimit_commutes_finite_limit` we show that filtered colimits
commute with finite limits.

-/

open function

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes w v v₁ u u₁ u₂

namespace category_theory

variables (C : Type u) [category.{v} C]

/--
A category `is_filtered_or_empty` if
1. for every pair of objects there exists another object "to the right", and
2. for every pair of parallel morphisms there exists a morphism to the right so the compositions
   are equal.
-/
class is_filtered_or_empty : Prop :=
(cocone_objs : ∀ (X Y : C), ∃ Z (f : X ⟶ Z) (g : Y ⟶ Z), true)
(cocone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ Z (h : Y ⟶ Z), f ≫ h = g ≫ h)

/--
A category `is_filtered` if
1. for every pair of objects there exists another object "to the right",
2. for every pair of parallel morphisms there exists a morphism to the right so the compositions
   are equal, and
3. there exists some object.

See <https://stacks.math.columbia.edu/tag/002V>. (They also define a diagram being filtered.)
-/
class is_filtered extends is_filtered_or_empty C : Prop :=
[nonempty : nonempty C]

@[priority 100]
instance is_filtered_or_empty_of_semilattice_sup
  (α : Type u) [semilattice_sup α] : is_filtered_or_empty α :=
{ cocone_objs := λ X Y, ⟨X ⊔ Y, hom_of_le le_sup_left, hom_of_le le_sup_right, trivial⟩,
  cocone_maps := λ X Y f g, ⟨Y, 𝟙 _, (by ext)⟩, }

@[priority 100]
instance is_filtered_of_semilattice_sup_nonempty
  (α : Type u) [semilattice_sup α] [nonempty α] : is_filtered α := {}

@[priority 100]
instance is_filtered_or_empty_of_directed_le (α : Type u) [preorder α] [is_directed α (≤)] :
  is_filtered_or_empty α :=
{ cocone_objs := λ X Y, let ⟨Z, h1, h2⟩ := exists_ge_ge X Y in
    ⟨Z, hom_of_le h1, hom_of_le h2, trivial⟩,
  cocone_maps := λ X Y f g, ⟨Y, 𝟙 _, by simp⟩ }

@[priority 100]
instance is_filtered_of_directed_le_nonempty (α : Type u) [preorder α] [is_directed α (≤)]
  [nonempty α] :
  is_filtered α := {}

-- Sanity checks
example (α : Type u) [semilattice_sup α] [order_bot α] : is_filtered α := by apply_instance
example (α : Type u) [semilattice_sup α] [order_top α] : is_filtered α := by apply_instance

instance : is_filtered (discrete punit) :=
{ cocone_objs := λ X Y, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, ⟨⟨dec_trivial⟩⟩, trivial⟩,
  cocone_maps := λ X Y f g, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, dec_trivial⟩,
  nonempty := ⟨⟨punit.star⟩⟩ }

namespace is_filtered

section allow_empty

variables {C} [is_filtered_or_empty C]

lemma cocone_objs : ∀ (X Y : C), ∃ Z (f : X ⟶ Z) (g : Y ⟶ Z), true :=
is_filtered_or_empty.cocone_objs
lemma cocone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ Z (h : Y ⟶ Z), f ≫ h = g ≫ h :=
is_filtered_or_empty.cocone_maps

/--
`max j j'` is an arbitrary choice of object to the right of both `j` and `j'`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def max (j j' : C) : C :=
(cocone_objs j j').some

/--
`left_to_max j j'` is an arbitrary choice of morphism from `j` to `max j j'`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def left_to_max (j j' : C) : j ⟶ max j j' :=
(cocone_objs j j').some_spec.some

/--
`right_to_max j j'` is an arbitrary choice of morphism from `j'` to `max j j'`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def right_to_max (j j' : C) : j' ⟶ max j j' :=
(cocone_objs j j').some_spec.some_spec.some

/--
`coeq f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of object
which admits a morphism `coeq_hom f f' : j' ⟶ coeq f f'` such that
`coeq_condition : f ≫ coeq_hom f f' = f' ≫ coeq_hom f f'`.
Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq {j j' : C} (f f' : j ⟶ j') : C :=
(cocone_maps f f').some

/--
`coeq_hom f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of morphism
`coeq_hom f f' : j' ⟶ coeq f f'` such that
`coeq_condition : f ≫ coeq_hom f f' = f' ≫ coeq_hom f f'`.
Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq_hom {j j' : C} (f f' : j ⟶ j') : j' ⟶ coeq f f' :=
(cocone_maps f f').some_spec.some

/--
`coeq_condition f f'`, for morphisms `f f' : j ⟶ j'`, is the proof that
`f ≫ coeq_hom f f' = f' ≫ coeq_hom f f'`.
-/
@[simp, reassoc]
lemma coeq_condition {j j' : C} (f f' : j ⟶ j') : f ≫ coeq_hom f f' = f' ≫ coeq_hom f f' :=
(cocone_maps f f').some_spec.some_spec

end allow_empty

section nonempty

open category_theory.limits

variables {C} [is_filtered C]

/--
Any finite collection of objects in a filtered category has an object "to the right".
-/
lemma sup_objs_exists (O : finset C) : ∃ (S : C), ∀ {X}, X ∈ O → _root_.nonempty (X ⟶ S) :=
begin
  classical,
  apply finset.induction_on O,
  { exact ⟨is_filtered.nonempty.some, (by rintros - ⟨⟩)⟩, },
  { rintros X O' nm ⟨S', w'⟩,
    use max X S',
    rintros Y mY,
    obtain rfl|h := eq_or_ne Y X,
    { exact ⟨left_to_max _ _⟩, },
    { exact ⟨(w' (finset.mem_of_mem_insert_of_ne mY h)).some ≫ right_to_max _ _⟩, }, }
end

variables (O : finset C) (H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y))

/--
Given any `finset` of objects `{X, ...}` and
indexed collection of `finset`s of morphisms `{f, ...}` in `C`,
there exists an object `S`, with a morphism `T X : X ⟶ S` from each `X`,
such that the triangles commute: `f ≫ T Y = T X`, for `f : X ⟶ Y` in the `finset`.
-/
lemma sup_exists :
  ∃ (S : C) (T : Π {X : C}, X ∈ O → (X ⟶ S)), ∀ {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y},
    (⟨X, Y, mX, mY, f⟩ : (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H → f ≫ T mY = T mX :=
begin
  classical,
  apply finset.induction_on H,
  { obtain ⟨S, f⟩ := sup_objs_exists O,
    refine ⟨S, λ X mX, (f mX).some, _⟩,
    rintros - - - - - ⟨⟩, },
  { rintros ⟨X, Y, mX, mY, f⟩ H' nmf ⟨S', T', w'⟩,
    refine ⟨coeq (f ≫ T' mY) (T' mX), λ Z mZ, T' mZ ≫ coeq_hom (f ≫ T' mY) (T' mX), _⟩,
    intros X' Y' mX' mY' f' mf',
    rw [←category.assoc],
    by_cases h : X = X' ∧ Y = Y',
    { rcases h with ⟨rfl, rfl⟩,
      by_cases hf : f = f',
      { subst hf,
        apply coeq_condition, },
      { rw @w' _ _ mX mY f' (by simpa [hf ∘ eq.symm] using mf') }, },
    { rw @w' _ _ mX' mY' f' _,
      apply finset.mem_of_mem_insert_of_ne mf',
      contrapose! h,
      obtain ⟨rfl, h⟩ := h,
      rw [heq_iff_eq, psigma.mk.inj_iff] at h,
      exact ⟨rfl, h.1.symm⟩ }, },
end

/--
An arbitrary choice of object "to the right"
of a finite collection of objects `O` and morphisms `H`,
making all the triangles commute.
-/
noncomputable
def sup : C :=
(sup_exists O H).some

/--
The morphisms to `sup O H`.
-/
noncomputable
def to_sup {X : C} (m : X ∈ O) :
  X ⟶ sup O H :=
(sup_exists O H).some_spec.some m

/--
The triangles of consisting of a morphism in `H` and the maps to `sup O H` commute.
-/
lemma to_sup_commutes
  {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y}
  (mf : (⟨X, Y, mX, mY, f⟩ : Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) ∈ H) :
  f ≫ to_sup O H mY = to_sup O H mX :=
(sup_exists O H).some_spec.some_spec mX mY mf

variables {J : Type v} [small_category J] [fin_category J]

/--
If we have `is_filtered C`, then for any functor `F : J ⥤ C` with `fin_category J`,
there exists a cocone over `F`.
-/
lemma cocone_nonempty (F : J ⥤ C) : _root_.nonempty (cocone F) :=
begin
  classical,
  let O := (finset.univ.image F.obj),
  let H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    finset.univ.bUnion (λ X : J, finset.univ.bUnion (λ Y : J, finset.univ.image (λ f : X ⟶ Y,
      ⟨F.obj X, F.obj Y, by simp, by simp, F.map f⟩))),
  obtain ⟨Z, f, w⟩ := sup_exists O H,
  refine ⟨⟨Z, ⟨λ X, f (by simp), _⟩⟩⟩,
  intros j j' g,
  dsimp,
  simp only [category.comp_id],
  apply w,
  simp only [finset.mem_univ, finset.mem_bUnion, exists_and_distrib_left,
    exists_prop_of_true, finset.mem_image],
  exact ⟨j, rfl, j', g, (by simp)⟩,
end

/--
An arbitrary choice of cocone over `F : J ⥤ C`, for `fin_category J` and `is_filtered C`.
-/
noncomputable def cocone (F : J ⥤ C) : cocone F :=
(cocone_nonempty F).some

variables {D : Type u₁} [category.{v₁} D]

/--
If `C` is filtered, and we have a functor `R : C ⥤ D` with a left adjoint, then `D` is filtered.
-/
lemma of_right_adjoint {L : D ⥤ C} {R : C ⥤ D} (h : L ⊣ R) : is_filtered D :=
{ cocone_objs := λ X Y,
    ⟨_, h.hom_equiv _ _ (left_to_max _ _), h.hom_equiv _ _ (right_to_max _ _), ⟨⟩⟩,
  cocone_maps := λ X Y f g,
    ⟨_, h.hom_equiv _ _ (coeq_hom _ _),
     by rw [← h.hom_equiv_naturality_left, ← h.hom_equiv_naturality_left, coeq_condition]⟩,
  nonempty := is_filtered.nonempty.map R.obj }

/-- If `C` is filtered, and we have a right adjoint functor `R : C ⥤ D`, then `D` is filtered. -/
lemma of_is_right_adjoint (R : C ⥤ D) [is_right_adjoint R] : is_filtered D :=
of_right_adjoint (adjunction.of_right_adjoint R)

/-- Being filtered is preserved by equivalence of categories. -/
lemma of_equivalence (h : C ≌ D) : is_filtered D :=
of_right_adjoint h.symm.to_adjunction

end nonempty

section special_shapes

variables {C} [is_filtered_or_empty C]

/--
`max₃ j₁ j₂ j₃` is an arbitrary choice of object to the right of `j₁`, `j₂` and `j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def max₃ (j₁ j₂ j₃ : C) : C := max (max j₁ j₂) j₃

/--
`first_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₁` to `max₃ j₁ j₂ j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def first_to_max₃ (j₁ j₂ j₃ : C) : j₁ ⟶ max₃ j₁ j₂ j₃ :=
left_to_max j₁ j₂ ≫ left_to_max (max j₁ j₂) j₃

/--
`second_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₂` to `max₃ j₁ j₂ j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def second_to_max₃ (j₁ j₂ j₃ : C) : j₂ ⟶ max₃ j₁ j₂ j₃ :=
right_to_max j₁ j₂ ≫ left_to_max (max j₁ j₂) j₃

/--
`third_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₃` to `max₃ j₁ j₂ j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def third_to_max₃ (j₁ j₂ j₃ : C) : j₃ ⟶ max₃ j₁ j₂ j₃ :=
right_to_max (max j₁ j₂) j₃

/--
`coeq₃ f g h`, for morphisms `f g h : j₁ ⟶ j₂`, is an arbitrary choice of object
which admits a morphism `coeq₃_hom f g h : j₂ ⟶ coeq₃ f g h` such that
`coeq₃_condition₁`, `coeq₃_condition₂` and `coeq₃_condition₃` are satisfied.
Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq₃ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) : C :=
coeq (coeq_hom f g ≫ left_to_max (coeq f g) (coeq g h))
  (coeq_hom g h ≫ right_to_max (coeq f g) (coeq g h))

/--
`coeq₃_hom f g h`, for morphisms `f g h : j₁ ⟶ j₂`, is an arbitrary choice of morphism
`j₂ ⟶ coeq₃ f g h` such that `coeq₃_condition₁`, `coeq₃_condition₂` and `coeq₃_condition₃`
are satisfied. Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq₃_hom {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) : j₂ ⟶ coeq₃ f g h :=
coeq_hom f g ≫ left_to_max (coeq f g) (coeq g h) ≫
coeq_hom (coeq_hom f g ≫ left_to_max (coeq f g) (coeq g h))
  (coeq_hom g h ≫ right_to_max (coeq f g) (coeq g h))

lemma coeq₃_condition₁ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) :
  f ≫ coeq₃_hom f g h = g ≫ coeq₃_hom f g h :=
by rw [coeq₃_hom, reassoc_of (coeq_condition f g)]

lemma coeq₃_condition₂ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) :
  g ≫ coeq₃_hom f g h = h ≫ coeq₃_hom f g h :=
begin
  dsimp [coeq₃_hom],
  slice_lhs 2 4 { rw [← category.assoc, coeq_condition _ _] },
  slice_rhs 2 4 { rw [← category.assoc, coeq_condition _ _] },
  slice_lhs 1 3 { rw [← category.assoc, coeq_condition _ _] },
  simp only [category.assoc],
end

lemma coeq₃_condition₃ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) :
  f ≫ coeq₃_hom f g h = h ≫ coeq₃_hom f g h :=
eq.trans (coeq₃_condition₁ f g h) (coeq₃_condition₂ f g h)

/-- For every span `j ⟵ i ⟶ j'`, there
   exists a cocone `j ⟶ k ⟵ j'` such that the square commutes. -/
lemma span {i j j' : C} (f : i ⟶ j) (f' : i ⟶ j') :
  ∃ (k : C) (g : j ⟶ k) (g' : j' ⟶ k), f ≫ g = f' ≫ g' :=
let ⟨K, G, G', _⟩ := cocone_objs j j', ⟨k, e, he⟩ := cocone_maps (f ≫ G) (f' ≫ G') in
⟨k, G ≫ e, G' ≫ e, by simpa only [← category.assoc]⟩

/--
Given a "bowtie" of morphisms
```
 j₁   j₂
 |\  /|
 | \/ |
 | /\ |
 |/  \∣
 vv  vv
 k₁  k₂
```
in a filtered category, we can construct an object `s` and two morphisms from `k₁` and `k₂` to `s`,
making the resulting squares commute.
-/
lemma bowtie {j₁ j₂ k₁ k₂ : C}
  (f₁ : j₁ ⟶ k₁) (g₁ : j₁ ⟶ k₂) (f₂ : j₂ ⟶ k₁) (g₂ : j₂ ⟶ k₂) :
  ∃ (s : C) (α : k₁ ⟶ s) (β : k₂ ⟶ s), f₁ ≫ α = g₁ ≫ β ∧ f₂ ≫ α = g₂ ≫ β :=
begin
  obtain ⟨t, k₁t, k₂t, ht⟩ := span f₁ g₁,
  obtain ⟨s, ts, hs⟩ := cocone_maps (f₂ ≫ k₁t) (g₂ ≫ k₂t),
  simp_rw category.assoc at hs,
  exact ⟨s, k₁t ≫ ts, k₂t ≫ ts, by rw reassoc_of ht, hs⟩,
end

/--
Given a "tulip" of morphisms
```
 j₁    j₂    j₃
 |\   / \   / |
 | \ /   \ /  |
 |  vv    vv  |
 \  k₁    k₂ /
  \         /
   \       /
    \     /
     \   /
      v v
       l
```
in a filtered category, we can construct an object `s` and three morphisms from `k₁`, `k₂` and `l`
to `s`, making the resulting squares commute.
-/
lemma tulip {j₁ j₂ j₃ k₁ k₂ l : C} (f₁ : j₁ ⟶ k₁) (f₂ : j₂ ⟶ k₁) (f₃ : j₂ ⟶ k₂) (f₄ : j₃ ⟶ k₂)
  (g₁ : j₁ ⟶ l) (g₂ : j₃ ⟶ l) :
  ∃ (s : C) (α : k₁ ⟶ s) (β : l ⟶ s) (γ : k₂ ⟶ s),
    f₁ ≫ α = g₁ ≫ β ∧ f₂ ≫ α = f₃ ≫ γ ∧ f₄ ≫ γ = g₂ ≫ β :=
begin
  obtain ⟨l', k₁l, k₂l, hl⟩ := span f₂ f₃,
  obtain ⟨s, ls, l's, hs₁, hs₂⟩ := bowtie g₁ (f₁ ≫ k₁l) g₂ (f₄ ≫ k₂l),
  refine ⟨s, k₁l ≫ l's, ls, k₂l ≫ l's, _, by rw reassoc_of hl, _⟩;
  simp only [hs₁, hs₂, category.assoc],
end

end special_shapes

end is_filtered

/--
A category `is_cofiltered_or_empty` if
1. for every pair of objects there exists another object "to the left", and
2. for every pair of parallel morphisms there exists a morphism to the left so the compositions
   are equal.
-/
class is_cofiltered_or_empty : Prop :=
(cone_objs : ∀ (X Y : C), ∃ W (f : W ⟶ X) (g : W ⟶ Y), true)
(cone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ W (h : W ⟶ X), h ≫ f = h ≫ g)

/--
A category `is_cofiltered` if
1. for every pair of objects there exists another object "to the left",
2. for every pair of parallel morphisms there exists a morphism to the left so the compositions
   are equal, and
3. there exists some object.

See <https://stacks.math.columbia.edu/tag/04AZ>.
-/
class is_cofiltered extends is_cofiltered_or_empty C : Prop :=
[nonempty : nonempty C]

@[priority 100]
instance is_cofiltered_or_empty_of_semilattice_inf
  (α : Type u) [semilattice_inf α] : is_cofiltered_or_empty α :=
{ cone_objs := λ X Y, ⟨X ⊓ Y, hom_of_le inf_le_left, hom_of_le inf_le_right, trivial⟩,
  cone_maps := λ X Y f g, ⟨X, 𝟙 _, (by ext)⟩, }

@[priority 100]
instance is_cofiltered_of_semilattice_inf_nonempty
  (α : Type u) [semilattice_inf α] [nonempty α] : is_cofiltered α := {}

@[priority 100]
instance is_cofiltered_or_empty_of_directed_ge (α : Type u) [preorder α]
  [is_directed α (≥)] :
  is_cofiltered_or_empty α :=
{ cone_objs := λ X Y, let ⟨Z, hX, hY⟩ := exists_le_le X Y in
    ⟨Z, hom_of_le hX, hom_of_le hY, trivial⟩,
  cone_maps := λ X Y f g, ⟨X, 𝟙 _, by simp⟩ }

@[priority 100]
instance is_cofiltered_of_directed_ge_nonempty (α : Type u) [preorder α] [is_directed α (≥)]
  [nonempty α] :
  is_cofiltered α := {}

-- Sanity checks
example (α : Type u) [semilattice_inf α] [order_bot α] : is_cofiltered α := by apply_instance
example (α : Type u) [semilattice_inf α] [order_top α] : is_cofiltered α := by apply_instance

instance : is_cofiltered (discrete punit) :=
{ cone_objs := λ X Y, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, ⟨⟨dec_trivial⟩⟩, trivial⟩,
  cone_maps := λ X Y f g, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, dec_trivial⟩,
  nonempty := ⟨⟨punit.star⟩⟩ }

namespace is_cofiltered

section allow_empty

variables {C} [is_cofiltered_or_empty C]

lemma cone_objs : ∀ (X Y : C), ∃ W (f : W ⟶ X) (g : W ⟶ Y), true := is_cofiltered_or_empty.cone_objs
lemma cone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ W (h : W ⟶ X), h ≫ f = h ≫ g :=
is_cofiltered_or_empty.cone_maps

/--
`min j j'` is an arbitrary choice of object to the left of both `j` and `j'`,
whose existence is ensured by `is_cofiltered`.
-/
noncomputable def min (j j' : C) : C :=
(cone_objs j j').some

/--
`min_to_left j j'` is an arbitrary choice of morphism from `min j j'` to `j`,
whose existence is ensured by `is_cofiltered`.
-/
noncomputable def min_to_left (j j' : C) : min j j' ⟶ j :=
(cone_objs j j').some_spec.some

/--
`min_to_right j j'` is an arbitrary choice of morphism from `min j j'` to `j'`,
whose existence is ensured by `is_cofiltered`.
-/
noncomputable def min_to_right (j j' : C) : min j j' ⟶ j' :=
(cone_objs j j').some_spec.some_spec.some

/--
`eq f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of object
which admits a morphism `eq_hom f f' : eq f f' ⟶ j` such that
`eq_condition : eq_hom f f' ≫ f = eq_hom f f' ≫ f'`.
Its existence is ensured by `is_cofiltered`.
-/
noncomputable def eq {j j' : C} (f f' : j ⟶ j') : C :=
(cone_maps f f').some

/--
`eq_hom f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of morphism
`eq_hom f f' : eq f f' ⟶ j` such that
`eq_condition : eq_hom f f' ≫ f = eq_hom f f' ≫ f'`.
Its existence is ensured by `is_cofiltered`.
-/
noncomputable def eq_hom {j j' : C} (f f' : j ⟶ j') : eq f f' ⟶ j :=
(cone_maps f f').some_spec.some

/--
`eq_condition f f'`, for morphisms `f f' : j ⟶ j'`, is the proof that
`eq_hom f f' ≫ f = eq_hom f f' ≫ f'`.
-/
@[simp, reassoc]
lemma eq_condition {j j' : C} (f f' : j ⟶ j') : eq_hom f f' ≫ f = eq_hom f f' ≫ f' :=
(cone_maps f f').some_spec.some_spec

/-- For every cospan `j ⟶ i ⟵ j'`,
 there exists a cone `j ⟵ k ⟶ j'` such that the square commutes. -/
lemma cospan {i j j' : C} (f : j ⟶ i) (f' : j' ⟶ i) :
  ∃ (k : C) (g : k ⟶ j) (g' : k ⟶ j'), g ≫ f = g' ≫ f' :=
let ⟨K, G, G', _⟩ := cone_objs j j', ⟨k, e, he⟩ := cone_maps (G ≫ f) (G' ≫ f') in
⟨k, e ≫ G, e ≫ G', by simpa only [category.assoc] using he⟩

lemma _root_.category_theory.functor.ranges_directed (F : C ⥤ Type*) (j : C) :
  directed (⊇) (λ (f : Σ' i, i ⟶ j), set.range (F.map f.2)) :=
λ ⟨i, ij⟩ ⟨k, kj⟩, let ⟨l, li, lk, e⟩ := cospan ij kj in
by refine ⟨⟨l, lk ≫ kj⟩, e ▸ _, _⟩; simp_rw F.map_comp; apply set.range_comp_subset_range

end allow_empty

section nonempty

open category_theory.limits

variables {C} [is_cofiltered C]

/--
Any finite collection of objects in a cofiltered category has an object "to the left".
-/
lemma inf_objs_exists (O : finset C) : ∃ (S : C), ∀ {X}, X ∈ O → _root_.nonempty (S ⟶ X) :=
begin
  classical,
  apply finset.induction_on O,
  { exact ⟨is_cofiltered.nonempty.some, (by rintros - ⟨⟩)⟩, },
  { rintros X O' nm ⟨S', w'⟩,
    use min X S',
    rintros Y mY,
    obtain rfl|h := eq_or_ne Y X,
    { exact ⟨min_to_left _ _⟩, },
    { exact ⟨min_to_right _ _ ≫ (w' (finset.mem_of_mem_insert_of_ne mY h)).some⟩, }, }
end

variables (O : finset C) (H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y))

/--
Given any `finset` of objects `{X, ...}` and
indexed collection of `finset`s of morphisms `{f, ...}` in `C`,
there exists an object `S`, with a morphism `T X : S ⟶ X` from each `X`,
such that the triangles commute: `T X ≫ f = T Y`, for `f : X ⟶ Y` in the `finset`.
-/
lemma inf_exists :
  ∃ (S : C) (T : Π {X : C}, X ∈ O → (S ⟶ X)), ∀ {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y},
    (⟨X, Y, mX, mY, f⟩ : (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H → T mX ≫ f = T mY :=
begin
  classical,
  apply finset.induction_on H,
  { obtain ⟨S, f⟩ := inf_objs_exists O,
    refine ⟨S, λ X mX, (f mX).some, _⟩,
    rintros - - - - - ⟨⟩, },
  { rintros ⟨X, Y, mX, mY, f⟩ H' nmf ⟨S', T', w'⟩,
    refine ⟨eq (T' mX ≫ f) (T' mY), λ Z mZ, eq_hom (T' mX ≫ f) (T' mY) ≫ T' mZ, _⟩,
    intros X' Y' mX' mY' f' mf',
    rw [category.assoc],
    by_cases h : X = X' ∧ Y = Y',
    { rcases h with ⟨rfl, rfl⟩,
      by_cases hf : f = f',
      { subst hf,
        apply eq_condition, },
      { rw @w' _ _ mX mY f' (by simpa [hf ∘ eq.symm] using mf') }, },
    { rw @w' _ _ mX' mY' f' _,
      apply finset.mem_of_mem_insert_of_ne mf',
      contrapose! h,
      obtain ⟨rfl, h⟩ := h,
      rw [heq_iff_eq, psigma.mk.inj_iff] at h,
      exact ⟨rfl, h.1.symm⟩ }, },
end

/--
An arbitrary choice of object "to the left"
of a finite collection of objects `O` and morphisms `H`,
making all the triangles commute.
-/
noncomputable
def inf : C :=
(inf_exists O H).some

/--
The morphisms from `inf O H`.
-/
noncomputable
def inf_to {X : C} (m : X ∈ O) :
  inf O H ⟶ X :=
(inf_exists O H).some_spec.some m

/--
The triangles consisting of a morphism in `H` and the maps from `inf O H` commute.
-/
lemma inf_to_commutes
  {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y}
  (mf : (⟨X, Y, mX, mY, f⟩ : Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) ∈ H) :
  inf_to O H mX ≫ f = inf_to O H mY :=
(inf_exists O H).some_spec.some_spec mX mY mf

variables {J : Type w} [small_category J] [fin_category J]

/--
If we have `is_cofiltered C`, then for any functor `F : J ⥤ C` with `fin_category J`,
there exists a cone over `F`.
-/
lemma cone_nonempty (F : J ⥤ C) : _root_.nonempty (cone F) :=
begin
  classical,
  let O := (finset.univ.image F.obj),
  let H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    finset.univ.bUnion (λ X : J, finset.univ.bUnion (λ Y : J, finset.univ.image (λ f : X ⟶ Y,
      ⟨F.obj X, F.obj Y, by simp, by simp, F.map f⟩))),
  obtain ⟨Z, f, w⟩ := inf_exists O H,
  refine ⟨⟨Z, ⟨λ X, f (by simp), _⟩⟩⟩,
  intros j j' g,
  dsimp,
  simp only [category.id_comp],
  symmetry,
  apply w,
  simp only [finset.mem_univ, finset.mem_bUnion, exists_and_distrib_left,
    exists_prop_of_true, finset.mem_image],
  exact ⟨j, rfl, j', g, (by simp)⟩,
end

/--
An arbitrary choice of cone over `F : J ⥤ C`, for `fin_category J` and `is_cofiltered C`.
-/
noncomputable def cone (F : J ⥤ C) : cone F :=
(cone_nonempty F).some

variables {D : Type u₁} [category.{v₁} D]

/--
If `C` is cofiltered, and we have a functor `L : C ⥤ D` with a right adjoint,
then `D` is cofiltered.
-/
lemma of_left_adjoint {L : C ⥤ D} {R : D ⥤ C} (h : L ⊣ R) : is_cofiltered D :=
{ cone_objs := λ X Y,
    ⟨L.obj (min (R.obj X) (R.obj Y)),
      (h.hom_equiv _ X).symm (min_to_left _ _), (h.hom_equiv _ Y).symm (min_to_right _ _), ⟨⟩⟩,
  cone_maps := λ X Y f g,
    ⟨L.obj (eq (R.map f) (R.map g)), (h.hom_equiv _ _).symm (eq_hom _ _),
     by rw [← h.hom_equiv_naturality_right_symm, ← h.hom_equiv_naturality_right_symm,
       eq_condition]⟩,
  nonempty := is_cofiltered.nonempty.map L.obj }

/-- If `C` is cofiltered, and we have a left adjoint functor `L : C ⥤ D`, then `D` is cofiltered. -/

/-- Being cofiltered is preserved by equivalence of categories. -/
lemma of_equivalence (h : C ≌ D) : is_cofiltered D :=
of_left_adjoint h.to_adjunction

end nonempty

end is_cofiltered

section opposite
open opposite

instance is_cofiltered_op_of_is_filtered [is_filtered C] : is_cofiltered Cᵒᵖ :=
{ cone_objs := λ X Y, ⟨op (is_filtered.max X.unop Y.unop),
    (is_filtered.left_to_max _ _).op, (is_filtered.right_to_max _ _).op, trivial⟩,
  cone_maps := λ X Y f g, ⟨op (is_filtered.coeq f.unop g.unop),
    (is_filtered.coeq_hom _ _).op, begin
      rw [(show f = f.unop.op, by simp), (show g = g.unop.op, by simp),
        ← op_comp, ← op_comp],
      congr' 1,
      exact is_filtered.coeq_condition f.unop g.unop,
    end⟩,
  nonempty := ⟨op is_filtered.nonempty.some⟩ }

instance is_filtered_op_of_is_cofiltered [is_cofiltered C] : is_filtered Cᵒᵖ :=
{ cocone_objs := λ X Y, ⟨op (is_cofiltered.min X.unop Y.unop),
    (is_cofiltered.min_to_left X.unop Y.unop).op,
    (is_cofiltered.min_to_right X.unop Y.unop).op, trivial⟩,
  cocone_maps := λ X Y f g, ⟨op (is_cofiltered.eq f.unop g.unop),
    (is_cofiltered.eq_hom f.unop g.unop).op, begin
      rw [(show f = f.unop.op, by simp), (show g = g.unop.op, by simp),
        ← op_comp, ← op_comp],
      congr' 1,
      exact is_cofiltered.eq_condition f.unop g.unop,
    end⟩,
  nonempty := ⟨op is_cofiltered.nonempty.some⟩ }

end opposite

section ulift

instance [is_filtered C] : is_filtered (ulift.{u₂} C) :=
is_filtered.of_equivalence ulift.equivalence

instance [is_cofiltered C] : is_cofiltered (ulift.{u₂} C) :=
is_cofiltered.of_equivalence ulift.equivalence

instance [is_filtered C] : is_filtered (ulift_hom C) :=
is_filtered.of_equivalence ulift_hom.equiv

instance [is_cofiltered C] : is_cofiltered (ulift_hom C) :=
is_cofiltered.of_equivalence ulift_hom.equiv

instance [is_filtered C] : is_filtered (as_small C) :=
is_filtered.of_equivalence as_small.equiv

instance [is_cofiltered C] : is_cofiltered (as_small C) :=
is_cofiltered.of_equivalence as_small.equiv

end ulift

end category_theory


/- import rel_hoare

namespace arrcp

open parlang
open parlang.kernel

def tstate := string → ℕ

def state.update (name : string) (val : ℕ) (s : tstate) : tstate :=
λn, if n = name then val else s n

notation s ` & ` n ` ::= ` v := state.update n v s

def init := λ n : ℕ, λ name, if name = "tid" then n else 0

def arrcp₁ : program tstate (λ n : ℕ, ℕ) := program.intro (λ m : memory (λ n : ℕ, ℕ), m 0) (
    kernel.load (λ s, ⟨0, λ a, s & "n" ::= a⟩) ;;               -- load n to thread tlocal
    kernel.load (λ s, ⟨1 + s "tid", λ a, s & "temp" ::= a⟩) ;;  -- load from array a
    kernel.store (λ s, ⟨1 + s "n" + s "tid", s "temp"⟩)         -- store to array b
)

def arrcp₂ : program tstate (λ n : ℕ, ℕ) := program.intro (λ m : memory (λ n : ℕ, ℕ), 10) (
    kernel.load (λ s, ⟨0, λ a, s & "n" ::= a⟩) ;;               -- load n to thread tlocal
    kernel.compute (λ s, s & "i" ::= s "tid") ;;
    kernel.loop (λ s, s "i" < s "n") (
        kernel.load (λ s, ⟨1 + s "i", λ a, s & "temp" ::= a⟩) ;;-- load from array a
        kernel.store (λ s, ⟨1 + s "n" + s "i", s "temp"⟩) ;;    -- store to array b
        kernel.compute (λ s, s & "i" ::= s "i" + 10)
    )
)

lemma arrcprel : rel_hoare_program init init eq arrcp₁ arrcp₂ eq := begin
    unfold arrcp₁ arrcp₂,
    apply rel_kernel_to_program,
    apply single_step_left ((λ (n₁ : ℕ) (s₁ : state n₁ (string → ℕ) (λ (n : ℕ), ℕ)) (ac₁ : vector bool n₁) (n₂ : ℕ)
     (s₂ : state n₂ (string → ℕ) (λ (n : ℕ), ℕ)) (ac₂ : vector bool n₂),
       ∃ (m₁ m₂ : memory (λ (n : ℕ), ℕ)),
         state.syncable s₁ m₁ ∧
           state.syncable s₂ m₂ ∧
             n₁ = m₁ 0 ∧
               n₂ = 10 ∧
                (∀ (i : fin n₁),
                      vector.nth (s₁.threads) i =
                        {tlocal := (init ↑i) & "n" ::= m₁ 0, shared := m₁, loads := insert 0 ((vector.nth (s₁.threads) i).loads), stores := ∅}) ∧
                (∀ (i : fin n₂),
                    vector.nth (s₂.threads) i =
                        {tlocal := init ↑i, shared := m₂, loads := ∅, stores := ∅}) ∧
                    m₁ = m₂ ∧ ↥(all_threads_active ac₁) ∧ ↥(all_threads_active ac₂))),
    {
        intros n₁ n₂ s₁ s₁' s₂ ac₁ ac₂ hp hek₁,
        cases hp with m₁ hp,
        cases hp with m₂ hp,
        apply exists.intro s₂,
        apply and.intro,
        {
            suffices h : exec_state (compute id) ac₂ s₂ (state.map_active_threads ac₂ (thread_state.map id) s₂),
            {
                rw ← state.map_active_threads_id s₂ ac₂ at h,
                assumption,
            },
            apply exec_state.compute,
        }, {
            simp,
            apply exists.intro m₁,
            cases hek₁,
            apply and.intro,
            {

                sorry -- memory does not change
            }, {
                apply exists.intro m₂,
                apply and.intro,
                { apply hp.right.left, },
                {
                    apply and.intro hp.right.right.left (and.intro hp.right.right.right.left (and.intro _ hp.right.right.right.right.right)),
                    intro i,
                    -- rw ← hp.right.right.right.right.left,
                    simp,
                    have haa: ↥(vector.nth ac₁ i) := begin
                        apply all_threads_active_nth,
                        exact hp.right.right.right.right.right.right.right.left,
                    end,
                    simp [haa],
                    rw thread_state.load,
                    rw thread_state.load._match_1,
                    have : m₁ = (vector.nth (s₁.threads) i).shared := begin
                        rw hp.right.right.right.right.left,
                    end,
                    subst this,
                    simp,
                    have : (vector.nth (s₁.threads) i).tlocal = (init i) := begin
                        rw hp.right.right.right.right.left,
                    end,
                    rw this,
                    rw memory.get,
                    simp,
                    rw hp.right.right.right.right.left,
                }
            }
        }
    }, {

    }
end

end arrcp -/


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yury G. Kudryashov
-/
import data.option.basic

/-!
# Disjoint union of types

This file proves basic results about the sum type `α ⊕ β`.

`α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*.

## Main declarations

* `sum.get_left`: Retrieves the left content of `x : α ⊕ β` or returns `none` if it's coming from
  the right.
* `sum.get_right`: Retrieves the right content of `x : α ⊕ β` or returns `none` if it's coming from
  the left.
* `sum.is_left`: Returns whether `x : α ⊕ β` comes from the left component or not.
* `sum.is_right`: Returns whether `x : α ⊕ β` comes from the right component or not.
* `sum.map`: Maps `α ⊕ β` to `γ ⊕ δ` component-wise.
* `sum.elim`: Nondependent eliminator/induction principle for `α ⊕ β`.
* `sum.swap`: Maps `α ⊕ β` to `β ⊕ α` by swapping components.
* `sum.lex`: Lexicographic order on `α ⊕ β` induced by a relation on `α` and a relation on `β`.

## Notes

The definition of `sum` takes values in `Type*`. This effectively forbids `Prop`- valued sum types.
To this effect, we have `psum`, which takes value in `Sort*` and carries a more complicated
universe signature in consequence. The `Prop` version is `or`.
-/

universes u v w x
variables {α : Type u} {α' : Type w} {β : Type v} {β' : Type x} {γ δ : Type*}

namespace sum

attribute [derive decidable_eq] sum

@[simp] lemma «forall» {p : α ⊕ β → Prop} : (∀ x, p x) ↔ (∀ a, p (inl a)) ∧ ∀ b, p (inr b) :=
⟨λ h, ⟨λ a, h _, λ b, h _⟩, λ ⟨h₁, h₂⟩, sum.rec h₁ h₂⟩

@[simp] lemma «exists» {p : α ⊕ β → Prop} : (∃ x, p x) ↔ (∃ a, p (inl a)) ∨ ∃ b, p (inr b) :=
⟨λ h, match h with
| ⟨inl a, h⟩ := or.inl ⟨a, h⟩
| ⟨inr b, h⟩ := or.inr ⟨b, h⟩
end, λ h, match h with
| or.inl ⟨a, h⟩ := ⟨inl a, h⟩
| or.inr ⟨b, h⟩ := ⟨inr b, h⟩
end⟩

lemma inl_injective : function.injective (inl : α → α ⊕ β) := λ x y, inl.inj
lemma inr_injective : function.injective (inr : β → α ⊕ β) := λ x y, inr.inj

section get

/-- Check if a sum is `inl` and if so, retrieve its contents. -/
@[simp] def get_left : α ⊕ β → option α
| (inl a) := some a
| (inr _) := none

/-- Check if a sum is `inr` and if so, retrieve its contents. -/
@[simp] def get_right : α ⊕ β → option β
| (inr b) := some b
| (inl _) := none

/-- Check if a sum is `inl`. -/
@[simp] def is_left : α ⊕ β → bool
| (inl _) := tt
| (inr _) := ff

/-- Check if a sum is `inr`. -/
@[simp] def is_right : α ⊕ β → bool
| (inl _) := ff
| (inr _) := tt

variables {x y : α ⊕ β}

lemma get_left_eq_none_iff : x.get_left = none ↔ x.is_right :=
by cases x; simp only [get_left, is_right, coe_sort_tt, coe_sort_ff, eq_self_iff_true]

lemma get_right_eq_none_iff : x.get_right = none ↔ x.is_left :=
by cases x; simp only [get_right, is_left, coe_sort_tt, coe_sort_ff, eq_self_iff_true]

end get

/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/
protected def map (f : α → α') (g : β → β')  : α ⊕ β → α' ⊕ β'
| (inl x) := inl (f x)
| (inr x) := inr (g x)

@[simp] lemma map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
@[simp] lemma map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl

@[simp] lemma map_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
  ∀ x : α ⊕ β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g)
| (inl a) := rfl
| (inr b) := rfl

@[simp] lemma map_comp_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
  (sum.map f' g') ∘ (sum.map f g) = sum.map (f' ∘ f) (g' ∘ g) :=
funext $ map_map f' g' f g

@[simp] lemma map_id_id (α β) : sum.map (@id α) (@id β) = id :=
funext $ λ x, sum.rec_on x (λ _, rfl) (λ _, rfl)

theorem inl.inj_iff {a b} : (inl a : α ⊕ β) = inl b ↔ a = b :=
⟨inl.inj, congr_arg _⟩

theorem inr.inj_iff {a b} : (inr a : α ⊕ β) = inr b ↔ a = b :=
⟨inr.inj, congr_arg _⟩

theorem inl_ne_inr {a : α} {b : β} : inl a ≠ inr b.

theorem inr_ne_inl {a : α} {b : β} : inr b ≠ inl a.

/-- Define a function on `α ⊕ β` by giving separate definitions on `α` and `β`. -/
protected def elim {α β γ : Sort*} (f : α → γ) (g : β → γ) : α ⊕ β → γ := λ x, sum.rec_on x f g

@[simp] lemma elim_inl {α β γ : Sort*} (f : α → γ) (g : β → γ) (x : α) :
  sum.elim f g (inl x) = f x := rfl

@[simp] lemma elim_inr {α β γ : Sort*} (f : α → γ) (g : β → γ) (x : β) :
  sum.elim f g (inr x) = g x := rfl

@[simp] lemma elim_comp_inl {α β γ : Sort*} (f : α → γ) (g : β → γ) :
  sum.elim f g ∘ inl = f := rfl

@[simp] lemma elim_comp_inr {α β γ : Sort*} (f : α → γ) (g : β → γ) :
  sum.elim f g ∘ inr = g := rfl

@[simp] lemma elim_inl_inr {α β : Sort*} :
  @sum.elim α β _ inl inr = id :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

lemma comp_elim {α β γ δ : Sort*} (f : γ → δ) (g : α → γ) (h : β → γ):
  f ∘ sum.elim g h = sum.elim (f ∘ g) (f ∘ h) :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

@[simp] lemma elim_comp_inl_inr {α β γ : Sort*} (f : α ⊕ β → γ) :
  sum.elim (f ∘ inl) (f ∘ inr) = f :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

open function (update update_eq_iff update_comp_eq_of_injective update_comp_eq_of_forall_ne)

@[simp] lemma update_elim_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α → γ} {g : β → γ}
  {i : α} {x : γ} :
  update (sum.elim f g) (inl i) x = sum.elim (update f i x) g :=
update_eq_iff.2 ⟨by simp, by simp { contextual := tt }⟩

@[simp] lemma update_elim_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α → γ} {g : β → γ}
  {i : β} {x : γ} :
  update (sum.elim f g) (inr i) x = sum.elim f (update g i x) :=
update_eq_iff.2 ⟨by simp, by simp { contextual := tt }⟩

@[simp] lemma update_inl_comp_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α}
  {x : γ} :
  update f (inl i) x ∘ inl = update (f ∘ inl) i x :=
update_comp_eq_of_injective _ inl_injective _ _

@[simp] lemma update_inl_apply_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ}
  {i j : α} {x : γ} :
  update f (inl i) x (inl j) = update (f ∘ inl) i x j :=
by rw ← update_inl_comp_inl

@[simp] lemma update_inl_comp_inr [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α} {x : γ} :
  update f (inl i) x ∘ inr = f ∘ inr :=
update_comp_eq_of_forall_ne _ _ $ λ _, inr_ne_inl

@[simp] lemma update_inl_apply_inr [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α} {j : β} {x : γ} :
  update f (inl i) x (inr j) = f (inr j) :=
function.update_noteq inr_ne_inl _ _

@[simp] lemma update_inr_comp_inl [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : β} {x : γ} :
  update f (inr i) x ∘ inl = f ∘ inl :=
update_comp_eq_of_forall_ne _ _ $ λ _, inl_ne_inr

@[simp]

@[simp] lemma update_inr_comp_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : β}
  {x : γ} :
  update f (inr i) x ∘ inr = update (f ∘ inr) i x :=
update_comp_eq_of_injective _ inr_injective _ _

@[simp] lemma update_inr_apply_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ}
  {i j : β} {x : γ} :
  update f (inr i) x (inr j) = update (f ∘ inr) i x j :=
by rw ← update_inr_comp_inr

/-- Swap the factors of a sum type -/
@[simp] def swap : α ⊕ β → β ⊕ α
| (inl a) := inr a
| (inr b) := inl b

@[simp] lemma swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x; refl
@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext $ swap_swap
@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap := swap_swap
@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap := swap_swap

section lift_rel

/-- Lifts pointwise two relations between `α` and `γ` and between `β` and `δ` to a relation between
`α ⊕ β` and `γ ⊕ δ`. -/
inductive lift_rel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β → γ ⊕ δ → Prop
| inl {a c} : r a c → lift_rel (inl a) (inl c)
| inr {b d} : s b d → lift_rel (inr b) (inr d)

attribute [protected] lift_rel.inl lift_rel.inr

variables {r r₁ r₂ : α → γ → Prop} {s s₁ s₂ : β → δ → Prop} {a : α} {b : β} {c : γ} {d : δ}
  {x : α ⊕ β} {y : γ ⊕ δ}

@[simp] lemma lift_rel_inl_inl : lift_rel r s (inl a) (inl c) ↔ r a c :=
⟨λ h, by { cases h, assumption }, lift_rel.inl⟩

@[simp] lemma not_lift_rel_inl_inr : ¬ lift_rel r s (inl a) (inr d) .
@[simp] lemma not_lift_rel_inr_inl : ¬ lift_rel r s (inr b) (inl c) .

@[simp] lemma lift_rel_inr_inr : lift_rel r s (inr b) (inr d) ↔ s b d :=
⟨λ h, by { cases h, assumption }, lift_rel.inr⟩

instance [Π a c, decidable (r a c)] [Π b d, decidable (s b d)] :
  Π (ab : α ⊕ β) (cd : γ ⊕ δ), decidable (lift_rel r s ab cd)
| (inl a) (inl c) := decidable_of_iff' _ lift_rel_inl_inl
| (inl a) (inr d) := decidable.is_false not_lift_rel_inl_inr
| (inr b) (inl c) := decidable.is_false not_lift_rel_inr_inl
| (inr b) (inr d) := decidable_of_iff' _ lift_rel_inr_inr

lemma lift_rel.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b)
  (h : lift_rel r₁ s₁ x y) :
  lift_rel r₂ s₂ x y :=
by { cases h, exacts [lift_rel.inl (hr _ _ ‹_›), lift_rel.inr (hs _ _ ‹_›)] }

lemma lift_rel.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : lift_rel r₁ s x y) :
  lift_rel r₂ s x y :=
h.mono hr $ λ _ _, id

lemma lift_rel.mono_right (hs : ∀ a b, s₁ a b → s₂ a b)  (h : lift_rel r s₁ x y) :
  lift_rel r s₂ x y :=
h.mono (λ _ _, id) hs

protected lemma lift_rel.swap (h : lift_rel r s x y) : lift_rel s r x.swap y.swap :=
by { cases h, exacts [lift_rel.inr ‹_›, lift_rel.inl ‹_›] }

@[simp] lemma lift_rel_swap_iff : lift_rel s r x.swap y.swap ↔ lift_rel r s x y :=
⟨λ h, by { rw [←swap_swap x, ←swap_swap y], exact h.swap }, lift_rel.swap⟩

end lift_rel

section lex

/-- Lexicographic order for sum. Sort all the `inl a` before the `inr b`, otherwise use the
respective order on `α` or `β`. -/
inductive lex (r : α → α → Prop) (s : β → β → Prop) : α ⊕ β → α ⊕ β → Prop
| inl {a₁ a₂} (h : r a₁ a₂) : lex (inl a₁) (inl a₂)
| inr {b₁ b₂} (h : s b₁ b₂) : lex (inr b₁) (inr b₂)
| sep (a b) : lex (inl a) (inr b)

attribute [protected] sum.lex.inl sum.lex.inr
attribute [simp] lex.sep

variables {r r₁ r₂ : α → α → Prop} {s s₁ s₂ : β → β → Prop} {a a₁ a₂ : α} {b b₁ b₂ : β}
  {x y : α ⊕ β}

@[simp] lemma lex_inl_inl : lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ :=
⟨λ h, by { cases h, assumption }, lex.inl⟩

@[simp] lemma lex_inr_inr : lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ :=
⟨λ h, by { cases h, assumption }, lex.inr⟩

@[simp] lemma lex_inr_inl : ¬ lex r s (inr b) (inl a) .

instance [decidable_rel r] [decidable_rel s] : decidable_rel (lex r s)
| (inl a) (inl c) := decidable_of_iff' _ lex_inl_inl
| (inl a) (inr d) := decidable.is_true (lex.sep _ _)
| (inr b) (inl c) := decidable.is_false lex_inr_inl
| (inr b) (inr d) := decidable_of_iff' _ lex_inr_inr

protected lemma lift_rel.lex {a b : α ⊕ β} (h : lift_rel r s a b) : lex r s a b :=
by { cases h, exacts [lex.inl ‹_›, lex.inr ‹_›] }

lemma lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) (h : lex r₁ s₁ x y) :
  lex r₂ s₂ x y :=
by { cases h, exacts [lex.inl (hr _ _ ‹_›), lex.inr (hs _ _ ‹_›), lex.sep _ _] }

lemma lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : lex r₁ s x y) : lex r₂ s x y :=
h.mono hr $ λ _ _, id

lemma lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b)  (h : lex r s₁ x y) : lex r s₂ x y :=
h.mono (λ _ _, id) hs

lemma lex_acc_inl {a} (aca : acc r a) : acc (lex r s) (inl a) :=
begin
  induction aca with a H IH,
  constructor, intros y h,
  cases h with a' _ h',
  exact IH _ h'
end

lemma lex_acc_inr (aca : ∀ a, acc (lex r s) (inl a)) {b} (acb : acc s b) : acc (lex r s) (inr b) :=
begin
  induction acb with b H IH,
  constructor, intros y h,
  cases h with _ _ _ b' _ h' a,
  { exact IH _ h' },
  { exact aca _ }
end

lemma lex_wf (ha : well_founded r) (hb : well_founded s) : well_founded (lex r s) :=
have aca : ∀ a, acc (lex r s) (inl a), from λ a, lex_acc_inl (ha.apply a),
⟨λ x, sum.rec_on x aca (λ b, lex_acc_inr aca (hb.apply b))⟩

end lex
end sum

namespace function

open sum

lemma injective.sum_elim {f : α → γ} {g : β → γ}
  (hf : injective f) (hg : injective g) (hfg : ∀ a b, f a ≠ g b) :
  injective (sum.elim f g)
| (inl x) (inl y) h := congr_arg inl $ hf h
| (inl x) (inr y) h := (hfg x y h).elim
| (inr x) (inl y) h := (hfg y x h.symm).elim
| (inr x) (inr y) h := congr_arg inr $ hg h

lemma injective.sum_map {f : α → β} {g : α' → β'} (hf : injective f) (hg : injective g) :
  injective (sum.map f g)
| (inl x) (inl y) h := congr_arg inl $ hf $ inl.inj h
| (inr x) (inr y) h := congr_arg inr $ hg $ inr.inj h

lemma surjective.sum_map {f : α → β} {g : α' → β'} (hf : surjective f) (hg : surjective g) :
  surjective (sum.map f g)
| (inl y) := let ⟨x, hx⟩ := hf y in ⟨inl x, congr_arg inl hx⟩
| (inr y) := let ⟨x, hx⟩ := hg y in ⟨inr x, congr_arg inr hx⟩

end function


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.indicator_function
import Mathlib.order.filter.at_top_bot
import Mathlib.PostPort

universes u_1 u_3 u_2

namespace Mathlib

/-!
# Indicator function and filters

Properties of indicator functions involving `=ᶠ` and `≤ᶠ`.

## Tags
indicator, characteristic, filter
-/

theorem indicator_eventually_eq {α : Type u_1} {M : Type u_3} [HasZero M] {s : set α} {t : set α}
    {f : α → M} {g : α → M} {l : filter α} (hf : filter.eventually_eq (l ⊓ filter.principal s) f g)
    (hs : filter.eventually_eq l s t) :
    filter.eventually_eq l (set.indicator s f) (set.indicator t g) :=
  sorry

theorem indicator_union_eventually_eq {α : Type u_1} {M : Type u_3} [add_monoid M] {s : set α}
    {t : set α} {f : α → M} {l : filter α} (h : filter.eventually (fun (a : α) => ¬a ∈ s ∩ t) l) :
    filter.eventually_eq l (set.indicator (s ∪ t) f) (set.indicator s f + set.indicator t f) :=
  filter.eventually.mono h
    fun (a : α) (ha : ¬a ∈ s ∩ t) => set.indicator_union_of_not_mem_inter ha f

theorem indicator_eventually_le_indicator {α : Type u_1} {β : Type u_2} [HasZero β] [preorder β]
    {s : set α} {f : α → β} {g : α → β} {l : filter α}
    (h : filter.eventually_le (l ⊓ filter.principal s) f g) :
    filter.eventually_le l (set.indicator s f) (set.indicator s g) :=
  filter.eventually.mono (iff.mp filter.eventually_inf_principal h)
    fun (a : α) (h : a ∈ s → f a ≤ g a) => set.indicator_rel_indicator (le_refl 0) h

theorem tendsto_indicator_of_monotone {α : Type u_1} {β : Type u_2} {ι : Type u_3} [preorder ι]
    [HasZero β] (s : ι → set α) (hs : monotone s) (f : α → β) (a : α) :
    filter.tendsto (fun (i : ι) => set.indicator (s i) f a) filter.at_top
        (pure (set.indicator (set.Union fun (i : ι) => s i) f a)) :=
  sorry

theorem tendsto_indicator_of_antimono {α : Type u_1} {β : Type u_2} {ι : Type u_3} [preorder ι]
    [HasZero β] (s : ι → set α) (hs : ∀ {i j : ι}, i ≤ j → s j ⊆ s i) (f : α → β) (a : α) :
    filter.tendsto (fun (i : ι) => set.indicator (s i) f a) filter.at_top
        (pure (set.indicator (set.Inter fun (i : ι) => s i) f a)) :=
  sorry

theorem tendsto_indicator_bUnion_finset {α : Type u_1} {β : Type u_2} {ι : Type u_3} [HasZero β]
    (s : ι → set α) (f : α → β) (a : α) :
    filter.tendsto
        (fun (n : finset ι) =>
          set.indicator (set.Union fun (i : ι) => set.Union fun (H : i ∈ n) => s i) f a)
        filter.at_top (pure (set.indicator (set.Union s) f a)) :=
  sorry

end Mathlib