import .affnK
import .affnKcoord_vectorspace

/-
    ********************
    *** Affine space ***
    ********************
-/
universes u
open_locale affine

section implicitK
variables
{K : Type u} [field K] [inhabited K]
{dim : nat} {id_vec : fin dim → nat }{f : fm K dim id_vec} (s : spc K f)
{dim2 : nat } {id_vec2 : fin dim2 → nat} {f2 : fm K dim2 id_vec2} (s2 : spc K f2)

/-
Definitions of affine operations
-/
@[simp]
def sub_point_point (p1 p2 : point s) : vectr s := mk_vectr' s (p1.coords -ᵥ p2.coords)
@[simp]
def add_point_vectr (p : point s) (v : vectr s) : point s :=
    mk_point' s (v.coords +ᵥ p.coords) -- reorder assumes order is irrelevant
@[simp]
def add_vectr_point (v : vectr s) (p : point s) : point s :=
    mk_point' s (v.coords +ᵥ p.coords)

instance : has_vadd (vectr s) (point s) := ⟨add_vectr_point s⟩
/-
The 0 vectr plus any particular point is the particular point unchanged
-/
lemma zero_vectr_vadd'_a1 : ∀ p : point s, (0 : vectr s) +ᵥ p = p := begin
    intros,
    ext,
    dsimp only [has_vadd.vadd],
    dsimp only [add_vectr_point, mk_point'],
    dsimp only [has_vadd.vadd],
    dsimp only [aff_vec_group_action, add_vec_pt],
    simp only [add_right_eq_self],
    dsimp only [has_zero.zero],
    dsimp only [vectr_zero, mk_vectr, mk_vec_n, mk_vec, vector.nth],
    simp only [list.nth_le_repeat],
    refl,
end

-- SULLIVAN: The following proof is slow to build. I simplified the
-- second simp somewhat but it's still very slow. Analyze & improve.
/-
vectr addition is associative with the action of vectrs on points
-/
lemma vectr_add_assoc'_a1 : ∀
    (g1 g2 : vectr s)
    (p : point s),
    g1 +ᵥ (g2 +ᵥ p) = g1 + g2 +ᵥ p :=
    begin
        intros, ext,
        repeat {
        have h0 : (g1 +ᵥ (g2 +ᵥ p)).coords = (g1.coords +ᵥ (g2.coords +ᵥ p.coords)) := rfl,
        have h1 : (g1 + g2 +ᵥ p).coords = (g1.coords +ᵥ g2.coords +ᵥ p.coords) := rfl,
        rw [h0,h1],
        simp *,
        simp [has_vadd.vadd, has_add.add, add_semigroup.add, add_zero_class.add,
            add_monoid.add, add_group.add, distrib.add],
        cc,
        }
    end

/-
@[protect_proj] class add_action (G : Type*) (P : Type*) [add_monoid G] extends has_vadd G P :=
(zero_vadd : ∀ p : P, (0 : G) +ᵥ p = p)
(add_vadd : ∀ (g₁ g₂ : G) (p : P), (g₁ + g₂) +ᵥ p = g₁ +ᵥ (g₂ +ᵥ p))
-/
instance vectr_add_action: add_action (vectr s) (point s) :=
⟨
begin
    exact zero_vectr_vadd'_a1 s
end,
begin
    let h0 := vectr_add_assoc'_a1 s,
    intros,
    exact (h0 g₁ g₂ p).symm
end
⟩

/-
point differencing operation
-/
@[simp]
def aff_point_group_sub : point s → point s → vectr s := sub_point_point s
instance point_has_vsub : has_vsub (vectr s) (point s) := ⟨ aff_point_group_sub s ⟩

/-
point is a nonempty set
-/
instance : nonempty (point s) := ⟨mk_point s ⟨list.repeat 0 dim, by simp only [list.length_repeat]⟩⟩

/-
Requirement for affine spaces
-/
lemma point_vsub_vadd_a1 : ∀ (p1 p2 : (point s)), (p1 -ᵥ p2) +ᵥ p2 = p1 := begin
    intros, ext,
    dsimp only [has_vsub.vsub, has_vadd.vadd],
    dsimp only [add_vectr_point, aff_point_group_sub, mk_point', sub_point_point, mk_vectr'],
    dsimp only [has_vsub.vsub, has_vadd.vadd],
    dsimp only [aff_vec_group_action, aff_pt_group_sub, add_vec_pt, sub_pt_pt],
    simp only [add_sub_cancel'_right]
end

/-
Requirement for affine spaces
-/
lemma point_vadd_vsub_a1 : ∀ (g : vectr s) (p : point s), g +ᵥ p -ᵥ p = g :=
begin
    intros, ext,
    repeat {
    have h0 : ((g +ᵥ p -ᵥ p) : vectr s).coords = (g.coords +ᵥ p.coords -ᵥ p.coords) := rfl,
    rw h0,
    simp *,
    }
end

--final instance showing vectrs and points form an affine space
instance : affine_space (vectr s) (point s) := ⟨
    point_vsub_vadd_a1 s,
    point_vadd_vsub_a1 s,
⟩
end implicitK


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.succ_pred.basic

/-!
# Successors and predecessors of naturals

In this file, we show that `ℕ` is both an archimedean `succ_order` and an archimedean `pred_order`.
-/

open function nat

@[reducible] -- so that Lean reads `nat.succ` through `succ_order.succ`
instance : succ_order ℕ :=
{ succ := succ,
  ..succ_order.of_succ_le_iff succ (λ a b, iff.rfl) }

@[reducible] -- so that Lean reads `nat.pred` through `pred_order.pred`
instance : pred_order ℕ :=
{ pred := pred,
  pred_le := pred_le,
  minimal_of_le_pred := λ a ha b h, begin
    cases a,
    { exact b.not_lt_zero h },
    { exact nat.lt_irrefl a ha }
  end,
  le_pred_of_lt := λ a b h, begin
    cases b,
    { exact (a.not_lt_zero h).elim },
    { exact le_of_succ_le_succ h }
  end,
  le_of_pred_lt := λ a b h, begin
    cases a,
    { exact b.zero_le },
    { exact h }
  end }

lemma nat.succ_iterate (a : ℕ) : ∀ n, succ^[n] a = a + n
| 0       := rfl
| (n + 1) := by { rw [function.iterate_succ', add_succ], exact congr_arg _ n.succ_iterate }

lemma nat.pred_iterate (a : ℕ) : ∀ n, pred^[n] a = a - n
| 0       := rfl
| (n + 1) := by { rw [function.iterate_succ', sub_succ], exact congr_arg _ n.pred_iterate }

instance : is_succ_archimedean ℕ :=
⟨λ a b h, ⟨b - a, by rw [nat.succ_iterate, add_tsub_cancel_of_le h]⟩⟩

instance : is_pred_archimedean ℕ :=
⟨λ a b h, ⟨b - a, by rw [nat.pred_iterate, tsub_tsub_cancel_of_le h]⟩⟩


import tactic

def gcounter (n: ℕ) : Type := array n ℕ

def new (n: ℕ) : gcounter n := { data := λ _, 0 }

def inc {n: ℕ} (g: gcounter n) (index: fin n) (value: ℕ) : gcounter n :=
	g.write index $ g.read index + value

def merge {n: ℕ} (g₁: gcounter n) (g₂: gcounter n) : gcounter n :=
	array.map₂ max g₁ g₂

def value {n: ℕ} (g: gcounter n) : ℕ :=
	array.foldl g 0 (+)

lemma merge_idempotent {n: ℕ} (g: gcounter n) : merge g g = g :=
begin
	dsimp only [merge],
	apply array.ext,
	intro,
	simp only [array.read_map₂, max_eq_right, eq_self_iff_true],
end

lemma merge_commutative {n: ℕ} (g₁ g₂: gcounter n) : merge g₁ g₂ = merge g₂ g₁ :=
begin
	dsimp only [merge],
	apply array.ext,
	intro,
	simp only [array.read_map₂, max_comm],
end

lemma merge_associative
 {n: ℕ} (g₁ g₂ g₃: gcounter n) : merge g₁ (merge g₂ g₃) = merge (merge g₁ g₂) g₃ :=
begin
	dsimp only [merge],
	apply array.ext,
	intro,
	simp only [array.read_map₂, max_assoc],
end

lemma inc_merge_increasing
	{n: ℕ} (v: ℕ) (i: fin n) (g: gcounter n) : merge (inc g i v) g = inc g i v :=
begin
	dsimp only [merge, inc],
	apply array.ext,
	intro,
	simp only [array.read_map₂, max_eq_left_iff],

	by_cases i = i_1,
	simp only [h, array.read_write],
	linarith,

	rwa array.read_write_of_ne,
end

lemma inc_value_increasing_aux₁
	(a b: ℕ) (li: list ℕ) : list.foldl (+) (a + b) li = list.foldl (+) a li + b :=
begin
	induction li generalizing a b,
	refl,
	simp only [list.foldl, add_right_comm, li_ih],
end

lemma inc_value_increasing_aux₂
	(a b i_val: ℕ) (li: list ℕ) (h: i_val < li.length):
	list.foldl has_add.add a (li.update_nth i_val (li.nth_le i_val h + b)) =
	list.foldl has_add.add a li + b :=
begin
	induction li generalizing a b i_val,

	rw list.length at h,
	linarith,

	cases i_val,
	simp only [list.update_nth, list.nth_le, list.foldl, ← add_assoc],

	apply inc_value_increasing_aux₁,
	apply li_ih,
end

lemma inc_value_increasing
	{n: ℕ} (v: ℕ) (i: fin n) (g: gcounter n) : value (inc g i v) = value g + v :=
begin
	simp only [inc, value, ← array.to_list_foldl, array.write_to_list],

	cases i,
	rw [← array.to_list_nth_le],

	generalize h : array.to_list g = li,
	simp only [h, add_comm],
	rw [add_comm, add_comm v],
	apply inc_value_increasing_aux₂,

	rwa array.to_list_length,
end

lemma value_new_aux₁ {n: ℕ} : (new n).to_list = list.repeat 0 n :=
begin
	apply list.ext_le,
	simp only [array.to_list_length, list.length_repeat],

	intros,
	rw [list.nth_le_repeat],
	rw [list.length_repeat] at h₂,

	rw array.to_list_nth_le,
	simp only [new, array.read, d_array.read],
	assumption,
end

lemma value_new_aux₂ {n: ℕ} : list.foldl (+) 0 (list.repeat 0 n) = 0 :=
begin
	induction n,
	simp only [list.repeat, list.foldl, add_zero],
	assumption,
end

lemma value_new {n: ℕ} : value (new n) = 0 :=
begin
	simp only [value, ← array.to_list_foldl, add_comm, value_new_aux₁, value_new_aux₂],
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import order.bounds

/-!
# Theory of complete lattices

## Main definitions

* `Sup` and `Inf` are the supremum and the infimum of a set;
* `supr (f : ι → α)` and `infi (f : ι → α)` are indexed supremum and infimum of a function,
  defined as `Sup` and `Inf` of the range of this function;
* `class complete_lattice`: a bounded lattice such that `Sup s` is always the least upper boundary
  of `s` and `Inf s` is always the greatest lower boundary of `s`;
* `class complete_linear_order`: a linear ordered complete lattice.

## Naming conventions

We use `Sup`/`Inf`/`supr`/`infi` for the corresponding functions in the statement. Sometimes we
also use `bsupr`/`binfi` for "bounded" supremum or infimum, i.e. one of `⨆ i ∈ s, f i`,
`⨆ i (hi : p i), f i`, or more generally `⨆ i (hi : p i), f i hi`.

## Notation

* `⨆ i, f i` : `supr f`, the supremum of the range of `f`;
* `⨅ i, f i` : `infi f`, the infimum of the range of `f`.
-/

set_option old_structure_cmd true
open set

variables {α β β₂ : Type*} {ι ι₂ : Sort*}

/-- class for the `Sup` operator -/
class has_Sup (α : Type*) := (Sup : set α → α)
/-- class for the `Inf` operator -/
class has_Inf (α : Type*) := (Inf : set α → α)

export has_Sup (Sup) has_Inf (Inf)

/-- Supremum of a set -/
add_decl_doc has_Sup.Sup
/-- Infimum of a set -/
add_decl_doc has_Inf.Inf

/-- Indexed supremum -/
def supr [has_Sup α] {ι} (s : ι → α) : α := Sup (range s)
/-- Indexed infimum -/
def infi [has_Inf α] {ι} (s : ι → α) : α := Inf (range s)

@[priority 50] instance has_Inf_to_nonempty (α) [has_Inf α] : nonempty α := ⟨Inf ∅⟩
@[priority 50] instance has_Sup_to_nonempty (α) [has_Sup α] : nonempty α := ⟨Sup ∅⟩

notation `⨆` binders `, ` r:(scoped f, supr f) := r
notation `⨅` binders `, ` r:(scoped f, infi f) := r

instance (α) [has_Inf α] : has_Sup (order_dual α) := ⟨(Inf : set α → α)⟩
instance (α) [has_Sup α] : has_Inf (order_dual α) := ⟨(Sup : set α → α)⟩

/--
Note that we rarely use `complete_semilattice_Sup`
(in fact, any such object is always a `complete_lattice`, so it's usually best to start there).

Nevertheless it is sometimes a useful intermediate step in constructions.
-/
class complete_semilattice_Sup (α : Type*) extends partial_order α, has_Sup α :=
(le_Sup : ∀s, ∀a∈s, a ≤ Sup s)
(Sup_le : ∀s a, (∀b∈s, b ≤ a) → Sup s ≤ a)

section
variables [complete_semilattice_Sup α] {s t : set α} {a b : α}

@[ematch] theorem le_Sup : a ∈ s → a ≤ Sup s := complete_semilattice_Sup.le_Sup s a

theorem Sup_le : (∀b∈s, b ≤ a) → Sup s ≤ a := complete_semilattice_Sup.Sup_le s a

lemma is_lub_Sup (s : set α) : is_lub s (Sup s) := ⟨assume x, le_Sup, assume x, Sup_le⟩

lemma is_lub.Sup_eq (h : is_lub s a) : Sup s = a := (is_lub_Sup s).unique h

theorem le_Sup_of_le (hb : b ∈ s) (h : a ≤ b) : a ≤ Sup s :=
le_trans h (le_Sup hb)

theorem Sup_le_Sup (h : s ⊆ t) : Sup s ≤ Sup t :=
(is_lub_Sup s).mono (is_lub_Sup t) h

@[simp] theorem Sup_le_iff : Sup s ≤ a ↔ (∀b ∈ s, b ≤ a) :=
is_lub_le_iff (is_lub_Sup s)

lemma le_Sup_iff :
  a ≤ Sup s ↔ (∀ b, (∀ x ∈ s, x ≤ b) → a ≤ b) :=
⟨λ h b hb, le_trans h (Sup_le hb), λ hb, hb _ (λ x, le_Sup)⟩

theorem Sup_le_Sup_of_forall_exists_le (h : ∀ x ∈ s, ∃ y ∈ t, x ≤ y) : Sup s ≤ Sup t :=
le_of_forall_le' begin
  simp only [Sup_le_iff],
  introv h₀ h₁,
  rcases h _ h₁ with ⟨y,hy,hy'⟩,
  solve_by_elim [le_trans hy']
end

-- We will generalize this to conditionally complete lattices in `cSup_singleton`.
theorem Sup_singleton {a : α} : Sup {a} = a :=
is_lub_singleton.Sup_eq

end

/--
Note that we rarely use `complete_semilattice_Inf`
(in fact, any such object is always a `complete_lattice`, so it's usually best to start there).

Nevertheless it is sometimes a useful intermediate step in constructions.
-/
class complete_semilattice_Inf (α : Type*) extends partial_order α, has_Inf α :=
(Inf_le : ∀s, ∀a∈s, Inf s ≤ a)
(le_Inf : ∀s a, (∀b∈s, a ≤ b) → a ≤ Inf s)

section
variables [complete_semilattice_Inf α] {s t : set α} {a b : α}

@[ematch] theorem Inf_le : a ∈ s → Inf s ≤ a := complete_semilattice_Inf.Inf_le s a

theorem le_Inf : (∀b∈s, a ≤ b) → a ≤ Inf s := complete_semilattice_Inf.le_Inf s a

lemma is_glb_Inf (s : set α) : is_glb s (Inf s) := ⟨assume a, Inf_le, assume a, le_Inf⟩

lemma is_glb.Inf_eq (h : is_glb s a) : Inf s = a := (is_glb_Inf s).unique h

theorem Inf_le_of_le (hb : b ∈ s) (h : b ≤ a) : Inf s ≤ a :=
le_trans (Inf_le hb) h

theorem Inf_le_Inf (h : s ⊆ t) : Inf t ≤ Inf s :=
(is_glb_Inf s).mono (is_glb_Inf t) h

@[simp] theorem le_Inf_iff : a ≤ Inf s ↔ (∀b ∈ s, a ≤ b) :=
le_is_glb_iff (is_glb_Inf s)

lemma Inf_le_iff :
  Inf s ≤ a ↔ (∀ b, (∀ x ∈ s, b ≤ x) → b ≤ a) :=
⟨λ h b hb, le_trans (le_Inf hb) h, λ hb, hb _ (λ x, Inf_le)⟩

theorem Inf_le_Inf_of_forall_exists_le (h : ∀ x ∈ s, ∃ y ∈ t, y ≤ x) : Inf t ≤ Inf s :=
le_of_forall_le begin
  simp only [le_Inf_iff],
  introv h₀ h₁,
  rcases h _ h₁ with ⟨y,hy,hy'⟩,
  solve_by_elim [le_trans _ hy']
end

-- We will generalize this to conditionally complete lattices in `cInf_singleton`.
theorem Inf_singleton {a : α} : Inf {a} = a :=
is_glb_singleton.Inf_eq

end

/-- A complete lattice is a bounded lattice which
  has suprema and infima for every subset. -/
@[protect_proj]
class complete_lattice (α : Type*) extends
  bounded_lattice α, complete_semilattice_Sup α, complete_semilattice_Inf α.

/-- Create a `complete_lattice` from a `partial_order` and `Inf` function
that returns the greatest lower bound of a set. Usually this constructor provides
poor definitional equalities.  If other fields are known explicitly, they should be
provided; for example, if `inf` is known explicitly, construct the `complete_lattice`
instance as
```
instance : complete_lattice my_T :=
{ inf := better_inf,
  le_inf := ...,
  inf_le_right := ...,
  inf_le_left := ...
  -- don't care to fix sup, Sup, bot, top
  ..complete_lattice_of_Inf my_T _ }
```
-/
def complete_lattice_of_Inf (α : Type*) [H1 : partial_order α]
  [H2 : has_Inf α] (is_glb_Inf : ∀ s : set α, is_glb s (Inf s)) :
  complete_lattice α :=
{ bot := Inf univ,
  bot_le := λ x, (is_glb_Inf univ).1 trivial,
  top := Inf ∅,
  le_top := λ a, (is_glb_Inf ∅).2 $ by simp,
  sup := λ a b, Inf {x | a ≤ x ∧ b ≤ x},
  inf := λ a b, Inf {a, b},
  le_inf := λ a b c hab hac, by { apply (is_glb_Inf _).2, simp [*] },
  inf_le_right := λ a b, (is_glb_Inf _).1 $ mem_insert_of_mem _ $ mem_singleton _,
  inf_le_left := λ a b, (is_glb_Inf _).1 $ mem_insert _ _,
  sup_le := λ a b c hac hbc, (is_glb_Inf _).1 $ by simp [*],
  le_sup_left := λ a b, (is_glb_Inf _).2 $ λ x, and.left,
  le_sup_right := λ a b, (is_glb_Inf _).2 $ λ x, and.right,
  le_Inf := λ s a ha, (is_glb_Inf s).2 ha,
  Inf_le := λ s a ha, (is_glb_Inf s).1 ha,
  Sup := λ s, Inf (upper_bounds s),
  le_Sup := λ s a ha, (is_glb_Inf (upper_bounds s)).2 $ λ b hb, hb ha,
  Sup_le := λ s a ha, (is_glb_Inf (upper_bounds s)).1 ha,
  .. H1, .. H2 }

/--
Any `complete_semilattice_Inf` is in fact a `complete_lattice`.

Note that this construction has bad definitional properties:
see the doc-string on `complete_lattice_of_Inf`.
-/
def complete_lattice_of_complete_semilattice_Inf (α : Type*) [complete_semilattice_Inf α] :
  complete_lattice α :=
complete_lattice_of_Inf α (λ s, is_glb_Inf s)

/-- Create a `complete_lattice` from a `partial_order` and `Sup` function
that returns the least upper bound of a set. Usually this constructor provides
poor definitional equalities.  If other fields are known explicitly, they should be
provided; for example, if `inf` is known explicitly, construct the `complete_lattice`
instance as
```
instance : complete_lattice my_T :=
{ inf := better_inf,
  le_inf := ...,
  inf_le_right := ...,
  inf_le_left := ...
  -- don't care to fix sup, Inf, bot, top
  ..complete_lattice_of_Sup my_T _ }
```
-/
def complete_lattice_of_Sup (α : Type*) [H1 : partial_order α]
  [H2 : has_Sup α] (is_lub_Sup : ∀ s : set α, is_lub s (Sup s)) :
  complete_lattice α :=
{ top := Sup univ,
  le_top := λ x, (is_lub_Sup univ).1 trivial,
  bot := Sup ∅,
  bot_le := λ x, (is_lub_Sup ∅).2 $ by simp,
  sup := λ a b, Sup {a, b},
  sup_le := λ a b c hac hbc, (is_lub_Sup _).2 (by simp [*]),
  le_sup_left := λ a b, (is_lub_Sup _).1 $ mem_insert _ _,
  le_sup_right := λ a b, (is_lub_Sup _).1 $ mem_insert_of_mem _ $ mem_singleton _,
  inf := λ a b, Sup {x | x ≤ a ∧ x ≤ b},
  le_inf := λ a b c hab hac, (is_lub_Sup _).1 $ by simp [*],
  inf_le_left := λ a b, (is_lub_Sup _).2 (λ x, and.left),
  inf_le_right := λ a b, (is_lub_Sup _).2 (λ x, and.right),
  Inf := λ s, Sup (lower_bounds s),
  Sup_le := λ s a ha, (is_lub_Sup s).2 ha,
  le_Sup := λ s a ha, (is_lub_Sup s).1 ha,
  Inf_le := λ s a ha, (is_lub_Sup (lower_bounds s)).2 (λ b hb, hb ha),
  le_Inf := λ s a ha, (is_lub_Sup (lower_bounds s)).1 ha,
  .. H1, .. H2 }

/--
Any `complete_semilattice_Sup` is in fact a `complete_lattice`.

Note that this construction has bad definitional properties:
see the doc-string on `complete_lattice_of_Sup`.
-/
def complete_lattice_of_complete_semilattice_Sup (α : Type*) [complete_semilattice_Sup α] :
  complete_lattice α :=
complete_lattice_of_Sup α (λ s, is_lub_Sup s)

/-- A complete linear order is a linear order whose lattice structure is complete. -/
class complete_linear_order (α : Type*) extends complete_lattice α, linear_order α

namespace order_dual
variable (α)

instance [complete_lattice α] : complete_lattice (order_dual α) :=
{ le_Sup := @complete_lattice.Inf_le α _,
  Sup_le := @complete_lattice.le_Inf α _,
  Inf_le := @complete_lattice.le_Sup α _,
  le_Inf := @complete_lattice.Sup_le α _,
  .. order_dual.bounded_lattice α, ..order_dual.has_Sup α, ..order_dual.has_Inf α }

instance [complete_linear_order α] : complete_linear_order (order_dual α) :=
{ .. order_dual.complete_lattice α, .. order_dual.linear_order α }

end order_dual

section
variables [complete_lattice α] {s t : set α} {a b : α}

theorem Inf_le_Sup (hs : s.nonempty) : Inf s ≤ Sup s :=
is_glb_le_is_lub (is_glb_Inf s) (is_lub_Sup s) hs

theorem Sup_union {s t : set α} : Sup (s ∪ t) = Sup s ⊔ Sup t :=
((is_lub_Sup s).union (is_lub_Sup t)).Sup_eq

theorem Sup_inter_le {s t : set α} : Sup (s ∩ t) ≤ Sup s ⊓ Sup t :=
by finish
/-
  Sup_le (assume a ⟨a_s, a_t⟩, le_inf (le_Sup a_s) (le_Sup a_t))
-/

theorem Inf_union {s t : set α} : Inf (s ∪ t) = Inf s ⊓ Inf t :=
((is_glb_Inf s).union (is_glb_Inf t)).Inf_eq

theorem le_Inf_inter {s t : set α} : Inf s ⊔ Inf t ≤ Inf (s ∩ t) :=
@Sup_inter_le (order_dual α) _ _ _

@[simp] theorem Sup_empty : Sup ∅ = (⊥ : α) :=
(@is_lub_empty α _).Sup_eq

@[simp] theorem Inf_empty : Inf ∅ = (⊤ : α) :=
(@is_glb_empty α _).Inf_eq

@[simp] theorem Sup_univ : Sup univ = (⊤ : α) :=
(@is_lub_univ α _).Sup_eq

@[simp] theorem Inf_univ : Inf univ = (⊥ : α) :=
(@is_glb_univ α _).Inf_eq

-- TODO(Jeremy): get this automatically
@[simp] theorem Sup_insert {a : α} {s : set α} : Sup (insert a s) = a ⊔ Sup s :=
((is_lub_Sup s).insert a).Sup_eq

@[simp] theorem Inf_insert {a : α} {s : set α} : Inf (insert a s) = a ⊓ Inf s :=
((is_glb_Inf s).insert a).Inf_eq

theorem Sup_le_Sup_of_subset_instert_bot (h : s ⊆ insert ⊥ t) : Sup s ≤ Sup t :=
le_trans (Sup_le_Sup h) (le_of_eq (trans Sup_insert bot_sup_eq))

theorem Inf_le_Inf_of_subset_insert_top (h : s ⊆ insert ⊤ t) : Inf t ≤ Inf s :=
le_trans (le_of_eq (trans top_inf_eq.symm Inf_insert.symm)) (Inf_le_Inf h)

theorem Sup_pair {a b : α} : Sup {a, b} = a ⊔ b :=
(@is_lub_pair α _ a b).Sup_eq

theorem Inf_pair {a b : α} : Inf {a, b} = a ⊓ b :=
(@is_glb_pair α _ a b).Inf_eq

@[simp] theorem Inf_eq_top : Inf s = ⊤ ↔ (∀a∈s, a = ⊤) :=
iff.intro
  (assume h a ha, top_unique $ h ▸ Inf_le ha)
  (assume h, top_unique $ le_Inf $ assume a ha, top_le_iff.2 $ h a ha)

lemma eq_singleton_top_of_Inf_eq_top_of_nonempty {s : set α}
  (h_inf : Inf s = ⊤) (hne : s.nonempty) : s = {⊤} :=
by { rw set.eq_singleton_iff_nonempty_unique_mem, rw Inf_eq_top at h_inf, exact ⟨hne, h_inf⟩, }

@[simp] theorem Sup_eq_bot : Sup s = ⊥ ↔ (∀a∈s, a = ⊥) :=
@Inf_eq_top (order_dual α) _ _

lemma eq_singleton_bot_of_Sup_eq_bot_of_nonempty {s : set α}
  (h_sup : Sup s = ⊥) (hne : s.nonempty) : s = {⊥} :=
by { rw set.eq_singleton_iff_nonempty_unique_mem, rw Sup_eq_bot at h_sup, exact ⟨hne, h_sup⟩, }

end

section complete_linear_order
variables [complete_linear_order α] {s t : set α} {a b : α}

lemma Inf_lt_iff : Inf s < b ↔ (∃a∈s, a < b) :=
is_glb_lt_iff (is_glb_Inf s)

lemma lt_Sup_iff : b < Sup s ↔ (∃a∈s, b < a) :=
lt_is_lub_iff (is_lub_Sup s)

lemma Sup_eq_top : Sup s = ⊤ ↔ (∀b<⊤, ∃a∈s, b < a) :=
iff.intro
  (assume (h : Sup s = ⊤) b hb, by rwa [←h, lt_Sup_iff] at hb)
  (assume h, top_unique $ le_of_not_gt $ assume h',
    let ⟨a, ha, h⟩ := h _ h' in
    lt_irrefl a $ lt_of_le_of_lt (le_Sup ha) h)

lemma Inf_eq_bot : Inf s = ⊥ ↔ (∀b>⊥, ∃a∈s, a < b) :=
@Sup_eq_top (order_dual α) _ _

lemma lt_supr_iff {f : ι → α} : a < supr f ↔ (∃i, a < f i) :=
lt_Sup_iff.trans exists_range_iff

lemma infi_lt_iff {f : ι → α} : infi f < a ↔ (∃i, f i < a) :=
Inf_lt_iff.trans exists_range_iff

end complete_linear_order

/-
### supr & infi
-/

section
variables [complete_lattice α] {s t : ι → α} {a b : α}

-- TODO: this declaration gives error when starting smt state
--@[ematch]
theorem le_supr (s : ι → α) (i : ι) : s i ≤ supr s :=
le_Sup ⟨i, rfl⟩

@[ematch] theorem le_supr' (s : ι → α) (i : ι) : (: s i ≤ supr s :) :=
le_Sup ⟨i, rfl⟩

/- TODO: this version would be more powerful, but, alas, the pattern matcher
   doesn't accept it.
@[ematch] theorem le_supr' (s : ι → α) (i : ι) : (: s i :) ≤ (: supr s :) :=
le_Sup ⟨i, rfl⟩
-/

lemma is_lub_supr : is_lub (range s) (⨆j, s j) := is_lub_Sup _

lemma is_lub.supr_eq (h : is_lub (range s) a) : (⨆j, s j) = a := h.Sup_eq

lemma is_glb_infi : is_glb (range s) (⨅j, s j) := is_glb_Inf _

lemma is_glb.infi_eq (h : is_glb (range s) a) : (⨅j, s j) = a := h.Inf_eq

theorem le_supr_of_le (i : ι) (h : a ≤ s i) : a ≤ supr s :=
le_trans h (le_supr _ i)

theorem le_bsupr {p : ι → Prop} {f : Π i (h : p i), α} (i : ι) (hi : p i) :
  f i hi ≤ ⨆ i hi, f i hi :=
le_supr_of_le i $ le_supr (f i) hi

theorem le_bsupr_of_le {p : ι → Prop} {f : Π i (h : p i), α} (i : ι) (hi : p i) (h : a ≤ f i hi) :
  a ≤ ⨆ i hi, f i hi :=
le_trans h (le_bsupr i hi)

theorem supr_le (h : ∀i, s i ≤ a) : supr s ≤ a :=
Sup_le $ assume b ⟨i, eq⟩, eq ▸ h i

theorem bsupr_le {p : ι → Prop} {f : Π i (h : p i), α} (h : ∀ i hi, f i hi ≤ a) :
  (⨆ i (hi : p i), f i hi) ≤ a :=
supr_le $ λ i, supr_le $ h i

theorem bsupr_le_supr (p : ι → Prop) (f : ι → α) : (⨆ i (H : p i), f i) ≤ ⨆ i, f i :=
bsupr_le (λ i hi, le_supr f i)

theorem supr_le_supr (h : ∀i, s i ≤ t i) : supr s ≤ supr t :=
supr_le $ assume i, le_supr_of_le i (h i)

theorem supr_le_supr2 {t : ι₂ → α} (h : ∀i, ∃j, s i ≤ t j) : supr s ≤ supr t :=
supr_le $ assume j, exists.elim (h j) le_supr_of_le

theorem bsupr_le_bsupr {p : ι → Prop} {f g : Π i (hi : p i), α} (h : ∀ i hi, f i hi ≤ g i hi) :
  (⨆ i hi, f i hi) ≤ ⨆ i hi, g i hi :=
bsupr_le $ λ i hi, le_trans (h i hi) (le_bsupr i hi)

theorem supr_le_supr_const (h : ι → ι₂) : (⨆ i:ι, a) ≤ (⨆ j:ι₂, a) :=
supr_le $ le_supr _ ∘ h

theorem bsupr_le_bsupr' {p q : ι → Prop} (hpq : ∀ i, p i → q i) {f : ι → α} :
  (⨆ i (hpi : p i), f i) ≤ ⨆ i (hqi : q i), f i :=
supr_le_supr $ λ i, supr_le_supr_const (hpq i)

@[simp] theorem supr_le_iff : supr s ≤ a ↔ (∀i, s i ≤ a) :=
(is_lub_le_iff is_lub_supr).trans forall_range_iff

theorem supr_lt_iff : supr s < a ↔ ∃ b < a, ∀ i, s i ≤ b :=
⟨λ h, ⟨supr s, h, λ i, le_supr s i⟩, λ ⟨b, hba, hsb⟩, (supr_le hsb).trans_lt hba⟩

theorem Sup_eq_supr {s : set α} : Sup s = (⨆a ∈ s, a) :=
le_antisymm
  (Sup_le $ assume b h, le_supr_of_le b $ le_supr _ h)
  (supr_le $ assume b, supr_le $ assume h, le_Sup h)

lemma Sup_sUnion {s : set (set α)} :
  Sup (⋃₀ s) = ⨆ (t ∈ s), Sup t :=
begin
  apply le_antisymm,
  { apply Sup_le (λ b hb, _),
    rcases hb with ⟨t, ts, bt⟩,
    apply le_trans _ (le_supr _ t),
    exact le_trans (le_Sup bt) (le_supr _ ts), },
  { apply supr_le (λ t, _),
    exact supr_le (λ ts, Sup_le_Sup (λ x xt, ⟨t, ts, xt⟩)) }
end

lemma le_supr_iff : (a ≤ supr s) ↔ (∀ b, (∀ i, s i ≤ b) → a ≤ b) :=
⟨λ h b hb, le_trans h (supr_le hb), λ h, h _ $ λ i, le_supr s i⟩

lemma monotone.le_map_supr [complete_lattice β] {f : α → β} (hf : monotone f) :
  (⨆ i, f (s i)) ≤ f (supr s) :=
supr_le $ λ i, hf $ le_supr _ _

lemma monotone.le_map_supr2 [complete_lattice β] {f : α → β} (hf : monotone f)
  {ι' : ι → Sort*} (s : Π i, ι' i → α) :
  (⨆ i (h : ι' i), f (s i h)) ≤ f (⨆ i (h : ι' i), s i h) :=
calc (⨆ i h, f (s i h)) ≤ (⨆ i, f (⨆ h, s i h)) :
  supr_le_supr $ λ i, hf.le_map_supr
... ≤ f (⨆ i (h : ι' i), s i h) : hf.le_map_supr

lemma monotone.le_map_Sup [complete_lattice β] {s : set α} {f : α → β} (hf : monotone f) :
  (⨆a∈s, f a) ≤ f (Sup s) :=
by rw [Sup_eq_supr]; exact hf.le_map_supr2 _

lemma supr_comp_le {ι' : Sort*} (f : ι' → α) (g : ι → ι') :
  (⨆ x, f (g x)) ≤ ⨆ y, f y :=
supr_le_supr2 $ λ x, ⟨_, le_refl _⟩

lemma monotone.supr_comp_eq [preorder β] {f : β → α} (hf : monotone f)
  {s : ι → β} (hs : ∀ x, ∃ i, x ≤ s i) :
  (⨆ x, f (s x)) = ⨆ y, f y :=
le_antisymm (supr_comp_le _ _) (supr_le_supr2 $ λ x, (hs x).imp $ λ i hi, hf hi)

lemma function.surjective.supr_comp {α : Type*} [has_Sup α] {f : ι → ι₂}
  (hf : function.surjective f) (g : ι₂ → α) :
  (⨆ x, g (f x)) = ⨆ y, g y :=
by simp only [supr, hf.range_comp]

lemma supr_congr {α : Type*} [has_Sup α] {f : ι → α} {g : ι₂ → α} (h : ι → ι₂)
  (h1 : function.surjective h) (h2 : ∀ x, g (h x) = f x) : (⨆ x, f x) = ⨆ y, g y :=
by { convert h1.supr_comp g, exact (funext h2).symm }

-- TODO: finish doesn't do well here.
@[congr] theorem supr_congr_Prop {α : Type*} [has_Sup α] {p q : Prop} {f₁ : p → α} {f₂ : q → α}
  (pq : p ↔ q) (f : ∀x, f₁ (pq.mpr x) = f₂ x) : supr f₁ = supr f₂ :=
begin
  have := propext pq, subst this,
  congr' with x,
  apply f
end

theorem infi_le (s : ι → α) (i : ι) : infi s ≤ s i :=
Inf_le ⟨i, rfl⟩

@[ematch] theorem infi_le' (s : ι → α) (i : ι) : (: infi s ≤ s i :) :=
Inf_le ⟨i, rfl⟩

theorem infi_le_of_le (i : ι) (h : s i ≤ a) : infi s ≤ a :=
le_trans (infi_le _ i) h

theorem binfi_le {p : ι → Prop} {f : Π i (hi : p i), α} (i : ι) (hi : p i) :
  (⨅ i hi, f i hi) ≤ f i hi :=
infi_le_of_le i $ infi_le (f i) hi

theorem binfi_le_of_le {p : ι → Prop} {f : Π i (hi : p i), α} (i : ι) (hi : p i) (h : f i hi ≤ a) :
  (⨅ i hi, f i hi) ≤ a :=
le_trans (binfi_le i hi) h

theorem le_infi (h : ∀i, a ≤ s i) : a ≤ infi s :=
le_Inf $ assume b ⟨i, eq⟩, eq ▸ h i

theorem le_binfi {p : ι → Prop} {f : Π i (h : p i), α} (h : ∀ i hi, a ≤ f i hi) :
  a ≤ ⨅ i hi, f i hi :=
le_infi $ λ i, le_infi $ h i

theorem infi_le_binfi (p : ι → Prop) (f : ι → α) : (⨅ i, f i) ≤ ⨅ i (H : p i), f i :=
le_binfi (λ i hi, infi_le f i)

theorem infi_le_infi (h : ∀i, s i ≤ t i) : infi s ≤ infi t :=
le_infi $ assume i, infi_le_of_le i (h i)

theorem infi_le_infi2 {t : ι₂ → α} (h : ∀j, ∃i, s i ≤ t j) : infi s ≤ infi t :=
le_infi $ assume j, exists.elim (h j) infi_le_of_le

theorem binfi_le_binfi {p : ι → Prop} {f g : Π i (h : p i), α} (h : ∀ i hi, f i hi ≤ g i hi) :
  (⨅ i hi, f i hi) ≤ ⨅ i hi, g i hi :=
le_binfi $ λ i hi, le_trans (binfi_le i hi) (h i hi)

theorem infi_le_infi_const (h : ι₂ → ι) : (⨅ i:ι, a) ≤ (⨅ j:ι₂, a) :=
le_infi $ infi_le _ ∘ h

@[simp] theorem le_infi_iff : a ≤ infi s ↔ (∀i, a ≤ s i) :=
⟨assume : a ≤ infi s, assume i, le_trans this (infi_le _ _), le_infi⟩

theorem Inf_eq_infi {s : set α} : Inf s = (⨅a ∈ s, a) :=
@Sup_eq_supr (order_dual α) _ _

lemma monotone.map_infi_le [complete_lattice β] {f : α → β} (hf : monotone f) :
  f (infi s) ≤ (⨅ i, f (s i)) :=
le_infi $ λ i, hf $ infi_le _ _

lemma monotone.map_infi2_le [complete_lattice β] {f : α → β} (hf : monotone f)
  {ι' : ι → Sort*} (s : Π i, ι' i → α) :
  f (⨅ i (h : ι' i), s i h) ≤ (⨅ i (h : ι' i), f (s i h)) :=
@monotone.le_map_supr2 (order_dual α) (order_dual β) _ _ _ f hf.order_dual _ _

lemma monotone.map_Inf_le [complete_lattice β] {s : set α} {f : α → β} (hf : monotone f) :
  f (Inf s) ≤ ⨅ a∈s, f a :=
by rw [Inf_eq_infi]; exact hf.map_infi2_le _

lemma le_infi_comp {ι' : Sort*} (f : ι' → α) (g : ι → ι') :
  (⨅ y, f y) ≤ ⨅ x, f (g x) :=
infi_le_infi2 $ λ x, ⟨_, le_refl _⟩

lemma monotone.infi_comp_eq [preorder β] {f : β → α} (hf : monotone f)
  {s : ι → β} (hs : ∀ x, ∃ i, s i ≤ x) :
  (⨅ x, f (s x)) = ⨅ y, f y :=
le_antisymm (infi_le_infi2 $ λ x, (hs x).imp $ λ i hi, hf hi) (le_infi_comp _ _)

lemma function.surjective.infi_comp {α : Type*} [has_Inf α] {f : ι → ι₂}
  (hf : function.surjective f) (g : ι₂ → α) :
  (⨅ x, g (f x)) = ⨅ y, g y :=
@function.surjective.supr_comp _ _ (order_dual α) _ f hf g

lemma infi_congr {α : Type*} [has_Inf α] {f : ι → α} {g : ι₂ → α} (h : ι → ι₂)
  (h1 : function.surjective h) (h2 : ∀ x, g (h x) = f x) : (⨅ x, f x) = ⨅ y, g y :=
@supr_congr _ _ (order_dual α) _ _ _ h h1 h2

@[congr] theorem infi_congr_Prop {α : Type*} [has_Inf α] {p q : Prop} {f₁ : p → α} {f₂ : q → α}
  (pq : p ↔ q) (f : ∀x, f₁ (pq.mpr x) = f₂ x) : infi f₁ = infi f₂ :=
@supr_congr_Prop (order_dual α) _ p q f₁ f₂ pq f

lemma supr_const_le {x : α} : (⨆ (h : ι), x) ≤ x :=
supr_le (λ _, le_rfl)

lemma le_infi_const {x : α} : x ≤ (⨅ (h : ι), x) :=
le_infi (λ _, le_rfl)

-- We will generalize this to conditionally complete lattices in `cinfi_const`.
theorem infi_const [nonempty ι] {a : α} : (⨅ b:ι, a) = a :=
by rw [infi, range_const, Inf_singleton]

-- We will generalize this to conditionally complete lattices in `csupr_const`.
theorem supr_const [nonempty ι] {a : α} : (⨆ b:ι, a) = a :=
@infi_const (order_dual α) _ _ _ _

@[simp] lemma infi_top : (⨅i:ι, ⊤ : α) = ⊤ :=
top_unique $ le_infi $ assume i, le_refl _

@[simp] lemma supr_bot : (⨆i:ι, ⊥ : α) = ⊥ :=
@infi_top (order_dual α) _ _

@[simp] lemma infi_eq_top : infi s = ⊤ ↔ (∀i, s i = ⊤) :=
Inf_eq_top.trans forall_range_iff

@[simp] lemma supr_eq_bot : supr s = ⊥ ↔ (∀i, s i = ⊥) :=
Sup_eq_bot.trans forall_range_iff

@[simp] lemma infi_pos {p : Prop} {f : p → α} (hp : p) : (⨅ h : p, f h) = f hp :=
le_antisymm (infi_le _ _) (le_infi $ assume h, le_refl _)

@[simp] lemma infi_neg {p : Prop} {f : p → α} (hp : ¬ p) : (⨅ h : p, f h) = ⊤ :=
le_antisymm le_top $ le_infi $ assume h, (hp h).elim

@[simp] lemma supr_pos {p : Prop} {f : p → α} (hp : p) : (⨆ h : p, f h) = f hp :=
le_antisymm (supr_le $ assume h, le_refl _) (le_supr _ _)

@[simp] lemma supr_neg {p : Prop} {f : p → α} (hp : ¬ p) : (⨆ h : p, f h) = ⊥ :=
le_antisymm (supr_le $ assume h, (hp h).elim) bot_le

lemma supr_eq_dif {p : Prop} [decidable p] (a : p → α) :
  (⨆h:p, a h) = (if h : p then a h else ⊥) :=
by by_cases p; simp [h]

lemma supr_eq_if {p : Prop} [decidable p] (a : α) :
  (⨆h:p, a) = (if p then a else ⊥) :=
supr_eq_dif (λ _, a)

lemma infi_eq_dif {p : Prop} [decidable p] (a : p → α) :
  (⨅h:p, a h) = (if h : p then a h else ⊤) :=
@supr_eq_dif (order_dual α) _ _ _ _

lemma infi_eq_if {p : Prop} [decidable p] (a : α) :
  (⨅h:p, a) = (if p then a else ⊤) :=
infi_eq_dif (λ _, a)

-- TODO: should this be @[simp]?
theorem infi_comm {f : ι → ι₂ → α} : (⨅i, ⨅j, f i j) = (⨅j, ⨅i, f i j) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume j, infi_le_of_le j $ infi_le _ i)
  (le_infi $ assume j, le_infi $ assume i, infi_le_of_le i $ infi_le _ j)

/- TODO: this is strange. In the proof below, we get exactly the desired
   among the equalities, but close does not get it.
begin
  apply @le_antisymm,
    simp, intros,
    begin [smt]
      ematch, ematch, ematch, trace_state, have := le_refl (f i_1 i),
      trace_state, close
    end
end
-/

-- TODO: should this be @[simp]?
theorem supr_comm {f : ι → ι₂ → α} : (⨆i, ⨆j, f i j) = (⨆j, ⨆i, f i j) :=
@infi_comm (order_dual α) _ _ _ _

@[simp] theorem infi_infi_eq_left {b : β} {f : Πx:β, x = b → α} :
  (⨅x, ⨅h:x = b, f x h) = f b rfl :=
le_antisymm
  (infi_le_of_le b $ infi_le _ rfl)
  (le_infi $ assume b', le_infi $ assume eq, match b', eq with ._, rfl := le_refl _ end)

@[simp] theorem infi_infi_eq_right {b : β} {f : Πx:β, b = x → α} :
  (⨅x, ⨅h:b = x, f x h) = f b rfl :=
le_antisymm
  (infi_le_of_le b $ infi_le _ rfl)
  (le_infi $ assume b', le_infi $ assume eq, match b', eq with ._, rfl := le_refl _ end)

@[simp] theorem supr_supr_eq_left {b : β} {f : Πx:β, x = b → α} :
  (⨆x, ⨆h : x = b, f x h) = f b rfl :=
@infi_infi_eq_left (order_dual α) _ _ _ _

@[simp] theorem supr_supr_eq_right {b : β} {f : Πx:β, b = x → α} :
  (⨆x, ⨆h : b = x, f x h) = f b rfl :=
@infi_infi_eq_right (order_dual α) _ _ _ _

attribute [ematch] le_refl

theorem infi_subtype {p : ι → Prop} {f : subtype p → α} : (⨅ x, f x) = (⨅ i (h:p i), f ⟨i, h⟩) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume : p i, infi_le _ _)
  (le_infi $ assume ⟨i, h⟩, infi_le_of_le i $ infi_le _ _)

lemma infi_subtype' {p : ι → Prop} {f : ∀ i, p i → α} :
  (⨅ i (h : p i), f i h) = (⨅ x : subtype p, f x x.property) :=
(@infi_subtype _ _ _ p (λ x, f x.val x.property)).symm

lemma infi_subtype'' {ι} (s : set ι) (f : ι → α) :
  (⨅ i : s, f i) = ⨅ (t : ι) (H : t ∈ s), f t :=
infi_subtype

theorem infi_inf_eq {f g : ι → α} : (⨅ x, f x ⊓ g x) = (⨅ x, f x) ⊓ (⨅ x, g x) :=
le_antisymm
  (le_inf
    (le_infi $ assume i, infi_le_of_le i inf_le_left)
    (le_infi $ assume i, infi_le_of_le i inf_le_right))
  (le_infi $ assume i, le_inf
    (inf_le_left_of_le $ infi_le _ _)
    (inf_le_right_of_le $ infi_le _ _))

/- TODO: here is another example where more flexible pattern matching
   might help.

begin
  apply @le_antisymm,
  safe, pose h := f a ⊓ g a, begin [smt] ematch, ematch  end
end
-/

lemma infi_inf [h : nonempty ι] {f : ι → α} {a : α} : (⨅x, f x) ⊓ a = (⨅ x, f x ⊓ a) :=
by rw [infi_inf_eq, infi_const]

lemma inf_infi [nonempty ι] {f : ι → α} {a : α} : a ⊓ (⨅x, f x) = (⨅ x, a ⊓ f x) :=
by rw [inf_comm, infi_inf]; simp [inf_comm]

lemma binfi_inf {p : ι → Prop} {f : Π i (hi : p i), α} {a : α} (h : ∃ i, p i) :
  (⨅i (h : p i), f i h) ⊓ a = (⨅ i (h : p i), f i h ⊓ a) :=
by haveI : nonempty {i // p i} := (let ⟨i, hi⟩ := h in ⟨⟨i, hi⟩⟩);
  rw [infi_subtype', infi_subtype', infi_inf]

lemma inf_binfi {p : ι → Prop} {f : Π i (hi : p i), α} {a : α} (h : ∃ i, p i) :
  a ⊓ (⨅i (h : p i), f i h) = (⨅ i (h : p i), a ⊓ f i h) :=
by simpa only [inf_comm] using binfi_inf h

theorem supr_sup_eq {f g : β → α} : (⨆ x, f x ⊔ g x) = (⨆ x, f x) ⊔ (⨆ x, g x) :=
@infi_inf_eq (order_dual α) β _ _ _

lemma supr_sup [h : nonempty ι] {f : ι → α} {a : α} : (⨆ x, f x) ⊔ a = (⨆ x, f x ⊔ a) :=
@infi_inf (order_dual α) _ _ _ _ _

lemma sup_supr [nonempty ι] {f : ι → α} {a : α} : a ⊔ (⨆ x, f x) = (⨆ x, a ⊔ f x) :=
@inf_infi (order_dual α) _ _ _ _ _

/- supr and infi under Prop -/

@[simp] theorem infi_false {s : false → α} : infi s = ⊤ :=
le_antisymm le_top (le_infi $ assume i, false.elim i)

@[simp] theorem supr_false {s : false → α} : supr s = ⊥ :=
le_antisymm (supr_le $ assume i, false.elim i) bot_le

@[simp] theorem infi_true {s : true → α} : infi s = s trivial :=
le_antisymm (infi_le _ _) (le_infi $ assume ⟨⟩, le_refl _)

@[simp] theorem supr_true {s : true → α} : supr s = s trivial :=
le_antisymm (supr_le $ assume ⟨⟩, le_refl _) (le_supr _ _)

@[simp] theorem infi_exists {p : ι → Prop} {f : Exists p → α} :
  (⨅ x, f x) = (⨅ i, ⨅ h:p i, f ⟨i, h⟩) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume : p i, infi_le _ _)
  (le_infi $ assume ⟨i, h⟩, infi_le_of_le i $ infi_le _ _)

@[simp] theorem supr_exists {p : ι → Prop} {f : Exists p → α} :
  (⨆ x, f x) = (⨆ i, ⨆ h:p i, f ⟨i, h⟩) :=
@infi_exists (order_dual α) _ _ _ _

theorem infi_and {p q : Prop} {s : p ∧ q → α} : infi s = (⨅ h₁ h₂, s ⟨h₁, h₂⟩) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume j, infi_le _ _)
  (le_infi $ assume ⟨i, h⟩, infi_le_of_le i $ infi_le _ _)

/-- The symmetric case of `infi_and`, useful for rewriting into a infimum over a conjunction -/
lemma infi_and' {p q : Prop} {s : p → q → α} :
  (⨅ (h₁ : p) (h₂ : q), s h₁ h₂) = ⨅ (h : p ∧ q), s h.1 h.2 :=
by { symmetry, exact infi_and }

theorem supr_and {p q : Prop} {s : p ∧ q → α} : supr s = (⨆ h₁ h₂, s ⟨h₁, h₂⟩) :=
@infi_and (order_dual α) _ _ _ _

/-- The symmetric case of `supr_and`, useful for rewriting into a supremum over a conjunction -/
lemma supr_and' {p q : Prop} {s : p → q → α} :
  (⨆ (h₁ : p) (h₂ : q), s h₁ h₂) = ⨆ (h : p ∧ q), s h.1 h.2 :=
by { symmetry, exact supr_and }

theorem infi_or {p q : Prop} {s : p ∨ q → α} :
  infi s = (⨅ h : p, s (or.inl h)) ⊓ (⨅ h : q, s (or.inr h)) :=
le_antisymm
  (le_inf
    (infi_le_infi2 $ assume j, ⟨_, le_refl _⟩)
    (infi_le_infi2 $ assume j, ⟨_, le_refl _⟩))
  (le_infi $ assume i, match i with
  | or.inl i := inf_le_left_of_le $ infi_le _ _
  | or.inr j := inf_le_right_of_le $ infi_le _ _
  end)

theorem supr_or {p q : Prop} {s : p ∨ q → α} :
  (⨆ x, s x) = (⨆ i, s (or.inl i)) ⊔ (⨆ j, s (or.inr j)) :=
@infi_or (order_dual α) _ _ _ _

lemma Sup_range {α : Type*} [has_Sup α] {f : ι → α} : Sup (range f) = supr f := rfl

lemma Inf_range {α : Type*} [has_Inf α] {f : ι → α} : Inf (range f) = infi f := rfl

lemma supr_range {g : β → α} {f : ι → β} : (⨆b∈range f, g b) = (⨆i, g (f i)) :=
le_antisymm
  (supr_le $ assume b, supr_le $ assume ⟨i, (h : f i = b)⟩, h ▸ le_supr _ i)
  (supr_le $ assume i, le_supr_of_le (f i) $ le_supr (λp, g (f i)) (mem_range_self _))

lemma infi_range {g : β → α} {f : ι → β} : (⨅b∈range f, g b) = (⨅i, g (f i)) :=
@supr_range (order_dual α) _ _ _ _ _

theorem Inf_image {s : set β} {f : β → α} : Inf (f '' s) = (⨅ a ∈ s, f a) :=
by rw [← infi_subtype'', infi, range_comp, subtype.range_coe]

theorem Sup_image {s : set β} {f : β → α} : Sup (f '' s) = (⨆ a ∈ s, f a) :=
@Inf_image (order_dual α) _ _ _ _

/-
### supr and infi under set constructions
-/

theorem infi_emptyset {f : β → α} : (⨅ x ∈ (∅ : set β), f x) = ⊤ :=
by simp

theorem supr_emptyset {f : β → α} : (⨆ x ∈ (∅ : set β), f x) = ⊥ :=
by simp

theorem infi_univ {f : β → α} : (⨅ x ∈ (univ : set β), f x) = (⨅ x, f x) :=
by simp

theorem supr_univ {f : β → α} : (⨆ x ∈ (univ : set β), f x) = (⨆ x, f x) :=
by simp

theorem infi_union {f : β → α} {s t : set β} : (⨅ x ∈ s ∪ t, f x) = (⨅x∈s, f x) ⊓ (⨅x∈t, f x) :=
by simp only [← infi_inf_eq, infi_or]

lemma infi_split (f : β → α) (p : β → Prop) :
  (⨅ i, f i) = (⨅ i (h : p i), f i) ⊓ (⨅ i (h : ¬ p i), f i) :=
by simpa [classical.em] using @infi_union _ _ _ f {i | p i} {i | ¬ p i}

lemma infi_split_single (f : β → α) (i₀ : β) :
  (⨅ i, f i) = f i₀ ⊓ (⨅ i (h : i ≠ i₀), f i) :=
by convert infi_split _ _; simp

theorem infi_le_infi_of_subset {f : β → α} {s t : set β} (h : s ⊆ t) :
  (⨅ x ∈ t, f x) ≤ (⨅ x ∈ s, f x) :=
by rw [(union_eq_self_of_subset_left h).symm, infi_union]; exact inf_le_left

theorem supr_union {f : β → α} {s t : set β} : (⨆ x ∈ s ∪ t, f x) = (⨆x∈s, f x) ⊔ (⨆x∈t, f x) :=
@infi_union (order_dual α) _ _ _ _ _

lemma supr_split (f : β → α) (p : β → Prop) :
  (⨆ i, f i) = (⨆ i (h : p i), f i) ⊔ (⨆ i (h : ¬ p i), f i) :=
@infi_split (order_dual α) _ _ _ _

lemma supr_split_single (f : β → α) (i₀ : β) :
  (⨆ i, f i) = f i₀ ⊔ (⨆ i (h : i ≠ i₀), f i) :=
@infi_split_single (order_dual α) _ _ _ _

theorem supr_le_supr_of_subset {f : β → α} {s t : set β} (h : s ⊆ t) :
  (⨆ x ∈ s, f x) ≤ (⨆ x ∈ t, f x) :=
@infi_le_infi_of_subset (order_dual α) _ _ _ _ _ h

theorem infi_insert {f : β → α} {s : set β} {b : β} :
  (⨅ x ∈ insert b s, f x) = f b ⊓ (⨅x∈s, f x) :=
eq.trans infi_union $ congr_arg (λx:α, x ⊓ (⨅x∈s, f x)) infi_infi_eq_left

theorem supr_insert {f : β → α} {s : set β} {b : β} :
  (⨆ x ∈ insert b s, f x) = f b ⊔ (⨆x∈s, f x) :=
eq.trans supr_union $ congr_arg (λx:α, x ⊔ (⨆x∈s, f x)) supr_supr_eq_left

theorem infi_singleton {f : β → α} {b : β} : (⨅ x ∈ (singleton b : set β), f x) = f b :=
by simp

theorem infi_pair {f : β → α} {a b : β} : (⨅ x ∈ ({a, b} : set β), f x) = f a ⊓ f b :=
by rw [infi_insert, infi_singleton]

theorem supr_singleton {f : β → α} {b : β} : (⨆ x ∈ (singleton b : set β), f x) = f b :=
@infi_singleton (order_dual α) _ _ _ _

theorem supr_pair {f : β → α} {a b : β} : (⨆ x ∈ ({a, b} : set β), f x) = f a ⊔ f b :=
by rw [supr_insert, supr_singleton]

lemma infi_image {γ} {f : β → γ} {g : γ → α} {t : set β} :
  (⨅ c ∈ f '' t, g c) = (⨅ b ∈ t, g (f b)) :=
by rw [← Inf_image, ← Inf_image, ← image_comp]

lemma supr_image {γ} {f : β → γ} {g : γ → α} {t : set β} :
  (⨆ c ∈ f '' t, g c) = (⨆ b ∈ t, g (f b)) :=
@infi_image (order_dual α) _ _ _ _ _ _

/-!
### `supr` and `infi` under `Type`
-/

theorem infi_of_empty' (h : ι → false) {s : ι → α} : infi s = ⊤ :=
top_unique (le_infi $ assume i, (h i).elim)

theorem supr_of_empty' (h : ι → false) {s : ι → α} : supr s = ⊥ :=
bot_unique (supr_le $ assume i, (h i).elim)

theorem infi_of_empty (h : ¬nonempty ι) {s : ι → α} : infi s = ⊤ :=
infi_of_empty' (λ i, h ⟨i⟩)

theorem supr_of_empty (h : ¬nonempty ι) {s : ι → α} : supr s = ⊥ :=
supr_of_empty' (λ i, h ⟨i⟩)

@[simp] theorem infi_empty {s : empty → α} : infi s = ⊤ :=
infi_of_empty nonempty_empty

@[simp] theorem supr_empty {s : empty → α} : supr s = ⊥ :=
supr_of_empty nonempty_empty

lemma supr_bool_eq {f : bool → α} : (⨆b:bool, f b) = f tt ⊔ f ff :=
le_antisymm
  (supr_le $ assume b, match b with tt := le_sup_left | ff := le_sup_right end)
  (sup_le (le_supr _ _) (le_supr _ _))

lemma infi_bool_eq {f : bool → α} : (⨅b:bool, f b) = f tt ⊓ f ff :=
@supr_bool_eq (order_dual α) _ _

lemma is_glb_binfi {s : set β} {f : β → α} : is_glb (f '' s) (⨅ x ∈ s, f x) :=
by simpa only [range_comp, subtype.range_coe, infi_subtype'] using @is_glb_infi α s _ (f ∘ coe)

theorem supr_subtype {p : ι → Prop} {f : subtype p → α} : (⨆ x, f x) = (⨆ i (h:p i), f ⟨i, h⟩) :=
@infi_subtype (order_dual α) _ _ _ _

lemma supr_subtype' {p : ι → Prop} {f : ∀ i, p i → α} :
  (⨆ i (h : p i), f i h) = (⨆ x : subtype p, f x x.property) :=
(@supr_subtype _ _ _ p (λ x, f x.val x.property)).symm

lemma Sup_eq_supr' {s : set α} : Sup s = ⨆ x : s, (x : α) :=
by rw [Sup_eq_supr, supr_subtype']; refl

lemma is_lub_bsupr {s : set β} {f : β → α} : is_lub (f '' s) (⨆ x ∈ s, f x) :=
by simpa only [range_comp, subtype.range_coe, supr_subtype'] using @is_lub_supr α s _ (f ∘ coe)

theorem infi_sigma {p : β → Type*} {f : sigma p → α} : (⨅ x, f x) = (⨅ i (h:p i), f ⟨i, h⟩) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume : p i, infi_le _ _)
  (le_infi $ assume ⟨i, h⟩, infi_le_of_le i $ infi_le _ _)

theorem supr_sigma {p : β → Type*} {f : sigma p → α} : (⨆ x, f x) = (⨆ i (h:p i), f ⟨i, h⟩) :=
@infi_sigma (order_dual α) _ _ _ _

theorem infi_prod {γ : Type*} {f : β × γ → α} : (⨅ x, f x) = (⨅ i j, f (i, j)) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume j, infi_le _ _)
  (le_infi $ assume ⟨i, h⟩, infi_le_of_le i $ infi_le _ _)

theorem supr_prod {γ : Type*} {f : β × γ → α} : (⨆ x, f x) = (⨆ i j, f (i, j)) :=
@infi_prod (order_dual α) _ _ _ _

theorem infi_sum {γ : Type*} {f : β ⊕ γ → α} :
  (⨅ x, f x) = (⨅ i, f (sum.inl i)) ⊓ (⨅ j, f (sum.inr j)) :=
le_antisymm
  (le_inf
    (infi_le_infi2 $ assume i, ⟨_, le_refl _⟩)
    (infi_le_infi2 $ assume j, ⟨_, le_refl _⟩))
  (le_infi $ assume s, match s with
  | sum.inl i := inf_le_left_of_le $ infi_le _ _
  | sum.inr j := inf_le_right_of_le $ infi_le _ _
  end)

theorem supr_sum {γ : Type*} {f : β ⊕ γ → α} :
  (⨆ x, f x) = (⨆ i, f (sum.inl i)) ⊔ (⨆ j, f (sum.inr j)) :=
@infi_sum (order_dual α) _ _ _ _

theorem supr_option (f : option β → α) :
  (⨆ o, f o) = f none ⊔ ⨆ b, f (option.some b) :=
eq_of_forall_ge_iff $ λ c, by simp only [supr_le_iff, sup_le_iff, option.forall]

theorem infi_option (f : option β → α) :
  (⨅ o, f o) = f none ⊓ ⨅ b, f (option.some b) :=
@supr_option (order_dual α) _ _ _

/-!
### `supr` and `infi` under `ℕ`
-/

lemma supr_ge_eq_supr_nat_add {u : ℕ → α} (n : ℕ) : (⨆ i ≥ n, u i) = ⨆ i, u (i + n) :=
begin
  apply le_antisymm;
  simp only [supr_le_iff],
  { exact λ i hi, le_Sup ⟨i - n, by { dsimp only, rw nat.sub_add_cancel hi }⟩ },
  { exact λ i, le_Sup ⟨i + n, supr_pos (nat.le_add_left _ _)⟩ }
end

lemma infi_ge_eq_infi_nat_add {u : ℕ → α} (n : ℕ) : (⨅ i ≥ n, u i) = ⨅ i, u (i + n) :=
@supr_ge_eq_supr_nat_add (order_dual α) _ _ _

lemma monotone.supr_nat_add {f : ℕ → α} (hf : monotone f) (k : ℕ) :
  (⨆ n, f (n + k)) = ⨆ n, f n :=
le_antisymm (supr_le (λ i, (le_refl _).trans (le_supr _ (i + k))))
    (supr_le_supr (λ i, hf (nat.le_add_right i k)))

@[simp] lemma supr_infi_ge_nat_add (f : ℕ → α) (k : ℕ) :
  (⨆ n, ⨅ i ≥ n, f (i + k)) = ⨆ n, ⨅ i ≥ n, f i :=
begin
  have hf : monotone (λ n, ⨅ i ≥ n, f i),
    from λ n m hnm, le_infi (λ i, (infi_le _ i).trans (le_infi (λ h, infi_le _ (hnm.trans h)))),
  rw ←monotone.supr_nat_add hf k,
  { simp_rw [infi_ge_eq_infi_nat_add, ←nat.add_assoc], },
end

lemma sup_supr_nat_succ (u : ℕ → α) : u 0 ⊔ (⨆ i, u (i + 1)) = ⨆ i, u i :=
begin
  refine eq_of_forall_ge_iff (λ c, _),
  simp only [sup_le_iff, supr_le_iff],
  refine ⟨λ h, _, λ h, ⟨h _, λ i, h _⟩⟩,
  rintro (_|i),
  exacts [h.1, h.2 i]
end

lemma inf_infi_nat_succ (u : ℕ → α) : u 0 ⊓ (⨅ i, u (i + 1)) = ⨅ i, u i :=
@sup_supr_nat_succ (order_dual α) _ u

end

section complete_linear_order
variables [complete_linear_order α]

lemma supr_eq_top (f : ι → α) : supr f = ⊤ ↔ (∀b<⊤, ∃i, b < f i) :=
by simp only [← Sup_range, Sup_eq_top, set.exists_range_iff]

lemma infi_eq_bot (f : ι → α) : infi f = ⊥ ↔ (∀b>⊥, ∃i, f i < b) :=
by simp only [← Inf_range, Inf_eq_bot, set.exists_range_iff]

end complete_linear_order

/-!
### Instances
-/

instance complete_lattice_Prop : complete_lattice Prop :=
{ Sup    := λs, ∃a∈s, a,
  le_Sup := assume s a h p, ⟨a, h, p⟩,
  Sup_le := assume s a h ⟨b, h', p⟩, h b h' p,
  Inf    := λs, ∀a:Prop, a∈s → a,
  Inf_le := assume s a h p, p a h,
  le_Inf := assume s a h p b hb, h b hb p,
  .. bounded_distrib_lattice_Prop }

lemma Inf_Prop_eq {s : set Prop} : Inf s = (∀p ∈ s, p) := rfl

lemma Sup_Prop_eq {s : set Prop} : Sup s = (∃p ∈ s, p) := rfl

lemma infi_Prop_eq {ι : Sort*} {p : ι → Prop} : (⨅i, p i) = (∀i, p i) :=
le_antisymm (assume h i, h _ ⟨i, rfl⟩ ) (assume h p ⟨i, eq⟩, eq ▸ h i)

lemma supr_Prop_eq {ι : Sort*} {p : ι → Prop} : (⨆i, p i) = (∃i, p i) :=
le_antisymm (λ ⟨q, ⟨i, (eq : p i = q)⟩, hq⟩, ⟨i, eq.symm ▸ hq⟩) (λ ⟨i, hi⟩, ⟨p i, ⟨i, rfl⟩, hi⟩)

instance pi.has_Sup {α : Type*} {β : α → Type*} [Π i, has_Sup (β i)] : has_Sup (Π i, β i) :=
⟨λ s i, ⨆ f : s, (f : Π i, β i) i⟩

instance pi.has_Inf {α : Type*} {β : α → Type*} [Π i, has_Inf (β i)] : has_Inf (Π i, β i) :=
⟨λ s i, ⨅ f : s, (f : Π i, β i) i⟩

instance pi.complete_lattice {α : Type*} {β : α → Type*} [∀ i, complete_lattice (β i)] :
  complete_lattice (Π i, β i) :=
{ Sup := Sup,
  Inf := Inf,
  le_Sup := λ s f hf i, le_supr (λ f : s, (f : Π i, β i) i) ⟨f, hf⟩,
  Inf_le := λ s f hf i, infi_le (λ f : s, (f : Π i, β i) i) ⟨f, hf⟩,
  Sup_le := λ s f hf i, supr_le $ λ g, hf g g.2 i,
  le_Inf := λ s f hf i, le_infi $ λ g, hf g g.2 i,
  .. pi.bounded_lattice }

lemma Inf_apply {α : Type*} {β : α → Type*} [Π i, has_Inf (β i)]
  {s : set (Πa, β a)} {a : α} :
  (Inf s) a = (⨅ f : s, (f : Πa, β a) a) :=
rfl

lemma infi_apply {α : Type*} {β : α → Type*} {ι : Sort*} [Π i, has_Inf (β i)]
  {f : ι → Πa, β a} {a : α} :
  (⨅i, f i) a = (⨅i, f i a) :=
by rw [infi, Inf_apply, infi, infi, ← image_eq_range (λ f : Π i, β i, f a) (range f), ← range_comp]

lemma Sup_apply {α : Type*} {β : α → Type*} [Π i, has_Sup (β i)] {s : set (Πa, β a)} {a : α} :
  (Sup s) a = (⨆f:s, (f : Πa, β a) a) :=
rfl

lemma unary_relation_Sup_iff {α : Type*} (s : set (α → Prop)) {a : α} :
  Sup s a ↔ ∃ (r : α → Prop), r ∈ s ∧ r a :=
by { change (∃ _, _) ↔ _, simp [-eq_iff_iff] }

lemma binary_relation_Sup_iff {α β : Type*} (s : set (α → β → Prop)) {a : α} {b : β} :
  Sup s a b ↔ ∃ (r : α → β → Prop), r ∈ s ∧ r a b :=
by { change (∃ _, _) ↔ _, simp [-eq_iff_iff] }

lemma supr_apply {α : Type*} {β : α → Type*} {ι : Sort*} [Π i, has_Sup (β i)] {f : ι → Πa, β a}
  {a : α} :
  (⨆i, f i) a = (⨆i, f i a) :=
@infi_apply α (λ i, order_dual (β i)) _ _ f a

section complete_lattice
variables [preorder α] [complete_lattice β]

theorem monotone_Sup_of_monotone {s : set (α → β)} (m_s : ∀f∈s, monotone f) : monotone (Sup s) :=
assume x y h, supr_le $ λ f, le_supr_of_le f $ m_s f f.2 h

theorem monotone_Inf_of_monotone {s : set (α → β)} (m_s : ∀f∈s, monotone f) : monotone (Inf s) :=
assume x y h, le_infi $ λ f, infi_le_of_le f $ m_s f f.2 h

end complete_lattice

namespace prod
variables (α β)

instance [has_Inf α] [has_Inf β] : has_Inf (α × β) :=
⟨λs, (Inf (prod.fst '' s), Inf (prod.snd '' s))⟩

instance [has_Sup α] [has_Sup β] : has_Sup (α × β) :=
⟨λs, (Sup (prod.fst '' s), Sup (prod.snd '' s))⟩

instance [complete_lattice α] [complete_lattice β] : complete_lattice (α × β) :=
{ le_Sup := assume s p hab, ⟨le_Sup $ mem_image_of_mem _ hab, le_Sup $ mem_image_of_mem _ hab⟩,
  Sup_le := assume s p h,
    ⟨ Sup_le $ ball_image_of_ball $ assume p hp, (h p hp).1,
      Sup_le $ ball_image_of_ball $ assume p hp, (h p hp).2⟩,
  Inf_le := assume s p hab, ⟨Inf_le $ mem_image_of_mem _ hab, Inf_le $ mem_image_of_mem _ hab⟩,
  le_Inf := assume s p h,
    ⟨ le_Inf $ ball_image_of_ball $ assume p hp, (h p hp).1,
      le_Inf $ ball_image_of_ball $ assume p hp, (h p hp).2⟩,
  .. prod.bounded_lattice α β,
  .. prod.has_Sup α β,
  .. prod.has_Inf α β }

end prod

section complete_lattice
variables [complete_lattice α] {a : α} {s : set α}

/-- This is a weaker version of `sup_Inf_eq` -/
lemma sup_Inf_le_infi_sup :
  a ⊔ Inf s ≤ (⨅ b ∈ s, a ⊔ b) :=
le_infi $ assume i, le_infi $ assume h, sup_le_sup_left (Inf_le h) _

/-- This is a weaker version of `Inf_sup_eq` -/
lemma Inf_sup_le_infi_sup :
  Inf s ⊔ a ≤ (⨅ b ∈ s, b ⊔ a) :=
le_infi $ assume i, le_infi $ assume h, sup_le_sup_right (Inf_le h) _

/-- This is a weaker version of `inf_Sup_eq` -/
lemma supr_inf_le_inf_Sup :
  (⨆ b ∈ s, a ⊓ b) ≤ a ⊓ Sup s :=
supr_le $ assume i, supr_le $ assume h, inf_le_inf_left _ (le_Sup h)

/-- This is a weaker version of `Sup_inf_eq` -/
lemma supr_inf_le_Sup_inf :
  (⨆ b ∈ s, b ⊓ a) ≤ Sup s ⊓ a :=
supr_le $ assume i, supr_le $ assume h, inf_le_inf_right _ (le_Sup h)

lemma disjoint_Sup_left {a : set α} {b : α} (d : disjoint (Sup a) b) {i} (hi : i ∈ a) :
  disjoint i b :=
(supr_le_iff.mp (supr_le_iff.mp (supr_inf_le_Sup_inf.trans (d : _)) i : _) hi : _)

lemma disjoint_Sup_right {a : set α} {b : α} (d : disjoint b (Sup a)) {i} (hi : i ∈ a) :
  disjoint b i :=
(supr_le_iff.mp (supr_le_iff.mp (supr_inf_le_inf_Sup.trans (d : _)) i : _) hi : _)

end complete_lattice

namespace complete_lattice
variables [complete_lattice α]

/-- An independent set of elements in a complete lattice is one in which every element is disjoint
  from the `Sup` of the rest. -/
def set_independent (s : set α) : Prop := ∀ ⦃a⦄, a ∈ s → disjoint a (Sup (s \ {a}))

variables {s : set α} (hs : set_independent s)

@[simp]
lemma set_independent_empty : set_independent (∅ : set α) :=
λ x hx, (set.not_mem_empty x hx).elim

theorem set_independent.mono {t : set α} (hst : t ⊆ s) :
  set_independent t :=
λ a ha, (hs (hst ha)).mono_right (Sup_le_Sup (diff_subset_diff_left hst))

/-- If the elements of a set are independent, then any pair within that set is disjoint. -/
lemma set_independent.disjoint {x y : α} (hx : x ∈ s) (hy : y ∈ s) (h : x ≠ y) : disjoint x y :=
disjoint_Sup_right (hs hx) ((mem_diff y).mpr ⟨hy, by simp [h.symm]⟩)

include hs

/-- If the elements of a set are independent, then any element is disjoint from the `Sup` of some
subset of the rest. -/
lemma set_independent.disjoint_Sup {x : α} {y : set α} (hx : x ∈ s) (hy : y ⊆ s) (hxy : x ∉ y) :
  disjoint x (Sup y) :=
begin
  have := (hs.mono $ insert_subset.mpr ⟨hx, hy⟩) (mem_insert x _),
  rw [insert_diff_of_mem _ (mem_singleton _), diff_singleton_eq_self hxy] at this,
  exact this,
end

omit hs

/-- An independent indexed family of elements in a complete lattice is one in which every element
  is disjoint from the `supr` of the rest.

  Example: an indexed family of non-zero elements in a
  vector space is linearly independent iff the indexed family of subspaces they generate is
  independent in this sense.

  Example: an indexed family of submodules of a module is independent in this sense if
  and only the natural map from the direct sum of the submodules to the module is injective. -/
def independent {ι : Sort*} {α : Type*} [complete_lattice α] (t : ι → α) : Prop :=
∀ i : ι, disjoint (t i) (⨆ (j ≠ i), t j)

lemma set_independent_iff {α : Type*} [complete_lattice α] (s : set α) :
  set_independent s ↔ independent (coe : s → α) :=
begin
  simp_rw [independent, set_independent, set_coe.forall, Sup_eq_supr],
  apply forall_congr, intro a, apply forall_congr, intro ha,
  congr' 2,
  convert supr_subtype.symm,
  simp [supr_and],
end

variables {t : ι → α} (ht : independent t)

theorem independent_def : independent t ↔ ∀ i : ι, disjoint (t i) (⨆ (j ≠ i), t j) :=
iff.rfl

theorem independent_def' {ι : Type*} {t : ι → α} :
  independent t ↔ ∀ i, disjoint (t i) (Sup (t '' {j | j ≠ i})) :=
by {simp_rw Sup_image, refl}

theorem independent_def'' {ι : Type*} {t : ι → α} :
  independent t ↔ ∀ i, disjoint (t i) (Sup {a | ∃ j ≠ i, t j = a}) :=
by {rw independent_def', tidy}

@[simp]
lemma independent_empty (t : empty → α) : independent t.

@[simp]
lemma independent_pempty (t : pempty → α) : independent t.

/-- If the elements of a set are independent, then any pair within that set is disjoint. -/
lemma independent.disjoint {x y : ι} (h : x ≠ y) : disjoint (t x) (t y) :=
disjoint_Sup_right (ht x) ⟨y, by simp [h.symm]⟩

lemma independent.mono {ι : Type*} {α : Type*} [complete_lattice α]
  {s t : ι → α} (hs : independent s) (hst : t ≤ s) :
  independent t :=
λ i, (hs i).mono (hst i) (supr_le_supr $ λ j, supr_le_supr $ λ _, hst j)

/-- Composing an indepedent indexed family with an injective function on the index results in
another indepedendent indexed family. -/
lemma independent.comp {ι ι' : Sort*} {α : Type*} [complete_lattice α]
  {s : ι → α} (hs : independent s) (f : ι' → ι) (hf : function.injective f) :
  independent (s ∘ f) :=
λ i, (hs (f i)).mono_right begin
  refine (supr_le_supr $ λ i, _).trans (supr_comp_le _ f),
  exact supr_le_supr_const hf.ne,
end

/-- If the elements of a set are independent, then any element is disjoint from the `supr` of some
subset of the rest. -/
lemma independent.disjoint_bsupr {ι : Type*} {α : Type*} [complete_lattice α]
  {t : ι → α} (ht : independent t) {x : ι} {y : set ι} (hx : x ∉ y) :
  disjoint (t x) (⨆ i ∈ y, t i) :=
disjoint.mono_right (bsupr_le_bsupr' $ λ i hi, (ne_of_mem_of_not_mem hi hx : _)) (ht x)

end complete_lattice


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import tactic.basic

/-!
# Types with a unique term

In this file we define a typeclass `unique`,
which expresses that a type has a unique term.
In other words, a type that is `inhabited` and a `subsingleton`.

## Main declaration

* `unique`: a typeclass that expresses that a type has a unique term.

## Main statements

* `unique.mk'`: an inhabited subsingleton type is `unique`. This can not be an instance because it
  would lead to loops in typeclass inference.

* `function.surjective.unique`: if the domain of a surjective function is `unique`, then its
  codomain is `unique` as well.

* `function.injective.subsingleton`: if the codomain of an injective function is `subsingleton`,
  then its domain is `subsingleton` as well.

* `function.injective.unique`: if the codomain of an injective function is `subsingleton` and its
  domain is `inhabited`, then its domain is `unique`.

## Implementation details

The typeclass `unique α` is implemented as a type,
rather than a `Prop`-valued predicate,
for good definitional properties of the default term.

-/

universes u v w

variables {α : Sort u} {β : Sort v} {γ : Sort w}

/-- `unique α` expresses that `α` is a type with a unique term `default α`.

This is implemented as a type, rather than a `Prop`-valued predicate,
for good definitional properties of the default term. -/
@[ext]
structure unique (α : Sort u) extends inhabited α :=
(uniq : ∀ a:α, a = default)

attribute [class] unique

instance punit.unique : unique punit.{u} :=
{ default := punit.star,
  uniq := λ x, punit_eq x _ }

lemma fin.eq_zero : ∀ n : fin 1, n = 0
| ⟨n, hn⟩ := fin.eq_of_veq (nat.eq_zero_of_le_zero (nat.le_of_lt_succ hn))

instance {n : ℕ} : inhabited (fin n.succ) := ⟨0⟩

@[simp] lemma fin.default_eq_zero (n : ℕ) : default (fin n.succ) = 0 := rfl

instance fin.unique : unique (fin 1) :=
{ uniq := fin.eq_zero, .. fin.inhabited }

namespace unique
open function

section

variables [unique α]

@[priority 100] -- see Note [lower instance priority]
instance : inhabited α := to_inhabited ‹unique α›

lemma eq_default (a : α) : a = default α := uniq _ a

lemma default_eq (a : α) : default α = a := (uniq _ a).symm

@[priority 100] -- see Note [lower instance priority]
instance : subsingleton α := subsingleton_of_forall_eq _ eq_default

lemma forall_iff {p : α → Prop} : (∀ a, p a) ↔ p (default α) :=
⟨λ h, h _, λ h x, by rwa [unique.eq_default x]⟩

lemma exists_iff {p : α → Prop} : Exists p ↔ p (default α) :=
⟨λ ⟨a, ha⟩, eq_default a ▸ ha, exists.intro (default α)⟩

end

@[ext] protected lemma subsingleton_unique' : ∀ (h₁ h₂ : unique α), h₁ = h₂
| ⟨⟨x⟩, h⟩ ⟨⟨y⟩, _⟩ := by congr; rw [h x, h y]

instance subsingleton_unique : subsingleton (unique α) :=
⟨unique.subsingleton_unique'⟩

/-- Construct `unique` from `inhabited` and `subsingleton`. Making this an instance would create
a loop in the class inheritance graph. -/
def mk' (α : Sort u) [h₁ : inhabited α] [subsingleton α] : unique α :=
{ uniq := λ x, subsingleton.elim _ _, .. h₁ }

end unique

@[simp] lemma pi.default_def {β : Π a : α, Sort v} [Π a, inhabited (β a)] :
  default (Π a, β a) = λ a, default (β a) :=
rfl

lemma pi.default_apply {β : Π a : α, Sort v} [Π a, inhabited (β a)] (a : α) :
  default (Π a, β a) a = default (β a) :=
rfl

instance pi.unique {β : Π a : α, Sort v} [Π a, unique (β a)] : unique (Π a, β a) :=
{ uniq := λ f, funext $ λ x, unique.eq_default _,
  .. pi.inhabited α }

/-- There is a unique function on an empty domain. -/
def pi.unique_of_empty (h : α → false) (β : Π a : α, Sort v) : unique (Π a, β a) :=
{ default := λ a, (h a).elim,
  uniq := λ f, funext $ λ a, (h a).elim }

/-- There is a unique function whose domain is `pempty`. -/
instance pi.pempty_unique (β : pempty.{u} → Sort v) : unique (Π a, β a) :=
pi.unique_of_empty pempty.elim β

namespace function

variable {f : α → β}

/-- If the domain of a surjective function is a singleton,
then the codomain is a singleton as well. -/
protected def surjective.unique (hf : surjective f) [unique α] : unique β :=
{ default := f (default _),
  uniq := λ b, let ⟨a, ha⟩ := hf b in ha ▸ congr_arg f (unique.eq_default _) }

/-- If the codomain of an injective function is a subsingleton, then the domain
is a subsingleton as well. -/
protected lemma injective.subsingleton (hf : injective f) [subsingleton β] :
  subsingleton α :=
⟨λ x y, hf $ subsingleton.elim _ _⟩

/-- If `α` is inhabited and admits an injective map to a subsingleton type, then `α` is `unique`. -/
protected def injective.unique [inhabited α] [subsingleton β] (hf : injective f) : unique α :=
@unique.mk' _ _ hf.subsingleton

end function


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.set.lattice
import logic.relation

/-!
# Relations holding pairwise

This file defines pairwise relations and pairwise disjoint indexed sets.

## Main declarations

* `pairwise`: `pairwise r` states that `r i j` for all `i ≠ j`.
* `set.pairwise`: `s.pairwise r` states that `r i j` for all `i ≠ j` with `i, j ∈ s`.
* `set.pairwise_disjoint`: `s.pairwise_disjoint f` states that images under `f` of distinct elements
  of `s` are either equal or `disjoint`.

## Notes

The spelling `s.pairwise_disjoint id` is preferred over `s.pairwise disjoint` to permit dot notation
on `set.pairwise_disjoint`, even though the latter unfolds to something nicer.
-/

open set function

variables {α ι ι' : Type*} {r p q : α → α → Prop}

section pairwise
variables {f g : ι → α} {s t u : set α} {a b : α}

/-- A relation `r` holds pairwise if `r i j` for all `i ≠ j`. -/
def pairwise (r : α → α → Prop) := ∀ i j, i ≠ j → r i j

lemma pairwise.mono (hr : pairwise r) (h : ∀ ⦃i j⦄, r i j → p i j) : pairwise p :=
λ i j hij, h $ hr i j hij

lemma pairwise_on_bool (hr : symmetric r) {a b : α} : pairwise (r on (λ c, cond c a b)) ↔ r a b :=
by simpa [pairwise, function.on_fun] using @hr a b

lemma pairwise_disjoint_on_bool [semilattice_inf α] [order_bot α] {a b : α} :
  pairwise (disjoint on (λ c, cond c a b)) ↔ disjoint a b :=
pairwise_on_bool disjoint.symm

lemma symmetric.pairwise_on [linear_order ι] (hr : symmetric r) (f : ι → α) :
  pairwise (r on f) ↔ ∀ m n, m < n → r (f m) (f n) :=
⟨λ h m n hmn, h m n hmn.ne, λ h m n hmn, begin
  obtain hmn' | hmn' := hmn.lt_or_lt,
  { exact h _ _ hmn' },
  { exact hr (h _ _ hmn') }
end⟩

lemma pairwise_disjoint_on [semilattice_inf α] [order_bot α] [linear_order ι] (f : ι → α) :
  pairwise (disjoint on f) ↔ ∀ m n, m < n → disjoint (f m) (f n) :=
symmetric.pairwise_on disjoint.symm f

lemma pairwise_disjoint.mono [semilattice_inf α] [order_bot α]
  (hs : pairwise (disjoint on f)) (h : g ≤ f) : pairwise (disjoint on g) :=
hs.mono (λ i j hij, disjoint.mono (h i) (h j) hij)

lemma function.injective_iff_pairwise_ne : injective f ↔ pairwise ((≠) on f) :=
forall₂_congr $ λ i j, not_imp_not.symm

alias function.injective_iff_pairwise_ne ↔ function.injective.pairwise_ne _

namespace set

/-- The relation `r` holds pairwise on the set `s` if `r x y` for all *distinct* `x y ∈ s`. -/
protected def pairwise (s : set α) (r : α → α → Prop) := ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → r x y

lemma pairwise_of_forall (s : set α) (r : α → α → Prop) (h : ∀ a b, r a b) : s.pairwise r :=
λ a _ b _ _, h a b

lemma pairwise.imp_on (h : s.pairwise r) (hrp : s.pairwise (λ ⦃a b : α⦄, r a b → p a b)) :
  s.pairwise p :=
λ a ha b hb hab, hrp ha hb hab $ h ha hb hab

lemma pairwise.imp (h : s.pairwise r) (hpq : ∀ ⦃a b : α⦄, r a b → p a b) : s.pairwise p :=
h.imp_on $ pairwise_of_forall s _ hpq

lemma pairwise.mono (h : t ⊆ s) (hs : s.pairwise r) : t.pairwise r :=
λ x xt y yt, hs (h xt) (h yt)

lemma pairwise.mono' (H : r ≤ p) (hr : s.pairwise r) : s.pairwise p := hr.imp H

protected lemma pairwise.eq (hs : s.pairwise r) (ha : a ∈ s) (hb : b ∈ s) (h : ¬ r a b) : a = b :=
of_not_not $ λ hab, h $ hs ha hb hab

lemma pairwise_top (s : set α) : s.pairwise ⊤ := pairwise_of_forall s _ (λ a b, trivial)

protected lemma subsingleton.pairwise (h : s.subsingleton) (r : α → α → Prop) :
  s.pairwise r :=
λ x hx y hy hne, (hne (h hx hy)).elim

@[simp] lemma pairwise_empty (r : α → α → Prop) : (∅ : set α).pairwise r :=
subsingleton_empty.pairwise r

@[simp] lemma pairwise_singleton (a : α) (r : α → α → Prop) : set.pairwise {a} r :=
subsingleton_singleton.pairwise r

lemma nonempty.pairwise_iff_exists_forall [is_equiv α r] {s : set ι} (hs : s.nonempty) :
  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
begin
  fsplit,
  { rcases hs with ⟨y, hy⟩,
    refine λ H, ⟨f y, λ x hx, _⟩,
    rcases eq_or_ne x y with rfl|hne,
    { apply is_refl.refl },
    { exact H hx hy hne } },
  { rintro ⟨z, hz⟩ x hx y hy hne,
    exact @is_trans.trans α r _ (f x) z (f y) (hz _ hx) (is_symm.symm _ _ $ hz _ hy) }
end

/-- For a nonempty set `s`, a function `f` takes pairwise equal values on `s` if and only if
for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
`set.pairwise_eq_iff_exists_eq` for a version that assumes `[nonempty ι]` instead of
`set.nonempty s`. -/
lemma nonempty.pairwise_eq_iff_exists_eq {s : set α} (hs : s.nonempty) {f : α → ι} :
  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
hs.pairwise_iff_exists_forall

lemma pairwise_iff_exists_forall [nonempty ι] (s : set α) (f : α → ι) {r : ι → ι → Prop}
  [is_equiv ι r] :
  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
begin
  rcases s.eq_empty_or_nonempty with rfl|hne,
  { simp },
  { exact hne.pairwise_iff_exists_forall }
end

/-- A function `f : α → ι` with nonempty codomain takes pairwise equal values on a set `s` if and
only if for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
`set.nonempty.pairwise_eq_iff_exists_eq` for a version that assumes `set.nonempty s` instead of
`[nonempty ι]`. -/
lemma pairwise_eq_iff_exists_eq [nonempty ι] (s : set α) (f : α → ι) :
  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
pairwise_iff_exists_forall s f

lemma pairwise_union :
  (s ∪ t).pairwise r ↔
    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b ∧ r b a :=
begin
  simp only [set.pairwise, mem_union_eq, or_imp_distrib, forall_and_distrib],
  exact ⟨λ H, ⟨H.1.1, H.2.2, H.2.1, λ x hx y hy hne, H.1.2 y hy x hx hne.symm⟩,
    λ H, ⟨⟨H.1, λ x hx y hy hne, H.2.2.2 y hy x hx hne.symm⟩, H.2.2.1, H.2.1⟩⟩
end

lemma pairwise_union_of_symmetric (hr : symmetric r) :
  (s ∪ t).pairwise r ↔
    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b :=
pairwise_union.trans $ by simp only [hr.iff, and_self]

lemma pairwise_insert :
  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b ∧ r b a :=
by simp only [insert_eq, pairwise_union, pairwise_singleton, true_and,
  mem_singleton_iff, forall_eq]

lemma pairwise.insert (hs : s.pairwise r) (h : ∀ b ∈ s, a ≠ b → r a b ∧ r b a) :
  (insert a s).pairwise r :=
pairwise_insert.2 ⟨hs, h⟩

lemma pairwise_insert_of_symmetric (hr : symmetric r) :
  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b :=
by simp only [pairwise_insert, hr.iff a, and_self]

lemma pairwise.insert_of_symmetric (hs : s.pairwise r) (hr : symmetric r)
  (h : ∀ b ∈ s, a ≠ b → r a b) :
  (insert a s).pairwise r :=
(pairwise_insert_of_symmetric hr).2 ⟨hs, h⟩

lemma pairwise_pair : set.pairwise {a, b} r ↔ (a ≠ b → r a b ∧ r b a) :=
by simp [pairwise_insert]

lemma pairwise_pair_of_symmetric (hr : symmetric r) : set.pairwise {a, b} r ↔ (a ≠ b → r a b) :=
by simp [pairwise_insert_of_symmetric hr]

lemma pairwise_univ : (univ : set α).pairwise r ↔ pairwise r :=
by simp only [set.pairwise, pairwise, mem_univ, forall_const]

lemma pairwise.on_injective (hs : s.pairwise r) (hf : function.injective f)
  (hfs : ∀ x, f x ∈ s) :
  pairwise (r on f) :=
λ i j hij, hs (hfs i) (hfs j) (hf.ne hij)

lemma inj_on.pairwise_image {s : set ι} (h : s.inj_on f) :
  (f '' s).pairwise r ↔ s.pairwise (r on f) :=
by simp [h.eq_iff, set.pairwise] {contextual := tt}

lemma pairwise_Union {f : ι → set α} (h : directed (⊆) f) :
  (⋃ n, f n).pairwise r ↔ ∀ n, (f n).pairwise r :=
begin
  split,
  { assume H n,
    exact pairwise.mono (subset_Union _ _) H },
  { assume H i hi j hj hij,
    rcases mem_Union.1 hi with ⟨m, hm⟩,
    rcases mem_Union.1 hj with ⟨n, hn⟩,
    rcases h m n with ⟨p, mp, np⟩,
    exact H p (mp hm) (np hn) hij }
end

lemma pairwise_sUnion {r : α → α → Prop} {s : set (set α)} (h : directed_on (⊆) s) :
  (⋃₀ s).pairwise r ↔ (∀ a ∈ s, set.pairwise a r) :=
by { rw [sUnion_eq_Union, pairwise_Union (h.directed_coe), set_coe.forall], refl }

end set

lemma pairwise.set_pairwise (h : pairwise r) (s : set α) : s.pairwise r := λ x hx y hy, h x y

end pairwise

lemma pairwise_subtype_iff_pairwise_set {α : Type*} (s : set α) (r : α → α → Prop) :
  pairwise (λ (x : s) (y : s), r x y) ↔ s.pairwise r :=
begin
  split,
  { assume h x hx y hy hxy,
    exact h ⟨x, hx⟩ ⟨y, hy⟩ (by simpa only [subtype.mk_eq_mk, ne.def]) },
  { rintros h ⟨x, hx⟩ ⟨y, hy⟩ hxy,
    simp only [subtype.mk_eq_mk, ne.def] at hxy,
    exact h hx hy hxy }
end

alias pairwise_subtype_iff_pairwise_set ↔ pairwise.set_of_subtype set.pairwise.subtype

namespace set
section semilattice_inf_bot
variables [semilattice_inf α] [order_bot α] {s t : set ι} {f g : ι → α}

/-- A set is `pairwise_disjoint` under `f`, if the images of any distinct two elements under `f`
are disjoint.

`s.pairwise disjoint` is (definitionally) the same as `s.pairwise_disjoint id`. We prefer the latter
in order to allow dot notation on `set.pairwise_disjoint`, even though the former unfolds more
nicely. -/
def pairwise_disjoint (s : set ι) (f : ι → α) : Prop := s.pairwise (disjoint on f)

lemma pairwise_disjoint.subset (ht : t.pairwise_disjoint f) (h : s ⊆ t) : s.pairwise_disjoint f :=
pairwise.mono h ht

lemma pairwise_disjoint.mono_on (hs : s.pairwise_disjoint f) (h : ∀ ⦃i⦄, i ∈ s → g i ≤ f i) :
  s.pairwise_disjoint g :=
λ a ha b hb hab, (hs ha hb hab).mono (h ha) (h hb)

lemma pairwise_disjoint.mono (hs : s.pairwise_disjoint f) (h : g ≤ f) : s.pairwise_disjoint g :=
hs.mono_on (λ i _, h i)

@[simp] lemma pairwise_disjoint_empty : (∅ : set ι).pairwise_disjoint f := pairwise_empty _

@[simp] lemma pairwise_disjoint_singleton (i : ι) (f : ι → α) : pairwise_disjoint {i} f :=
pairwise_singleton i _

lemma pairwise_disjoint_insert {i : ι} :
  (insert i s).pairwise_disjoint f
    ↔ s.pairwise_disjoint f ∧ ∀ j ∈ s, i ≠ j → disjoint (f i) (f j) :=
set.pairwise_insert_of_symmetric $ symmetric_disjoint.comap f

lemma pairwise_disjoint.insert (hs : s.pairwise_disjoint f) {i : ι}
  (h : ∀ j ∈ s, i ≠ j → disjoint (f i) (f j)) :
  (insert i s).pairwise_disjoint f :=
set.pairwise_disjoint_insert.2 ⟨hs, h⟩

lemma pairwise_disjoint.image_of_le (hs : s.pairwise_disjoint f) {g : ι → ι} (hg : f ∘ g ≤ f) :
  (g '' s).pairwise_disjoint f :=
begin
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ h,
  exact (hs ha hb $ ne_of_apply_ne _ h).mono (hg a) (hg b),
end

lemma inj_on.pairwise_disjoint_image {g : ι' → ι} {s : set ι'} (h : s.inj_on g) :
  (g '' s).pairwise_disjoint f ↔ s.pairwise_disjoint (f ∘ g) :=
h.pairwise_image

lemma pairwise_disjoint.range (g : s → ι) (hg : ∀ (i : s), f (g i) ≤ f i)
  (ht : s.pairwise_disjoint f) :
  (range g).pairwise_disjoint f :=
begin
  rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ hxy,
  exact (ht x.2 y.2 $ λ h, hxy $ congr_arg g $ subtype.ext h).mono (hg x) (hg y),
end

lemma pairwise_disjoint_union :
  (s ∪ t).pairwise_disjoint f ↔ s.pairwise_disjoint f ∧ t.pairwise_disjoint f ∧
    ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j) :=
pairwise_union_of_symmetric $ symmetric_disjoint.comap f

lemma pairwise_disjoint.union (hs : s.pairwise_disjoint f) (ht : t.pairwise_disjoint f)
  (h : ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j)) :
  (s ∪ t).pairwise_disjoint f :=
pairwise_disjoint_union.2 ⟨hs, ht, h⟩

lemma pairwise_disjoint_Union {g : ι' → set ι} (h : directed (⊆) g) :
  (⋃ n, g n).pairwise_disjoint f ↔ ∀ ⦃n⦄, (g n).pairwise_disjoint f :=
pairwise_Union h

lemma pairwise_disjoint_sUnion {s : set (set ι)} (h : directed_on (⊆) s) :
  (⋃₀ s).pairwise_disjoint f ↔ ∀ ⦃a⦄, a ∈ s → set.pairwise_disjoint a f :=
pairwise_sUnion h

-- classical
lemma pairwise_disjoint.elim (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (h : ¬ disjoint (f i) (f j)) :
  i = j :=
hs.eq hi hj h

-- classical
lemma pairwise_disjoint.elim' (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (h : f i ⊓ f j ≠ ⊥) :
  i = j :=
hs.elim hi hj $ λ hij, h hij.eq_bot

lemma pairwise_disjoint.eq_of_le (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (hf : f i ≠ ⊥) (hij : f i ≤ f j) :
  i = j :=
hs.elim' hi hj $ λ h, hf $ (inf_of_le_left hij).symm.trans h

end semilattice_inf_bot

section complete_lattice
variables [complete_lattice α]

/-- Bind operation for `set.pairwise_disjoint`. If you want to only consider finsets of indices, you
can use `set.pairwise_disjoint.bUnion_finset`. -/
lemma pairwise_disjoint.bUnion {s : set ι'} {g : ι' → set ι} {f : ι → α}
  (hs : s.pairwise_disjoint (λ i' : ι', ⨆ i ∈ g i', f i))
  (hg : ∀ i ∈ s, (g i).pairwise_disjoint f) :
  (⋃ i ∈ s, g i).pairwise_disjoint f :=
begin
  rintro a ha b hb hab,
  simp_rw set.mem_Union at ha hb,
  obtain ⟨c, hc, ha⟩ := ha,
  obtain ⟨d, hd, hb⟩ := hb,
  obtain hcd | hcd := eq_or_ne (g c) (g d),
  { exact hg d hd (hcd.subst ha) hb hab },
  { exact (hs hc hd $ ne_of_apply_ne _ hcd).mono (le_supr₂ a ha) (le_supr₂ b hb) }
end

end complete_lattice

/-! ### Pairwise disjoint set of sets -/

lemma pairwise_disjoint_range_singleton :
  (set.range (singleton : ι → set ι)).pairwise_disjoint id :=
begin
  rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h,
  exact disjoint_singleton.2 (ne_of_apply_ne _ h),
end

lemma pairwise_disjoint_fiber (f : ι → α) (s : set α) : s.pairwise_disjoint (λ a, f ⁻¹' {a}) :=
λ a _ b _ h i ⟨hia, hib⟩, h $ (eq.symm hia).trans hib

-- classical
lemma pairwise_disjoint.elim_set {s : set ι} {f : ι → set α} (hs : s.pairwise_disjoint f) {i j : ι}
  (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i) (haj : a ∈ f j) : i = j :=
hs.elim hi hj $ not_disjoint_iff.2 ⟨a, hai, haj⟩

lemma bUnion_diff_bUnion_eq {s t : set ι} {f : ι → set α} (h : (s ∪ t).pairwise_disjoint f) :
  (⋃ i ∈ s, f i) \ (⋃ i ∈ t, f i) = (⋃ i ∈ s \ t, f i) :=
begin
  refine (bUnion_diff_bUnion_subset f s t).antisymm
    (Union₂_subset $ λ i hi a ha, (mem_diff _).2 ⟨mem_bUnion hi.1 ha, _⟩),
  rw mem_Union₂, rintro ⟨j, hj, haj⟩,
  exact h (or.inl hi.1) (or.inr hj) (ne_of_mem_of_not_mem hj hi.2).symm ⟨ha, haj⟩,
end

/-- Equivalence between a disjoint bounded union and a dependent sum. -/
noncomputable def bUnion_eq_sigma_of_disjoint {s : set ι} {f : ι → set α}
  (h : s.pairwise_disjoint f) :
  (⋃ i ∈ s, f i) ≃ (Σ i : s, f i) :=
(equiv.set_congr (bUnion_eq_Union _ _)).trans $ Union_eq_sigma_of_disjoint $
  λ ⟨i, hi⟩ ⟨j, hj⟩ ne, h hi hj $ λ eq, ne $ subtype.eq eq

end set

lemma pairwise_disjoint_fiber (f : ι → α) : pairwise (disjoint on (λ a : α, f ⁻¹' {a})) :=
set.pairwise_univ.1 $ set.pairwise_disjoint_fiber f univ