/-
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

Defines bounded lattice type class hierarchy.

Includes the Prop and fun instances.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.lattice
import Mathlib.data.option.basic
import Mathlib.tactic.pi_instances
import Mathlib.logic.nontrivial
import Mathlib.PostPort

universes u l v u_1 u_2

namespace Mathlib

/-- Typeclass for the `⊤` (`\top`) notation -/
/-- Typeclass for the `⊥` (`\bot`) notation -/
class has_top (α : Type u)
where
  top : α

class has_bot (α : Type u)
where
  bot : α

notation:1024 "⊤" => Mathlib.has_top.top

notation:1024 "⊥" => Mathlib.has_bot.bot

/-- An `order_top` is a partial order with a maximal element.
  (We could state this on preorders, but then it wouldn't be unique
  so distinguishing one would seem odd.) -/
class order_top (α : Type u)
extends has_top α, partial_order α
where
  le_top : ∀ (a : α), a ≤ ⊤

@[simp] theorem le_top {α : Type u} [order_top α] {a : α} : a ≤ ⊤ :=
  order_top.le_top a

theorem top_unique {α : Type u} [order_top α] {a : α} (h : ⊤ ≤ a) : a = ⊤ :=
  le_antisymm le_top h

-- TODO: delete in favor of the next?

theorem eq_top_iff {α : Type u} [order_top α] {a : α} : a = ⊤ ↔ ⊤ ≤ a :=
  { mp := fun (eq : a = ⊤) => Eq.symm eq ▸ le_refl ⊤, mpr := top_unique }

@[simp] theorem top_le_iff {α : Type u} [order_top α] {a : α} : ⊤ ≤ a ↔ a = ⊤ :=
  { mp := top_unique, mpr := fun (h : a = ⊤) => Eq.symm h ▸ le_refl ⊤ }

@[simp] theorem not_top_lt {α : Type u} [order_top α] {a : α} : ¬⊤ < a :=
  fun (h : ⊤ < a) => lt_irrefl a (lt_of_le_of_lt le_top h)

theorem eq_top_mono {α : Type u} [order_top α] {a : α} {b : α} (h : a ≤ b) (h₂ : a = ⊤) : b = ⊤ :=
  iff.mp top_le_iff (h₂ ▸ h)

theorem lt_top_iff_ne_top {α : Type u} [order_top α] {a : α} : a < ⊤ ↔ a ≠ ⊤ := sorry

theorem ne_top_of_lt {α : Type u} [order_top α] {a : α} {b : α} (h : a < b) : a ≠ ⊤ :=
  iff.mp lt_top_iff_ne_top (lt_of_lt_of_le h le_top)

theorem ne_top_of_le_ne_top {α : Type u} [order_top α] {a : α} {b : α} (hb : b ≠ ⊤) (hab : a ≤ b) : a ≠ ⊤ :=
  fun (ha : a = ⊤) => hb (top_unique (ha ▸ hab))

theorem strict_mono.top_preimage_top' {α : Type u} {β : Type v} [linear_order α] [order_top β] {f : α → β} (H : strict_mono f) {a : α} (h_top : f a = ⊤) (x : α) : x ≤ a :=
  strict_mono.top_preimage_top H (fun (p : β) => eq.mpr (id (Eq._oldrec (Eq.refl (p ≤ f a)) h_top)) le_top) x

theorem order_top.ext_top {α : Type u_1} {A : order_top α} {B : order_top α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : ⊤ = ⊤ :=
  top_unique (eq.mpr (id (Eq._oldrec (Eq.refl (⊤ ≤ ⊤)) (Eq.symm (propext (H ⊤ ⊤))))) le_top)

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

/-- An `order_bot` is a partial order with a minimal element.
  (We could state this on preorders, but then it wouldn't be unique
  so distinguishing one would seem odd.) -/
class order_bot (α : Type u)
extends has_bot α, partial_order α
where
  bot_le : ∀ (a : α), ⊥ ≤ a

@[simp] theorem bot_le {α : Type u} [order_bot α] {a : α} : ⊥ ≤ a :=
  order_bot.bot_le a

theorem bot_unique {α : Type u} [order_bot α] {a : α} (h : a ≤ ⊥) : a = ⊥ :=
  le_antisymm h bot_le

-- TODO: delete?

theorem eq_bot_iff {α : Type u} [order_bot α] {a : α} : a = ⊥ ↔ a ≤ ⊥ :=
  { mp := fun (eq : a = ⊥) => Eq.symm eq ▸ le_refl ⊥, mpr := bot_unique }

@[simp] theorem le_bot_iff {α : Type u} [order_bot α] {a : α} : a ≤ ⊥ ↔ a = ⊥ :=
  { mp := bot_unique, mpr := fun (h : a = ⊥) => Eq.symm h ▸ le_refl ⊥ }

@[simp] theorem not_lt_bot {α : Type u} [order_bot α] {a : α} : ¬a < ⊥ :=
  fun (h : a < ⊥) => lt_irrefl a (lt_of_lt_of_le h bot_le)

theorem ne_bot_of_le_ne_bot {α : Type u} [order_bot α] {a : α} {b : α} (hb : b ≠ ⊥) (hab : b ≤ a) : a ≠ ⊥ :=
  fun (ha : a = ⊥) => hb (bot_unique (ha ▸ hab))

theorem eq_bot_mono {α : Type u} [order_bot α] {a : α} {b : α} (h : a ≤ b) (h₂ : b = ⊥) : a = ⊥ :=
  iff.mp le_bot_iff (h₂ ▸ h)

theorem bot_lt_iff_ne_bot {α : Type u} [order_bot α] {a : α} : ⊥ < a ↔ a ≠ ⊥ := sorry

theorem ne_bot_of_gt {α : Type u} [order_bot α] {a : α} {b : α} (h : a < b) : b ≠ ⊥ :=
  iff.mp bot_lt_iff_ne_bot (lt_of_le_of_lt bot_le h)

theorem strict_mono.bot_preimage_bot' {α : Type u} {β : Type v} [linear_order α] [order_bot β] {f : α → β} (H : strict_mono f) {a : α} (h_bot : f a = ⊥) (x : α) : a ≤ x :=
  strict_mono.bot_preimage_bot H (fun (p : β) => eq.mpr (id (Eq._oldrec (Eq.refl (f a ≤ p)) h_bot)) bot_le) x

theorem order_bot.ext_bot {α : Type u_1} {A : order_bot α} {B : order_bot α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : ⊥ = ⊥ :=
  bot_unique (eq.mpr (id (Eq._oldrec (Eq.refl (⊥ ≤ ⊥)) (Eq.symm (propext (H ⊥ ⊥))))) bot_le)

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

/-- A `semilattice_sup_top` is a semilattice with top and join. -/
class semilattice_sup_top (α : Type u)
extends semilattice_sup α, order_top α
where

@[simp] theorem top_sup_eq {α : Type u} [semilattice_sup_top α] {a : α} : ⊤ ⊔ a = ⊤ :=
  sup_of_le_left le_top

@[simp] theorem sup_top_eq {α : Type u} [semilattice_sup_top α] {a : α} : a ⊔ ⊤ = ⊤ :=
  sup_of_le_right le_top

/-- A `semilattice_sup_bot` is a semilattice with bottom and join. -/
class semilattice_sup_bot (α : Type u)
extends order_bot α, semilattice_sup α
where

@[simp] theorem bot_sup_eq {α : Type u} [semilattice_sup_bot α] {a : α} : ⊥ ⊔ a = a :=
  sup_of_le_right bot_le

@[simp] theorem sup_bot_eq {α : Type u} [semilattice_sup_bot α] {a : α} : a ⊔ ⊥ = a :=
  sup_of_le_left bot_le

@[simp] theorem sup_eq_bot_iff {α : Type u} [semilattice_sup_bot α] {a : α} {b : α} : a ⊔ b = ⊥ ↔ a = ⊥ ∧ b = ⊥ := sorry

protected instance nat.semilattice_sup_bot : semilattice_sup_bot ℕ :=
  semilattice_sup_bot.mk 0 distrib_lattice.le distrib_lattice.lt distrib_lattice.le_refl distrib_lattice.le_trans
    distrib_lattice.le_antisymm nat.zero_le distrib_lattice.sup distrib_lattice.le_sup_left distrib_lattice.le_sup_right
    distrib_lattice.sup_le

/-- A `semilattice_inf_top` is a semilattice with top and meet. -/
class semilattice_inf_top (α : Type u)
extends semilattice_inf α, order_top α
where

@[simp] theorem top_inf_eq {α : Type u} [semilattice_inf_top α] {a : α} : ⊤ ⊓ a = a :=
  inf_of_le_right le_top

@[simp] theorem inf_top_eq {α : Type u} [semilattice_inf_top α] {a : α} : a ⊓ ⊤ = a :=
  inf_of_le_left le_top

@[simp] theorem inf_eq_top_iff {α : Type u} [semilattice_inf_top α] {a : α} {b : α} : a ⊓ b = ⊤ ↔ a = ⊤ ∧ b = ⊤ := sorry

/-- A `semilattice_inf_bot` is a semilattice with bottom and meet. -/
class semilattice_inf_bot (α : Type u)
extends order_bot α, semilattice_inf α
where

@[simp] theorem bot_inf_eq {α : Type u} [semilattice_inf_bot α] {a : α} : ⊥ ⊓ a = ⊥ :=
  inf_of_le_left bot_le

@[simp] theorem inf_bot_eq {α : Type u} [semilattice_inf_bot α] {a : α} : a ⊓ ⊥ = ⊥ :=
  inf_of_le_right bot_le

/- Bounded lattices -/

/-- A bounded lattice is a lattice with a top and bottom element,
  denoted `⊤` and `⊥` respectively. This allows for the interpretation
  of all finite suprema and infima, taking `inf ∅ = ⊤` and `sup ∅ = ⊥`. -/
class bounded_lattice (α : Type u)
extends order_bot α, order_top α, lattice α
where

protected instance semilattice_inf_top_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] : semilattice_inf_top α :=
  semilattice_inf_top.mk bounded_lattice.top bounded_lattice.le bounded_lattice.lt bounded_lattice.le_refl
    bounded_lattice.le_trans bounded_lattice.le_antisymm sorry bounded_lattice.inf bounded_lattice.inf_le_left
    bounded_lattice.inf_le_right bounded_lattice.le_inf

protected instance semilattice_inf_bot_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] : semilattice_inf_bot α :=
  semilattice_inf_bot.mk bounded_lattice.bot bounded_lattice.le bounded_lattice.lt bounded_lattice.le_refl
    bounded_lattice.le_trans bounded_lattice.le_antisymm sorry bounded_lattice.inf bounded_lattice.inf_le_left
    bounded_lattice.inf_le_right bounded_lattice.le_inf

protected instance semilattice_sup_top_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] : semilattice_sup_top α :=
  semilattice_sup_top.mk bounded_lattice.top bounded_lattice.le bounded_lattice.lt bounded_lattice.le_refl
    bounded_lattice.le_trans bounded_lattice.le_antisymm sorry bounded_lattice.sup bounded_lattice.le_sup_left
    bounded_lattice.le_sup_right bounded_lattice.sup_le

protected instance semilattice_sup_bot_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] : semilattice_sup_bot α :=
  semilattice_sup_bot.mk bounded_lattice.bot bounded_lattice.le bounded_lattice.lt bounded_lattice.le_refl
    bounded_lattice.le_trans bounded_lattice.le_antisymm sorry bounded_lattice.sup bounded_lattice.le_sup_left
    bounded_lattice.le_sup_right bounded_lattice.sup_le

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

/-- A bounded distributive lattice is exactly what it sounds like. -/
class bounded_distrib_lattice (α : Type u_1)
extends distrib_lattice α, bounded_lattice α
where

theorem inf_eq_bot_iff_le_compl {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} (h₁ : b ⊔ c = ⊤) (h₂ : b ⊓ c = ⊥) : a ⊓ b = ⊥ ↔ a ≤ c := sorry

/- Prop instance -/

protected instance bounded_distrib_lattice_Prop : bounded_distrib_lattice Prop :=
  bounded_distrib_lattice.mk Or (fun (a b : Prop) => a → b) (distrib_lattice.lt._default fun (a b : Prop) => a → b) sorry
    sorry sorry Or.inl Or.inr sorry And and.left and.right sorry sorry True sorry False false.elim

protected instance Prop.linear_order : linear_order Prop :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry (classical.dec_rel LessEq)
    Mathlib.decidable_eq_of_decidable_le Mathlib.decidable_lt_of_decidable_le

@[simp] theorem le_iff_imp {p : Prop} {q : Prop} : p ≤ q ↔ p → q :=
  iff.rfl

theorem monotone_and {α : Type u} [preorder α] {p : α → Prop} {q : α → Prop} (m_p : monotone p) (m_q : monotone q) : monotone fun (x : α) => p x ∧ q x :=
  fun (a b : α) (h : a ≤ b) => and.imp (m_p h) (m_q h)

-- Note: by finish [monotone] doesn't work

theorem monotone_or {α : Type u} [preorder α] {p : α → Prop} {q : α → Prop} (m_p : monotone p) (m_q : monotone q) : monotone fun (x : α) => p x ∨ q x :=
  fun (a b : α) (h : a ≤ b) => or.imp (m_p h) (m_q h)

protected instance pi.order_bot {α : Type u_1} {β : α → Type u_2} [(a : α) → order_bot (β a)] : order_bot ((a : α) → β a) :=
  order_bot.mk (fun (_x : α) => ⊥) partial_order.le partial_order.lt sorry sorry sorry sorry

/- Function lattices -/

protected instance pi.has_sup {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_sup (α i)] : has_sup ((i : ι) → α i) :=
  has_sup.mk fun (f g : (i : ι) → α i) (i : ι) => f i ⊔ g i

@[simp] theorem sup_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_sup (α i)] (f : (i : ι) → α i) (g : (i : ι) → α i) (i : ι) : has_sup.sup f g i = f i ⊔ g i :=
  rfl

protected instance pi.has_inf {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_inf (α i)] : has_inf ((i : ι) → α i) :=
  has_inf.mk fun (f g : (i : ι) → α i) (i : ι) => f i ⊓ g i

@[simp] theorem inf_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_inf (α i)] (f : (i : ι) → α i) (g : (i : ι) → α i) (i : ι) : has_inf.inf f g i = f i ⊓ g i :=
  rfl

protected instance pi.has_bot {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_bot (α i)] : has_bot ((i : ι) → α i) :=
  has_bot.mk fun (i : ι) => ⊥

@[simp] theorem bot_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_bot (α i)] (i : ι) : ⊥ = ⊥ :=
  rfl

protected instance pi.has_top {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_top (α i)] : has_top ((i : ι) → α i) :=
  has_top.mk fun (i : ι) => ⊤

@[simp] theorem top_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_top (α i)] (i : ι) : ⊤ = ⊤ :=
  rfl

protected instance pi.semilattice_sup {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → semilattice_sup (α i)] : semilattice_sup ((i : ι) → α i) :=
  semilattice_sup.mk has_sup.sup partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

protected instance pi.semilattice_inf {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → semilattice_inf (α i)] : semilattice_inf ((i : ι) → α i) :=
  semilattice_inf.mk has_inf.inf partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

protected instance pi.semilattice_inf_bot {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → semilattice_inf_bot (α i)] : semilattice_inf_bot ((i : ι) → α i) :=
  semilattice_inf_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry has_inf.inf sorry sorry sorry

protected instance pi.semilattice_inf_top {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → semilattice_inf_top (α i)] : semilattice_inf_top ((i : ι) → α i) :=
  semilattice_inf_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry has_inf.inf sorry sorry sorry

protected instance pi.semilattice_sup_bot {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → semilattice_sup_bot (α i)] : semilattice_sup_bot ((i : ι) → α i) :=
  semilattice_sup_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry has_sup.sup sorry sorry sorry

protected instance pi.semilattice_sup_top {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → semilattice_sup_top (α i)] : semilattice_sup_top ((i : ι) → α i) :=
  semilattice_sup_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry has_sup.sup sorry sorry sorry

protected instance pi.lattice {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → lattice (α i)] : lattice ((i : ι) → α i) :=
  lattice.mk semilattice_sup.sup semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance pi.bounded_lattice {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → bounded_lattice (α i)] : bounded_lattice ((i : ι) → α i) :=
  bounded_lattice.mk semilattice_sup_top.sup semilattice_sup_top.le semilattice_sup_top.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf_bot.inf sorry sorry sorry semilattice_sup_top.top sorry semilattice_inf_bot.bot sorry

theorem eq_bot_of_bot_eq_top {α : Type u_1} [bounded_lattice α] (hα : ⊥ = ⊤) (x : α) : x = ⊥ :=
  eq_bot_mono le_top (Eq.symm hα)

theorem eq_top_of_bot_eq_top {α : Type u_1} [bounded_lattice α] (hα : ⊥ = ⊤) (x : α) : x = ⊤ :=
  eq_top_mono bot_le hα

theorem subsingleton_of_top_le_bot {α : Type u_1} [bounded_lattice α] (h : ⊤ ≤ ⊥) : subsingleton α :=
  subsingleton.intro
    fun (a b : α) => le_antisymm (le_trans le_top (le_trans h bot_le)) (le_trans le_top (le_trans h bot_le))

theorem subsingleton_of_bot_eq_top {α : Type u_1} [bounded_lattice α] (hα : ⊥ = ⊤) : subsingleton α :=
  subsingleton_of_top_le_bot (ge_of_eq hα)

theorem subsingleton_iff_bot_eq_top {α : Type u_1} [bounded_lattice α] : ⊥ = ⊤ ↔ subsingleton α :=
  { mp := subsingleton_of_bot_eq_top, mpr := fun (h : subsingleton α) => subsingleton.elim ⊥ ⊤ }

/-- Attach `⊥` to a type. -/
def with_bot (α : Type u_1) :=
  Option α

namespace with_bot

protected instance has_coe_t {α : Type u} : has_coe_t α (with_bot α) :=
  has_coe_t.mk some

protected instance has_bot {α : Type u} : has_bot (with_bot α) :=
  has_bot.mk none

protected instance inhabited {α : Type u} : Inhabited (with_bot α) :=
  { default := ⊥ }

theorem none_eq_bot {α : Type u} : none = ⊥ :=
  rfl

theorem some_eq_coe {α : Type u} (a : α) : some a = ↑a :=
  rfl

/-- Recursor for `with_bot` using the preferred forms `⊥` and `↑a`. -/
def rec_bot_coe {α : Type u} {C : with_bot α → Sort u_1} (h₁ : C ⊥) (h₂ : (a : α) → C ↑a) (n : with_bot α) : C n :=
  Option.rec h₁ h₂

theorem coe_eq_coe {α : Type u} {a : α} {b : α} : ↑a = ↑b ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a = ↑b ↔ a = b)) (Eq.symm (option.some.inj_eq a b)))) (iff.refl (↑a = ↑b))

protected instance has_lt {α : Type u} [HasLess α] : HasLess (with_bot α) :=
  { Less := fun (o₁ o₂ : Option α) => ∃ (b : α), ∃ (H : b ∈ o₂), ∀ (a : α), a ∈ o₁ → a < b }

@[simp] theorem some_lt_some {α : Type u} [HasLess α] {a : α} {b : α} : some a < some b ↔ a < b := sorry

theorem bot_lt_some {α : Type u} [HasLess α] (a : α) : ⊥ < some a :=
  Exists.intro a (Exists.intro rfl fun (b : α) (hb : b ∈ ⊥) => false.elim (option.not_mem_none b hb))

theorem bot_lt_coe {α : Type u} [HasLess α] (a : α) : ⊥ < ↑a :=
  bot_lt_some a

protected instance preorder {α : Type u} [preorder α] : preorder (with_bot α) :=
  preorder.mk (fun (o₁ o₂ : Option α) => ∀ (a : α) (H : a ∈ o₁), ∃ (b : α), ∃ (H : b ∈ o₂), a ≤ b) Less sorry sorry

protected instance partial_order {α : Type u} [partial_order α] : partial_order (with_bot α) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

protected instance order_bot {α : Type u} [partial_order α] : order_bot (with_bot α) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

@[simp] theorem coe_le_coe {α : Type u} [preorder α] {a : α} {b : α} : ↑a ≤ ↑b ↔ a ≤ b := sorry

@[simp] theorem some_le_some {α : Type u} [preorder α] {a : α} {b : α} : some a ≤ some b ↔ a ≤ b :=
  coe_le_coe

theorem coe_le {α : Type u} [partial_order α] {a : α} {b : α} {o : Option α} : b ∈ o → (↑a ≤ o ↔ a ≤ b) := sorry

theorem coe_lt_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a < ↑b ↔ a < b :=
  some_lt_some

theorem le_coe_get_or_else {α : Type u} [preorder α] (a : with_bot α) (b : α) : a ≤ ↑(option.get_or_else a b) := sorry

@[simp] theorem get_or_else_bot {α : Type u} (a : α) : option.get_or_else ⊥ a = a :=
  rfl

theorem get_or_else_bot_le_iff {α : Type u} [order_bot α] {a : with_bot α} {b : α} : option.get_or_else a ⊥ ≤ b ↔ a ≤ ↑b := sorry

protected instance decidable_le {α : Type u} [preorder α] [DecidableRel LessEq] : DecidableRel LessEq :=
  sorry

protected instance decidable_lt {α : Type u} [HasLess α] [DecidableRel Less] : DecidableRel Less :=
  sorry

protected instance linear_order {α : Type u} [linear_order α] : linear_order (with_bot α) :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry with_bot.decidable_le
    Mathlib.decidable_eq_of_decidable_le with_bot.decidable_lt

protected instance semilattice_sup {α : Type u} [semilattice_sup α] : semilattice_sup_bot (with_bot α) :=
  semilattice_sup_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry (option.lift_or_get has_sup.sup)
    sorry sorry sorry

protected instance semilattice_inf {α : Type u} [semilattice_inf α] : semilattice_inf_bot (with_bot α) :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry
    (fun (o₁ o₂ : with_bot α) => option.bind o₁ fun (a : α) => option.map (fun (b : α) => a ⊓ b) o₂) sorry sorry sorry

protected instance lattice {α : Type u} [lattice α] : lattice (with_bot α) :=
  lattice.mk semilattice_sup_bot.sup semilattice_sup_bot.le semilattice_sup_bot.lt sorry sorry sorry sorry sorry sorry
    semilattice_inf_bot.inf sorry sorry sorry

theorem lattice_eq_DLO {α : Type u} [linear_order α] : Mathlib.lattice_of_linear_order = with_bot.lattice :=
  lattice.ext fun (x y : with_bot α) => iff.rfl

theorem sup_eq_max {α : Type u} [linear_order α] (x : with_bot α) (y : with_bot α) : x ⊔ y = max x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = max x y)) (Eq.symm sup_eq_max)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = x ⊔ y)) lattice_eq_DLO)) (Eq.refl (x ⊔ y)))

theorem inf_eq_min {α : Type u} [linear_order α] (x : with_bot α) (y : with_bot α) : x ⊓ y = min x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = min x y)) (Eq.symm inf_eq_min)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = x ⊓ y)) lattice_eq_DLO)) (Eq.refl (x ⊓ y)))

protected instance order_top {α : Type u} [order_top α] : order_top (with_bot α) :=
  order_top.mk (some ⊤) partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance bounded_lattice {α : Type u} [bounded_lattice α] : bounded_lattice (with_bot α) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    order_top.top sorry order_bot.bot sorry

theorem well_founded_lt {α : Type u} [partial_order α] (h : well_founded Less) : well_founded Less := sorry

protected instance densely_ordered {α : Type u} [partial_order α] [densely_ordered α] [no_bot_order α] : densely_ordered (with_bot α) :=
  densely_ordered.mk fun (a b : with_bot α) => sorry

end with_bot

--TODO(Mario): Construct using order dual on with_bot

/-- Attach `⊤` to a type. -/
def with_top (α : Type u_1) :=
  Option α

namespace with_top

protected instance has_coe_t {α : Type u} : has_coe_t α (with_top α) :=
  has_coe_t.mk some

protected instance has_top {α : Type u} : has_top (with_top α) :=
  has_top.mk none

protected instance inhabited {α : Type u} : Inhabited (with_top α) :=
  { default := ⊤ }

theorem none_eq_top {α : Type u} : none = ⊤ :=
  rfl

theorem some_eq_coe {α : Type u} (a : α) : some a = ↑a :=
  rfl

/-- Recursor for `with_top` using the preferred forms `⊤` and `↑a`. -/
def rec_top_coe {α : Type u} {C : with_top α → Sort u_1} (h₁ : C ⊤) (h₂ : (a : α) → C ↑a) (n : with_top α) : C n :=
  Option.rec h₁ h₂

theorem coe_eq_coe {α : Type u} {a : α} {b : α} : ↑a = ↑b ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a = ↑b ↔ a = b)) (Eq.symm (option.some.inj_eq a b)))) (iff.refl (↑a = ↑b))

@[simp] theorem top_ne_coe {α : Type u} {a : α} : ⊤ ≠ ↑a :=
  fun (ᾰ : ⊤ = ↑a) => eq.dcases_on ᾰ (fun (a_1 : some a = none) => option.no_confusion a_1) (Eq.refl ↑a) (HEq.refl ᾰ)

@[simp] theorem coe_ne_top {α : Type u} {a : α} : ↑a ≠ ⊤ :=
  fun (ᾰ : ↑a = ⊤) => eq.dcases_on ᾰ (fun (a_1 : none = some a) => option.no_confusion a_1) (Eq.refl ⊤) (HEq.refl ᾰ)

protected instance has_lt {α : Type u} [HasLess α] : HasLess (with_top α) :=
  { Less := fun (o₁ o₂ : Option α) => ∃ (b : α), ∃ (H : b ∈ o₁), ∀ (a : α), a ∈ o₂ → b < a }

protected instance has_le {α : Type u} [HasLessEq α] : HasLessEq (with_top α) :=
  { LessEq := fun (o₁ o₂ : Option α) => ∀ (a : α) (H : a ∈ o₂), ∃ (b : α), ∃ (H : b ∈ o₁), b ≤ a }

@[simp] theorem some_lt_some {α : Type u} [HasLess α] {a : α} {b : α} : some a < some b ↔ a < b := sorry

@[simp] theorem some_le_some {α : Type u} [HasLessEq α] {a : α} {b : α} : some a ≤ some b ↔ a ≤ b := sorry

@[simp] theorem le_none {α : Type u} [HasLessEq α] {a : with_top α} : a ≤ none := sorry

@[simp] theorem some_lt_none {α : Type u} [HasLess α] {a : α} : some a < none := sorry

protected instance can_lift {α : Type u} : can_lift (with_top α) α :=
  can_lift.mk coe (fun (r : with_top α) => r ≠ ⊤) sorry

protected instance preorder {α : Type u} [preorder α] : preorder (with_top α) :=
  preorder.mk (fun (o₁ o₂ : Option α) => ∀ (a : α) (H : a ∈ o₂), ∃ (b : α), ∃ (H : b ∈ o₁), b ≤ a) Less sorry sorry

protected instance partial_order {α : Type u} [partial_order α] : partial_order (with_top α) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

protected instance order_top {α : Type u} [partial_order α] : order_top (with_top α) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry

@[simp] theorem coe_le_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a ≤ ↑b ↔ a ≤ b := sorry

theorem le_coe {α : Type u} [partial_order α] {a : α} {b : α} {o : Option α} : a ∈ o → (o ≤ ↑b ↔ a ≤ b) := sorry

theorem le_coe_iff {α : Type u} [partial_order α] {b : α} {x : with_top α} : x ≤ ↑b ↔ ∃ (a : α), x = ↑a ∧ a ≤ b := sorry

theorem coe_le_iff {α : Type u} [partial_order α] {a : α} {x : with_top α} : ↑a ≤ x ↔ ∀ (b : α), x = ↑b → a ≤ b := sorry

theorem lt_iff_exists_coe {α : Type u} [partial_order α] {a : with_top α} {b : with_top α} : a < b ↔ ∃ (p : α), a = ↑p ∧ ↑p < b := sorry

theorem coe_lt_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a < ↑b ↔ a < b :=
  some_lt_some

theorem coe_lt_top {α : Type u} [partial_order α] (a : α) : ↑a < ⊤ :=
  some_lt_none

theorem coe_lt_iff {α : Type u} [partial_order α] {a : α} {x : with_top α} : ↑a < x ↔ ∀ (b : α), x = ↑b → a < b := sorry

theorem not_top_le_coe {α : Type u} [partial_order α] (a : α) : ¬⊤ ≤ ↑a :=
  fun (h : ⊤ ≤ ↑a) => false.elim (lt_irrefl ⊤ (lt_of_le_of_lt h (coe_lt_top a)))

protected instance decidable_le {α : Type u} [preorder α] [DecidableRel LessEq] : DecidableRel LessEq :=
  fun (x y : with_top α) => with_bot.decidable_le y x

protected instance decidable_lt {α : Type u} [HasLess α] [DecidableRel Less] : DecidableRel Less :=
  fun (x y : with_top α) => with_bot.decidable_lt y x

protected instance linear_order {α : Type u} [linear_order α] : linear_order (with_top α) :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry with_top.decidable_le
    Mathlib.decidable_eq_of_decidable_le with_top.decidable_lt

protected instance semilattice_inf {α : Type u} [semilattice_inf α] : semilattice_inf_top (with_top α) :=
  semilattice_inf_top.mk order_top.top order_top.le order_top.lt sorry sorry sorry sorry (option.lift_or_get has_inf.inf)
    sorry sorry sorry

theorem coe_inf {α : Type u} [semilattice_inf α] (a : α) (b : α) : ↑(a ⊓ b) = ↑a ⊓ ↑b :=
  rfl

protected instance semilattice_sup {α : Type u} [semilattice_sup α] : semilattice_sup_top (with_top α) :=
  semilattice_sup_top.mk order_top.top order_top.le order_top.lt sorry sorry sorry sorry
    (fun (o₁ o₂ : with_top α) => option.bind o₁ fun (a : α) => option.map (fun (b : α) => a ⊔ b) o₂) sorry sorry sorry

theorem coe_sup {α : Type u} [semilattice_sup α] (a : α) (b : α) : ↑(a ⊔ b) = ↑a ⊔ ↑b :=
  rfl

protected instance lattice {α : Type u} [lattice α] : lattice (with_top α) :=
  lattice.mk semilattice_sup_top.sup semilattice_sup_top.le semilattice_sup_top.lt sorry sorry sorry sorry sorry sorry
    semilattice_inf_top.inf sorry sorry sorry

theorem lattice_eq_DLO {α : Type u} [linear_order α] : Mathlib.lattice_of_linear_order = with_top.lattice :=
  lattice.ext fun (x y : with_top α) => iff.rfl

theorem sup_eq_max {α : Type u} [linear_order α] (x : with_top α) (y : with_top α) : x ⊔ y = max x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = max x y)) (Eq.symm sup_eq_max)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = x ⊔ y)) lattice_eq_DLO)) (Eq.refl (x ⊔ y)))

theorem inf_eq_min {α : Type u} [linear_order α] (x : with_top α) (y : with_top α) : x ⊓ y = min x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = min x y)) (Eq.symm inf_eq_min)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = x ⊓ y)) lattice_eq_DLO)) (Eq.refl (x ⊓ y)))

protected instance order_bot {α : Type u} [order_bot α] : order_bot (with_top α) :=
  order_bot.mk (some ⊥) partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance bounded_lattice {α : Type u} [bounded_lattice α] : bounded_lattice (with_top α) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    order_top.top sorry order_bot.bot sorry

theorem well_founded_lt {α : Type u_1} [partial_order α] (h : well_founded Less) : well_founded Less := sorry

protected instance densely_ordered {α : Type u} [partial_order α] [densely_ordered α] [no_top_order α] : densely_ordered (with_top α) :=
  densely_ordered.mk fun (a b : with_top α) => sorry

theorem lt_iff_exists_coe_btwn {α : Type u} [partial_order α] [densely_ordered α] [no_top_order α] {a : with_top α} {b : with_top α} : a < b ↔ ∃ (x : α), a < ↑x ∧ ↑x < b := sorry

end with_top

namespace subtype

/-- A subtype forms a `⊔`-`⊥`-semilattice if `⊥` and `⊔` preserve the property. -/
protected def semilattice_sup_bot {α : Type u} [semilattice_sup_bot α] {P : α → Prop} (Pbot : P ⊥) (Psup : ∀ {x y : α}, P x → P y → P (x ⊔ y)) : semilattice_sup_bot (Subtype fun (x : α) => P x) :=
  semilattice_sup_bot.mk { val := ⊥, property := Pbot } semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

/-- A subtype forms a `⊓`-`⊥`-semilattice if `⊥` and `⊓` preserve the property. -/
protected def semilattice_inf_bot {α : Type u} [semilattice_inf_bot α] {P : α → Prop} (Pbot : P ⊥) (Pinf : ∀ {x y : α}, P x → P y → P (x ⊓ y)) : semilattice_inf_bot (Subtype fun (x : α) => P x) :=
  semilattice_inf_bot.mk { val := ⊥, property := Pbot } semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

/-- A subtype forms a `⊓`-`⊤`-semilattice if `⊤` and `⊓` preserve the property. -/
protected def semilattice_inf_top {α : Type u} [semilattice_inf_top α] {P : α → Prop} (Ptop : P ⊤) (Pinf : ∀ {x y : α}, P x → P y → P (x ⊓ y)) : semilattice_inf_top (Subtype fun (x : α) => P x) :=
  semilattice_inf_top.mk { val := ⊤, property := Ptop } semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

end subtype

namespace order_dual

protected instance has_top (α : Type u) [has_bot α] : has_top (order_dual α) :=
  has_top.mk ⊥

protected instance has_bot (α : Type u) [has_top α] : has_bot (order_dual α) :=
  has_bot.mk ⊤

protected instance order_top (α : Type u) [order_bot α] : order_top (order_dual α) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry bot_le

protected instance order_bot (α : Type u) [order_top α] : order_bot (order_dual α) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry le_top

protected instance semilattice_sup_top (α : Type u) [semilattice_inf_bot α] : semilattice_sup_top (order_dual α) :=
  semilattice_sup_top.mk order_top.top semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry semilattice_sup.sup
    sorry sorry sorry

protected instance semilattice_sup_bot (α : Type u) [semilattice_inf_top α] : semilattice_sup_bot (order_dual α) :=
  semilattice_sup_bot.mk order_bot.bot semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry semilattice_sup.sup
    sorry sorry sorry

protected instance semilattice_inf_top (α : Type u) [semilattice_sup_bot α] : semilattice_inf_top (order_dual α) :=
  semilattice_inf_top.mk order_top.top semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry semilattice_inf.inf
    sorry sorry sorry

protected instance semilattice_inf_bot (α : Type u) [semilattice_sup_top α] : semilattice_inf_bot (order_dual α) :=
  semilattice_inf_bot.mk order_bot.bot semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry semilattice_inf.inf
    sorry sorry sorry

protected instance bounded_lattice (α : Type u) [bounded_lattice α] : bounded_lattice (order_dual α) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    order_top.top sorry order_bot.bot sorry

protected instance bounded_distrib_lattice (α : Type u) [bounded_distrib_lattice α] : bounded_distrib_lattice (order_dual α) :=
  bounded_distrib_lattice.mk bounded_lattice.sup bounded_lattice.le bounded_lattice.lt sorry sorry sorry sorry sorry sorry
    bounded_lattice.inf sorry sorry sorry sorry bounded_lattice.top sorry bounded_lattice.bot sorry

end order_dual

namespace prod

protected instance has_top (α : Type u) (β : Type v) [has_top α] [has_top β] : has_top (α × β) :=
  has_top.mk (⊤, ⊤)

protected instance has_bot (α : Type u) (β : Type v) [has_bot α] [has_bot β] : has_bot (α × β) :=
  has_bot.mk (⊥, ⊥)

protected instance order_top (α : Type u) (β : Type v) [order_top α] [order_top β] : order_top (α × β) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance order_bot (α : Type u) (β : Type v) [order_bot α] [order_bot β] : order_bot (α × β) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance semilattice_sup_top (α : Type u) (β : Type v) [semilattice_sup_top α] [semilattice_sup_top β] : semilattice_sup_top (α × β) :=
  semilattice_sup_top.mk order_top.top semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry semilattice_sup.sup
    sorry sorry sorry

protected instance semilattice_inf_top (α : Type u) (β : Type v) [semilattice_inf_top α] [semilattice_inf_top β] : semilattice_inf_top (α × β) :=
  semilattice_inf_top.mk order_top.top semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry semilattice_inf.inf
    sorry sorry sorry

protected instance semilattice_sup_bot (α : Type u) (β : Type v) [semilattice_sup_bot α] [semilattice_sup_bot β] : semilattice_sup_bot (α × β) :=
  semilattice_sup_bot.mk order_bot.bot semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry semilattice_sup.sup
    sorry sorry sorry

protected instance semilattice_inf_bot (α : Type u) (β : Type v) [semilattice_inf_bot α] [semilattice_inf_bot β] : semilattice_inf_bot (α × β) :=
  semilattice_inf_bot.mk order_bot.bot semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry semilattice_inf.inf
    sorry sorry sorry

protected instance bounded_lattice (α : Type u) (β : Type v) [bounded_lattice α] [bounded_lattice β] : bounded_lattice (α × β) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    order_top.top sorry order_bot.bot sorry

protected instance bounded_distrib_lattice (α : Type u) (β : Type v) [bounded_distrib_lattice α] [bounded_distrib_lattice β] : bounded_distrib_lattice (α × β) :=
  bounded_distrib_lattice.mk bounded_lattice.sup bounded_lattice.le bounded_lattice.lt sorry sorry sorry sorry sorry sorry
    bounded_lattice.inf sorry sorry sorry sorry bounded_lattice.top sorry bounded_lattice.bot sorry

end prod

/-- Two elements of a lattice are disjoint if their inf is the bottom element.
  (This generalizes disjoint sets, viewed as members of the subset lattice.) -/
def disjoint {α : Type u} [semilattice_inf_bot α] (a : α) (b : α) :=
  a ⊓ b ≤ ⊥

theorem disjoint.eq_bot {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} (h : disjoint a b) : a ⊓ b = ⊥ :=
  iff.mpr eq_bot_iff h

theorem disjoint_iff {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} : disjoint a b ↔ a ⊓ b = ⊥ :=
  iff.symm eq_bot_iff

theorem disjoint.comm {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} : disjoint a b ↔ disjoint b a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (disjoint a b ↔ disjoint b a)) (disjoint.equations._eqn_1 a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊓ b ≤ ⊥ ↔ disjoint b a)) (disjoint.equations._eqn_1 b a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊓ b ≤ ⊥ ↔ b ⊓ a ≤ ⊥)) inf_comm)) (iff.refl (b ⊓ a ≤ ⊥))))

theorem disjoint.symm {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} : disjoint a b → disjoint b a :=
  iff.mp disjoint.comm

@[simp] theorem disjoint_bot_left {α : Type u} [semilattice_inf_bot α] {a : α} : disjoint ⊥ a :=
  inf_le_left

@[simp] theorem disjoint_bot_right {α : Type u} [semilattice_inf_bot α] {a : α} : disjoint a ⊥ :=
  inf_le_right

theorem disjoint.mono {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} {c : α} {d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) : disjoint b d → disjoint a c :=
  le_trans (inf_le_inf h₁ h₂)

theorem disjoint.mono_left {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} {c : α} (h : a ≤ b) : disjoint b c → disjoint a c :=
  disjoint.mono h (le_refl c)

theorem disjoint.mono_right {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} {c : α} (h : b ≤ c) : disjoint a c → disjoint a b :=
  disjoint.mono (le_refl a) h

@[simp] theorem disjoint_self {α : Type u} [semilattice_inf_bot α] {a : α} : disjoint a a ↔ a = ⊥ := sorry

theorem disjoint.ne {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} (ha : a ≠ ⊥) (hab : disjoint a b) : a ≠ b := sorry

@[simp] theorem disjoint_top {α : Type u} [bounded_lattice α] {a : α} : disjoint a ⊤ ↔ a = ⊥ := sorry

@[simp] theorem top_disjoint {α : Type u} [bounded_lattice α] {a : α} : disjoint ⊤ a ↔ a = ⊥ := sorry

@[simp] theorem disjoint_sup_left {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} : disjoint (a ⊔ b) c ↔ disjoint a c ∧ disjoint b c := sorry

@[simp] theorem disjoint_sup_right {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} : disjoint a (b ⊔ c) ↔ disjoint a b ∧ disjoint a c := sorry

theorem disjoint.sup_left {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} (ha : disjoint a c) (hb : disjoint b c) : disjoint (a ⊔ b) c :=
  iff.mpr disjoint_sup_left { left := ha, right := hb }

theorem disjoint.sup_right {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} (hb : disjoint a b) (hc : disjoint a c) : disjoint a (b ⊔ c) :=
  iff.mpr disjoint_sup_right { left := hb, right := hc }

theorem disjoint.left_le_of_le_sup_right {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} (h : a ≤ b ⊔ c) (hd : disjoint a c) : a ≤ b :=
  (fun (x : a ⊓ c ≤ b ⊓ c) => le_of_inf_le_sup_le x (sup_le h le_sup_right)) (Eq.symm (iff.mp disjoint_iff hd) ▸ bot_le)

theorem disjoint.left_le_of_le_sup_left {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} (h : a ≤ c ⊔ b) (hd : disjoint a c) : a ≤ b :=
  le_of_inf_le_sup_le (Eq.symm (iff.mp disjoint_iff hd) ▸ bot_le) (sup_comm ▸ sup_le h le_sup_left)

/-!
### `is_compl` predicate
-/

/-- Two elements `x` and `y` are complements of each other if
`x ⊔ y = ⊤` and `x ⊓ y = ⊥`. -/
structure is_compl {α : Type u} [bounded_lattice α] (x : α) (y : α)
where
  inf_le_bot : x ⊓ y ≤ ⊥
  top_le_sup : ⊤ ≤ x ⊔ y

namespace is_compl

protected theorem disjoint {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) : disjoint x y :=
  inf_le_bot h

protected theorem symm {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) : is_compl y x :=
  mk (eq.mpr (id (Eq._oldrec (Eq.refl (y ⊓ x ≤ ⊥)) inf_comm)) (inf_le_bot h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⊤ ≤ y ⊔ x)) sup_comm)) (top_le_sup h))

theorem of_eq {α : Type u} [bounded_lattice α] {x : α} {y : α} (h₁ : x ⊓ y = ⊥) (h₂ : x ⊔ y = ⊤) : is_compl x y :=
  mk (le_of_eq h₁) (le_of_eq (Eq.symm h₂))

theorem inf_eq_bot {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) : x ⊓ y = ⊥ :=
  disjoint.eq_bot (is_compl.disjoint h)

theorem sup_eq_top {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) : x ⊔ y = ⊤ :=
  top_unique (top_le_sup h)

theorem to_order_dual {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) : is_compl x y :=
  mk (top_le_sup h) (inf_le_bot h)

theorem le_left_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl x y) : z ≤ x ↔ disjoint z y :=
  { mp := fun (hz : z ≤ x) => disjoint.mono_left hz (is_compl.disjoint h),
    mpr := fun (hz : disjoint z y) => le_of_inf_le_sup_le (le_trans hz bot_le) (le_trans le_top (top_le_sup h)) }

theorem le_right_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl x y) : z ≤ y ↔ disjoint z x :=
  le_left_iff (is_compl.symm h)

theorem left_le_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl x y) : x ≤ z ↔ ⊤ ≤ z ⊔ y :=
  le_left_iff (to_order_dual h)

theorem right_le_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl x y) : y ≤ z ↔ ⊤ ≤ z ⊔ x :=
  left_le_iff (is_compl.symm h)

theorem antimono {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {x' : α} {y' : α} (h : is_compl x y) (h' : is_compl x' y') (hx : x ≤ x') : y' ≤ y :=
  iff.mpr (right_le_iff h') (le_trans (top_le_sup (is_compl.symm h)) (sup_le_sup_left hx y))

theorem right_unique {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (hxy : is_compl x y) (hxz : is_compl x z) : y = z :=
  le_antisymm (antimono hxz hxy (le_refl x)) (antimono hxy hxz (le_refl x))

theorem left_unique {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (hxz : is_compl x z) (hyz : is_compl y z) : x = y :=
  right_unique (is_compl.symm hxz) (is_compl.symm hyz)

theorem sup_inf {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {x' : α} {y' : α} (h : is_compl x y) (h' : is_compl x' y') : is_compl (x ⊔ x') (y ⊓ y') := sorry

theorem inf_sup {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {x' : α} {y' : α} (h : is_compl x y) (h' : is_compl x' y') : is_compl (x ⊓ x') (y ⊔ y') :=
  is_compl.symm (sup_inf (is_compl.symm h) (is_compl.symm h'))

theorem inf_left_eq_bot_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl y z) : x ⊓ y = ⊥ ↔ x ≤ z :=
  inf_eq_bot_iff_le_compl (sup_eq_top h) (inf_eq_bot h)

theorem inf_right_eq_bot_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl y z) : x ⊓ z = ⊥ ↔ x ≤ y :=
  inf_left_eq_bot_iff (is_compl.symm h)

theorem disjoint_left_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl y z) : disjoint x y ↔ x ≤ z :=
  iff.trans disjoint_iff (inf_left_eq_bot_iff h)

theorem disjoint_right_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α} (h : is_compl y z) : disjoint x z ↔ x ≤ y :=
  disjoint_left_iff (is_compl.symm h)

end is_compl

theorem is_compl_bot_top {α : Type u} [bounded_lattice α] : is_compl ⊥ ⊤ :=
  is_compl.of_eq bot_inf_eq sup_top_eq

theorem is_compl_top_bot {α : Type u} [bounded_lattice α] : is_compl ⊤ ⊥ :=
  is_compl.of_eq inf_bot_eq top_sup_eq

theorem bot_ne_top {α : Type u} [bounded_lattice α] [nontrivial α] : ⊥ ≠ ⊤ :=
  fun (H : ⊥ = ⊤) => iff.mpr not_nontrivial_iff_subsingleton (subsingleton_of_bot_eq_top H) _inst_2

theorem top_ne_bot {α : Type u} [bounded_lattice α] [nontrivial α] : ⊤ ≠ ⊥ :=
  ne.symm bot_ne_top

namespace bool

protected instance bounded_lattice : bounded_lattice Bool :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    tt sorry false sorry

end bool

@[simp] theorem top_eq_tt : ⊤ = tt :=
  rfl

@[simp] theorem bot_eq_ff : ⊥ = false :=
  rfl


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Scott Morrison

! This file was ported from Lean 3 source module category_theory.subobject.limits
! leanprover-community/mathlib commit 956af7c76589f444f2e1313911bad16366ea476d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Subobject.Lattice

/-!
# Specific subobjects

We define `equalizer_subobject`, `kernel_subobject` and `image_subobject`, which are the subobjects
represented by the equalizer, kernel and image of (a pair of) morphism(s) and provide conditions
for `P.factors f`, where `P` is one of these special subobjects.

TODO: Add conditions for when `P` is a pullback subobject.
TODO: an iff characterisation of `(image_subobject f).factors h`

-/

universe v u

noncomputable section

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Subobject Opposite

variable {C : Type u} [Category.{v} C] {X Y Z : C}

namespace CategoryTheory

namespace Limits

section Equalizer

variable (f g : X ⟶ Y) [HasEqualizer f g]

/-- The equalizer of morphisms `f g : X ⟶ Y` as a `subobject X`. -/
abbrev equalizerSubobject : Subobject X :=
  Subobject.mk (equalizer.ι f g)
#align category_theory.limits.equalizer_subobject CategoryTheory.Limits.equalizerSubobject

/-- The underlying object of `equalizer_subobject f g` is (up to isomorphism!)
the same as the chosen object `equalizer f g`. -/
def equalizerSubobjectIso : (equalizerSubobject f g : C) ≅ equalizer f g :=
  Subobject.underlyingIso (equalizer.ι f g)
#align category_theory.limits.equalizer_subobject_iso CategoryTheory.Limits.equalizerSubobjectIso

@[simp, reassoc.1]
theorem equalizerSubobject_arrow :
    (equalizerSubobjectIso f g).Hom ≫ equalizer.ι f g = (equalizerSubobject f g).arrow := by
  simp [equalizer_subobject_iso]
#align category_theory.limits.equalizer_subobject_arrow CategoryTheory.Limits.equalizerSubobject_arrow

@[simp, reassoc.1]
theorem equalizerSubobject_arrow' :
    (equalizerSubobjectIso f g).inv ≫ (equalizerSubobject f g).arrow = equalizer.ι f g := by
  simp [equalizer_subobject_iso]
#align category_theory.limits.equalizer_subobject_arrow' CategoryTheory.Limits.equalizerSubobject_arrow'

@[reassoc.1]
theorem equalizerSubobject_arrow_comp :
    (equalizerSubobject f g).arrow ≫ f = (equalizerSubobject f g).arrow ≫ g := by
  rw [← equalizer_subobject_arrow, category.assoc, category.assoc, equalizer.condition]
#align category_theory.limits.equalizer_subobject_arrow_comp CategoryTheory.Limits.equalizerSubobject_arrow_comp

theorem equalizerSubobject_factors {W : C} (h : W ⟶ X) (w : h ≫ f = h ≫ g) :
    (equalizerSubobject f g).Factors h :=
  ⟨equalizer.lift h w, by simp⟩
#align category_theory.limits.equalizer_subobject_factors CategoryTheory.Limits.equalizerSubobject_factors

theorem equalizerSubobject_factors_iff {W : C} (h : W ⟶ X) :
    (equalizerSubobject f g).Factors h ↔ h ≫ f = h ≫ g :=
  ⟨fun w => by
    rw [← subobject.factor_thru_arrow _ _ w, category.assoc, equalizer_subobject_arrow_comp,
      category.assoc],
    equalizerSubobject_factors f g h⟩
#align category_theory.limits.equalizer_subobject_factors_iff CategoryTheory.Limits.equalizerSubobject_factors_iff

end Equalizer

section Kernel

variable [HasZeroMorphisms C] (f : X ⟶ Y) [HasKernel f]

/-- The kernel of a morphism `f : X ⟶ Y` as a `subobject X`. -/
abbrev kernelSubobject : Subobject X :=
  Subobject.mk (kernel.ι f)
#align category_theory.limits.kernel_subobject CategoryTheory.Limits.kernelSubobject

/-- The underlying object of `kernel_subobject f` is (up to isomorphism!)
the same as the chosen object `kernel f`. -/
def kernelSubobjectIso : (kernelSubobject f : C) ≅ kernel f :=
  Subobject.underlyingIso (kernel.ι f)
#align category_theory.limits.kernel_subobject_iso CategoryTheory.Limits.kernelSubobjectIso

@[simp, reassoc.1, elementwise]
theorem kernelSubobject_arrow :
    (kernelSubobjectIso f).Hom ≫ kernel.ι f = (kernelSubobject f).arrow := by
  simp [kernel_subobject_iso]
#align category_theory.limits.kernel_subobject_arrow CategoryTheory.Limits.kernelSubobject_arrow

@[simp, reassoc.1, elementwise]
theorem kernelSubobject_arrow' :
    (kernelSubobjectIso f).inv ≫ (kernelSubobject f).arrow = kernel.ι f := by
  simp [kernel_subobject_iso]
#align category_theory.limits.kernel_subobject_arrow' CategoryTheory.Limits.kernelSubobject_arrow'

@[simp, reassoc.1, elementwise]
theorem kernelSubobject_arrow_comp : (kernelSubobject f).arrow ≫ f = 0 :=
  by
  rw [← kernel_subobject_arrow]
  simp only [category.assoc, kernel.condition, comp_zero]
#align category_theory.limits.kernel_subobject_arrow_comp CategoryTheory.Limits.kernelSubobject_arrow_comp

theorem kernelSubobject_factors {W : C} (h : W ⟶ X) (w : h ≫ f = 0) :
    (kernelSubobject f).Factors h :=
  ⟨kernel.lift _ h w, by simp⟩
#align category_theory.limits.kernel_subobject_factors CategoryTheory.Limits.kernelSubobject_factors

theorem kernelSubobject_factors_iff {W : C} (h : W ⟶ X) :
    (kernelSubobject f).Factors h ↔ h ≫ f = 0 :=
  ⟨fun w => by
    rw [← subobject.factor_thru_arrow _ _ w, category.assoc, kernel_subobject_arrow_comp,
      comp_zero],
    kernelSubobject_factors f h⟩
#align category_theory.limits.kernel_subobject_factors_iff CategoryTheory.Limits.kernelSubobject_factors_iff

/-- A factorisation of `h : W ⟶ X` through `kernel_subobject f`, assuming `h ≫ f = 0`. -/
def factorThruKernelSubobject {W : C} (h : W ⟶ X) (w : h ≫ f = 0) : W ⟶ kernelSubobject f :=
  (kernelSubobject f).factorThru h (kernelSubobject_factors f h w)
#align category_theory.limits.factor_thru_kernel_subobject CategoryTheory.Limits.factorThruKernelSubobject

@[simp]
theorem factorThruKernelSubobject_comp_arrow {W : C} (h : W ⟶ X) (w : h ≫ f = 0) :
    factorThruKernelSubobject f h w ≫ (kernelSubobject f).arrow = h :=
  by
  dsimp [factor_thru_kernel_subobject]
  simp
#align category_theory.limits.factor_thru_kernel_subobject_comp_arrow CategoryTheory.Limits.factorThruKernelSubobject_comp_arrow

@[simp]
theorem factorThruKernelSubobject_comp_kernelSubobjectIso {W : C} (h : W ⟶ X) (w : h ≫ f = 0) :
    factorThruKernelSubobject f h w ≫ (kernelSubobjectIso f).Hom = kernel.lift f h w :=
  (cancel_mono (kernel.ι f)).1 <| by simp
#align category_theory.limits.factor_thru_kernel_subobject_comp_kernel_subobject_iso CategoryTheory.Limits.factorThruKernelSubobject_comp_kernelSubobjectIso

section

variable {f} {X' Y' : C} {f' : X' ⟶ Y'} [HasKernel f']

/-- A commuting square induces a morphism between the kernel subobjects. -/
def kernelSubobjectMap (sq : Arrow.mk f ⟶ Arrow.mk f') :
    (kernelSubobject f : C) ⟶ (kernelSubobject f' : C) :=
  Subobject.factorThru _ ((kernelSubobject f).arrow ≫ sq.left)
    (kernelSubobject_factors _ _ (by simp [sq.w]))
#align category_theory.limits.kernel_subobject_map CategoryTheory.Limits.kernelSubobjectMap

@[simp, reassoc.1, elementwise]
theorem kernelSubobjectMap_arrow (sq : Arrow.mk f ⟶ Arrow.mk f') :
    kernelSubobjectMap sq ≫ (kernelSubobject f').arrow = (kernelSubobject f).arrow ≫ sq.left := by
  simp [kernel_subobject_map]
#align category_theory.limits.kernel_subobject_map_arrow CategoryTheory.Limits.kernelSubobjectMap_arrow

@[simp]
theorem kernelSubobjectMap_id : kernelSubobjectMap (𝟙 (Arrow.mk f)) = 𝟙 _ :=
  by
  ext
  simp
  dsimp
  simp
#align category_theory.limits.kernel_subobject_map_id CategoryTheory.Limits.kernelSubobjectMap_id

-- See library note [dsimp, simp].
@[simp]
theorem kernelSubobjectMap_comp {X'' Y'' : C} {f'' : X'' ⟶ Y''} [HasKernel f'']
    (sq : Arrow.mk f ⟶ Arrow.mk f') (sq' : Arrow.mk f' ⟶ Arrow.mk f'') :
    kernelSubobjectMap (sq ≫ sq') = kernelSubobjectMap sq ≫ kernelSubobjectMap sq' :=
  by
  ext
  simp
#align category_theory.limits.kernel_subobject_map_comp CategoryTheory.Limits.kernelSubobjectMap_comp

@[reassoc.1]
theorem kernel_map_comp_kernelSubobjectIso_inv (sq : Arrow.mk f ⟶ Arrow.mk f') :
    kernel.map f f' sq.1 sq.2 sq.3.symm ≫ (kernelSubobjectIso _).inv =
      (kernelSubobjectIso _).inv ≫ kernelSubobjectMap sq :=
  by ext <;> simp
#align category_theory.limits.kernel_map_comp_kernel_subobject_iso_inv CategoryTheory.Limits.kernel_map_comp_kernelSubobjectIso_inv

@[reassoc.1]
theorem kernelSubobjectIso_comp_kernel_map (sq : Arrow.mk f ⟶ Arrow.mk f') :
    (kernelSubobjectIso _).Hom ≫ kernel.map f f' sq.1 sq.2 sq.3.symm =
      kernelSubobjectMap sq ≫ (kernelSubobjectIso _).Hom :=
  by simp [← iso.comp_inv_eq, kernel_map_comp_kernel_subobject_iso_inv]
#align category_theory.limits.kernel_subobject_iso_comp_kernel_map CategoryTheory.Limits.kernelSubobjectIso_comp_kernel_map

end

@[simp]
theorem kernelSubobject_zero {A B : C} : kernelSubobject (0 : A ⟶ B) = ⊤ :=
  (isIso_iff_mk_eq_top _).mp (by infer_instance)
#align category_theory.limits.kernel_subobject_zero CategoryTheory.Limits.kernelSubobject_zero

instance isIso_kernelSubobject_zero_arrow : IsIso (kernelSubobject (0 : X ⟶ Y)).arrow :=
  (isIso_arrow_iff_eq_top _).mpr kernelSubobject_zero
#align category_theory.limits.is_iso_kernel_subobject_zero_arrow CategoryTheory.Limits.isIso_kernelSubobject_zero_arrow

theorem le_kernelSubobject (A : Subobject X) (h : A.arrow ≫ f = 0) : A ≤ kernelSubobject f :=
  Subobject.le_mk_of_comm (kernel.lift f A.arrow h) (by simp)
#align category_theory.limits.le_kernel_subobject CategoryTheory.Limits.le_kernelSubobject

/-- The isomorphism between the kernel of `f ≫ g` and the kernel of `g`,
when `f` is an isomorphism.
-/
def kernelSubobjectIsoComp {X' : C} (f : X' ⟶ X) [IsIso f] (g : X ⟶ Y) [HasKernel g] :
    (kernelSubobject (f ≫ g) : C) ≅ (kernelSubobject g : C) :=
  kernelSubobjectIso _ ≪≫ kernelIsIsoComp f g ≪≫ (kernelSubobjectIso _).symm
#align category_theory.limits.kernel_subobject_iso_comp CategoryTheory.Limits.kernelSubobjectIsoComp

@[simp]
theorem kernelSubobjectIsoComp_hom_arrow {X' : C} (f : X' ⟶ X) [IsIso f] (g : X ⟶ Y) [HasKernel g] :
    (kernelSubobjectIsoComp f g).Hom ≫ (kernelSubobject g).arrow =
      (kernelSubobject (f ≫ g)).arrow ≫ f :=
  by simp [kernel_subobject_iso_comp]
#align category_theory.limits.kernel_subobject_iso_comp_hom_arrow CategoryTheory.Limits.kernelSubobjectIsoComp_hom_arrow

@[simp]
theorem kernelSubobjectIsoComp_inv_arrow {X' : C} (f : X' ⟶ X) [IsIso f] (g : X ⟶ Y) [HasKernel g] :
    (kernelSubobjectIsoComp f g).inv ≫ (kernelSubobject (f ≫ g)).arrow =
      (kernelSubobject g).arrow ≫ inv f :=
  by simp [kernel_subobject_iso_comp]
#align category_theory.limits.kernel_subobject_iso_comp_inv_arrow CategoryTheory.Limits.kernelSubobjectIsoComp_inv_arrow

/-- The kernel of `f` is always a smaller subobject than the kernel of `f ≫ h`. -/
theorem kernelSubobject_comp_le (f : X ⟶ Y) [HasKernel f] {Z : C} (h : Y ⟶ Z) [HasKernel (f ≫ h)] :
    kernelSubobject f ≤ kernelSubobject (f ≫ h) :=
  le_kernelSubobject _ _ (by simp)
#align category_theory.limits.kernel_subobject_comp_le CategoryTheory.Limits.kernelSubobject_comp_le

/-- Postcomposing by an monomorphism does not change the kernel subobject. -/
@[simp]
theorem kernelSubobject_comp_mono (f : X ⟶ Y) [HasKernel f] {Z : C} (h : Y ⟶ Z) [Mono h] :
    kernelSubobject (f ≫ h) = kernelSubobject f :=
  le_antisymm (le_kernelSubobject _ _ ((cancel_mono h).mp (by simp))) (kernelSubobject_comp_le f h)
#align category_theory.limits.kernel_subobject_comp_mono CategoryTheory.Limits.kernelSubobject_comp_mono

instance kernelSubobject_comp_mono_isIso (f : X ⟶ Y) [HasKernel f] {Z : C} (h : Y ⟶ Z) [Mono h] :
    IsIso (Subobject.ofLe _ _ (kernelSubobject_comp_le f h)) :=
  by
  rw [of_le_mk_le_mk_of_comm (kernel_comp_mono f h).inv]
  · infer_instance
  · simp
#align category_theory.limits.kernel_subobject_comp_mono_is_iso CategoryTheory.Limits.kernelSubobject_comp_mono_isIso

/-- Taking cokernels is an order-reversing map from the subobjects of `X` to the quotient objects
    of `X`. -/
@[simps]
def cokernelOrderHom [HasCokernels C] (X : C) : Subobject X →o (Subobject (op X))ᵒᵈ
    where
  toFun :=
    Subobject.lift (fun A f hf => Subobject.mk (cokernel.π f).op)
      (by
        rintro A B f g hf hg i rfl
        refine' subobject.mk_eq_mk_of_comm _ _ (iso.op _) (Quiver.Hom.unop_inj _)
        ·
          exact
            (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
                (is_cokernel_epi_comp (colimit.is_colimit _) i.hom rfl)).symm
        ·
          simp only [iso.comp_inv_eq, iso.op_hom, iso.symm_hom, unop_comp, Quiver.Hom.unop_op,
            colimit.comp_cocone_point_unique_up_to_iso_hom, cofork.of_π_ι_app,
            coequalizer.cofork_π])
  monotone' :=
    Subobject.ind₂ _ <| by
      intro A B f g hf hg h
      dsimp only [subobject.lift_mk]
      refine' subobject.mk_le_mk_of_comm (cokernel.desc f (cokernel.π g) _).op _
      · rw [← subobject.of_mk_le_mk_comp h, category.assoc, cokernel.condition, comp_zero]
      · exact Quiver.Hom.unop_inj (cokernel.π_desc _ _ _)
#align category_theory.limits.cokernel_order_hom CategoryTheory.Limits.cokernelOrderHom

/-- Taking kernels is an order-reversing map from the quotient objects of `X` to the subobjects of
    `X`. -/
@[simps]
def kernelOrderHom [HasKernels C] (X : C) : (Subobject (op X))ᵒᵈ →o Subobject X
    where
  toFun :=
    Subobject.lift (fun A f hf => Subobject.mk (kernel.ι f.unop))
      (by
        rintro A B f g hf hg i rfl
        refine' subobject.mk_eq_mk_of_comm _ _ _ _
        ·
          exact
            is_limit.cone_point_unique_up_to_iso (limit.is_limit _)
              (is_kernel_comp_mono (limit.is_limit (parallel_pair g.unop 0)) i.unop.hom rfl)
        · dsimp
          simp only [← iso.eq_inv_comp, limit.cone_point_unique_up_to_iso_inv_comp,
            fork.of_ι_π_app])
  monotone' :=
    Subobject.ind₂ _ <| by
      intro A B f g hf hg h
      dsimp only [subobject.lift_mk]
      refine' subobject.mk_le_mk_of_comm (kernel.lift g.unop (kernel.ι f.unop) _) _
      · rw [← subobject.of_mk_le_mk_comp h, unop_comp, kernel.condition_assoc, zero_comp]
      · exact Quiver.Hom.op_inj (by simp)
#align category_theory.limits.kernel_order_hom CategoryTheory.Limits.kernelOrderHom

end Kernel

section Image

variable (f : X ⟶ Y) [HasImage f]

/-- The image of a morphism `f g : X ⟶ Y` as a `subobject Y`. -/
abbrev imageSubobject : Subobject Y :=
  Subobject.mk (image.ι f)
#align category_theory.limits.image_subobject CategoryTheory.Limits.imageSubobject

/-- The underlying object of `image_subobject f` is (up to isomorphism!)
the same as the chosen object `image f`. -/
def imageSubobjectIso : (imageSubobject f : C) ≅ image f :=
  Subobject.underlyingIso (image.ι f)
#align category_theory.limits.image_subobject_iso CategoryTheory.Limits.imageSubobjectIso

@[simp, reassoc.1]
theorem imageSubobject_arrow : (imageSubobjectIso f).Hom ≫ image.ι f = (imageSubobject f).arrow :=
  by simp [image_subobject_iso]
#align category_theory.limits.image_subobject_arrow CategoryTheory.Limits.imageSubobject_arrow

@[simp, reassoc.1]
theorem imageSubobject_arrow' : (imageSubobjectIso f).inv ≫ (imageSubobject f).arrow = image.ι f :=
  by simp [image_subobject_iso]
#align category_theory.limits.image_subobject_arrow' CategoryTheory.Limits.imageSubobject_arrow'

/-- A factorisation of `f : X ⟶ Y` through `image_subobject f`. -/
def factorThruImageSubobject : X ⟶ imageSubobject f :=
  factorThruImage f ≫ (imageSubobjectIso f).inv
#align category_theory.limits.factor_thru_image_subobject CategoryTheory.Limits.factorThruImageSubobject

instance [HasEqualizers C] : Epi (factorThruImageSubobject f) :=
  by
  dsimp [factor_thru_image_subobject]
  apply epi_comp

@[simp, reassoc.1, elementwise]
theorem imageSubobject_arrow_comp : factorThruImageSubobject f ≫ (imageSubobject f).arrow = f := by
  simp [factor_thru_image_subobject, image_subobject_arrow]
#align category_theory.limits.image_subobject_arrow_comp CategoryTheory.Limits.imageSubobject_arrow_comp

theorem imageSubobject_arrow_comp_eq_zero [HasZeroMorphisms C] {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z}
    [HasImage f] [Epi (factorThruImageSubobject f)] (h : f ≫ g = 0) :
    (imageSubobject f).arrow ≫ g = 0 :=
  zero_of_epi_comp (factorThruImageSubobject f) <| by simp [h]
#align category_theory.limits.image_subobject_arrow_comp_eq_zero CategoryTheory.Limits.imageSubobject_arrow_comp_eq_zero

theorem imageSubobject_factors_comp_self {W : C} (k : W ⟶ X) : (imageSubobject f).Factors (k ≫ f) :=
  ⟨k ≫ factorThruImage f, by simp⟩
#align category_theory.limits.image_subobject_factors_comp_self CategoryTheory.Limits.imageSubobject_factors_comp_self

@[simp]
theorem factorThruImageSubobject_comp_self {W : C} (k : W ⟶ X) (h) :
    (imageSubobject f).factorThru (k ≫ f) h = k ≫ factorThruImageSubobject f :=
  by
  ext
  simp
#align category_theory.limits.factor_thru_image_subobject_comp_self CategoryTheory.Limits.factorThruImageSubobject_comp_self

@[simp]
theorem factorThruImageSubobject_comp_self_assoc {W W' : C} (k : W ⟶ W') (k' : W' ⟶ X) (h) :
    (imageSubobject f).factorThru (k ≫ k' ≫ f) h = k ≫ k' ≫ factorThruImageSubobject f :=
  by
  ext
  simp
#align category_theory.limits.factor_thru_image_subobject_comp_self_assoc CategoryTheory.Limits.factorThruImageSubobject_comp_self_assoc

/-- The image of `h ≫ f` is always a smaller subobject than the image of `f`. -/
theorem imageSubobject_comp_le {X' : C} (h : X' ⟶ X) (f : X ⟶ Y) [HasImage f] [HasImage (h ≫ f)] :
    imageSubobject (h ≫ f) ≤ imageSubobject f :=
  Subobject.mk_le_mk_of_comm (image.preComp h f) (by simp)
#align category_theory.limits.image_subobject_comp_le CategoryTheory.Limits.imageSubobject_comp_le

section

open ZeroObject

variable [HasZeroMorphisms C] [HasZeroObject C]

@[simp]
theorem imageSubobject_zero_arrow : (imageSubobject (0 : X ⟶ Y)).arrow = 0 :=
  by
  rw [← image_subobject_arrow]
  simp
#align category_theory.limits.image_subobject_zero_arrow CategoryTheory.Limits.imageSubobject_zero_arrow

@[simp]
theorem imageSubobject_zero {A B : C} : imageSubobject (0 : A ⟶ B) = ⊥ :=
  Subobject.eq_of_comm (imageSubobjectIso _ ≪≫ imageZero ≪≫ Subobject.botCoeIsoZero.symm) (by simp)
#align category_theory.limits.image_subobject_zero CategoryTheory.Limits.imageSubobject_zero

end

section

variable [HasEqualizers C]

attribute [local instance] epi_comp

/-- The morphism `image_subobject (h ≫ f) ⟶ image_subobject f`
is an epimorphism when `h` is an epimorphism.
In general this does not imply that `image_subobject (h ≫ f) = image_subobject f`,
although it will when the ambient category is abelian.
 -/
instance imageSubobject_comp_le_epi_of_epi {X' : C} (h : X' ⟶ X) [Epi h] (f : X ⟶ Y) [HasImage f]
    [HasImage (h ≫ f)] : Epi (Subobject.ofLe _ _ (imageSubobject_comp_le h f)) :=
  by
  rw [of_le_mk_le_mk_of_comm (image.pre_comp h f)]
  · infer_instance
  · simp
#align category_theory.limits.image_subobject_comp_le_epi_of_epi CategoryTheory.Limits.imageSubobject_comp_le_epi_of_epi

end

section

variable [HasEqualizers C]

/-- Postcomposing by an isomorphism gives an isomorphism between image subobjects. -/
def imageSubobjectCompIso (f : X ⟶ Y) [HasImage f] {Y' : C} (h : Y ⟶ Y') [IsIso h] :
    (imageSubobject (f ≫ h) : C) ≅ (imageSubobject f : C) :=
  imageSubobjectIso _ ≪≫ (image.compIso _ _).symm ≪≫ (imageSubobjectIso _).symm
#align category_theory.limits.image_subobject_comp_iso CategoryTheory.Limits.imageSubobjectCompIso

@[simp, reassoc.1]
theorem imageSubobjectCompIso_hom_arrow (f : X ⟶ Y) [HasImage f] {Y' : C} (h : Y ⟶ Y') [IsIso h] :
    (imageSubobjectCompIso f h).Hom ≫ (imageSubobject f).arrow =
      (imageSubobject (f ≫ h)).arrow ≫ inv h :=
  by simp [image_subobject_comp_iso]
#align category_theory.limits.image_subobject_comp_iso_hom_arrow CategoryTheory.Limits.imageSubobjectCompIso_hom_arrow

@[simp, reassoc.1]
theorem imageSubobjectCompIso_inv_arrow (f : X ⟶ Y) [HasImage f] {Y' : C} (h : Y ⟶ Y') [IsIso h] :
    (imageSubobjectCompIso f h).inv ≫ (imageSubobject (f ≫ h)).arrow =
      (imageSubobject f).arrow ≫ h :=
  by simp [image_subobject_comp_iso]
#align category_theory.limits.image_subobject_comp_iso_inv_arrow CategoryTheory.Limits.imageSubobjectCompIso_inv_arrow

end

theorem imageSubobject_mono (f : X ⟶ Y) [Mono f] : imageSubobject f = mk f :=
  eq_of_comm (imageSubobjectIso f ≪≫ imageMonoIsoSource f ≪≫ (underlyingIso f).symm) (by simp)
#align category_theory.limits.image_subobject_mono CategoryTheory.Limits.imageSubobject_mono

/-- Precomposing by an isomorphism does not change the image subobject. -/
theorem imageSubobject_iso_comp [HasEqualizers C] {X' : C} (h : X' ⟶ X) [IsIso h] (f : X ⟶ Y)
    [HasImage f] : imageSubobject (h ≫ f) = imageSubobject f :=
  le_antisymm (imageSubobject_comp_le h f)
    (Subobject.mk_le_mk_of_comm (inv (image.preComp h f)) (by simp))
#align category_theory.limits.image_subobject_iso_comp CategoryTheory.Limits.imageSubobject_iso_comp

theorem imageSubobject_le {A B : C} {X : Subobject B} (f : A ⟶ B) [HasImage f] (h : A ⟶ X)
    (w : h ≫ X.arrow = f) : imageSubobject f ≤ X :=
  Subobject.le_of_comm
    ((imageSubobjectIso f).Hom ≫
      image.lift
        { i := (X : C)
          e := h
          m := X.arrow })
    (by simp)
#align category_theory.limits.image_subobject_le CategoryTheory.Limits.imageSubobject_le

theorem imageSubobject_le_mk {A B : C} {X : C} (g : X ⟶ B) [Mono g] (f : A ⟶ B) [HasImage f]
    (h : A ⟶ X) (w : h ≫ g = f) : imageSubobject f ≤ Subobject.mk g :=
  imageSubobject_le f (h ≫ (Subobject.underlyingIso g).inv) (by simp [w])
#align category_theory.limits.image_subobject_le_mk CategoryTheory.Limits.imageSubobject_le_mk

/-- Given a commutative square between morphisms `f` and `g`,
we have a morphism in the category from `image_subobject f` to `image_subobject g`. -/
def imageSubobjectMap {W X Y Z : C} {f : W ⟶ X} [HasImage f] {g : Y ⟶ Z} [HasImage g]
    (sq : Arrow.mk f ⟶ Arrow.mk g) [HasImageMap sq] :
    (imageSubobject f : C) ⟶ (imageSubobject g : C) :=
  (imageSubobjectIso f).Hom ≫ image.map sq ≫ (imageSubobjectIso g).inv
#align category_theory.limits.image_subobject_map CategoryTheory.Limits.imageSubobjectMap

@[simp, reassoc.1]
theorem imageSubobjectMap_arrow {W X Y Z : C} {f : W ⟶ X} [HasImage f] {g : Y ⟶ Z} [HasImage g]
    (sq : Arrow.mk f ⟶ Arrow.mk g) [HasImageMap sq] :
    imageSubobjectMap sq ≫ (imageSubobject g).arrow = (imageSubobject f).arrow ≫ sq.right :=
  by
  simp only [image_subobject_map, category.assoc, image_subobject_arrow']
  erw [image.map_ι, ← category.assoc, image_subobject_arrow]
#align category_theory.limits.image_subobject_map_arrow CategoryTheory.Limits.imageSubobjectMap_arrow

theorem image_map_comp_imageSubobjectIso_inv {W X Y Z : C} {f : W ⟶ X} [HasImage f] {g : Y ⟶ Z}
    [HasImage g] (sq : Arrow.mk f ⟶ Arrow.mk g) [HasImageMap sq] :
    image.map sq ≫ (imageSubobjectIso _).inv = (imageSubobjectIso _).inv ≫ imageSubobjectMap sq :=
  by ext <;> simp
#align category_theory.limits.image_map_comp_image_subobject_iso_inv CategoryTheory.Limits.image_map_comp_imageSubobjectIso_inv

theorem imageSubobjectIso_comp_image_map {W X Y Z : C} {f : W ⟶ X} [HasImage f] {g : Y ⟶ Z}
    [HasImage g] (sq : Arrow.mk f ⟶ Arrow.mk g) [HasImageMap sq] :
    (imageSubobjectIso _).Hom ≫ image.map sq = imageSubobjectMap sq ≫ (imageSubobjectIso _).Hom :=
  by
  rw [← iso.comp_inv_eq, category.assoc, ← (image_subobject_iso (arrow.mk f).Hom).eq_inv_comp, ←
      image_map_comp_image_subobject_iso_inv] <;>
    rfl
#align category_theory.limits.image_subobject_iso_comp_image_map CategoryTheory.Limits.imageSubobjectIso_comp_image_map

end Image

end Limits

end CategoryTheory


/-
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, Floris van Doorn, Sébastien Gouëzel, Alex J. Best
-/
import algebra.group_power
import data.list.forall2

/-!
# Sums and products from lists

This file provides basic results about `list.prod`, `list.sum`, which calculate the product and sum
of elements of a list and `list.alternating_prod`, `list.alternating_sum`, their alternating
counterparts. These are defined in [`data.list.defs`](./defs).
-/

variables {ι α M N P M₀ G R : Type*}

namespace list
section monoid
variables [monoid M] [monoid N] [monoid P] {l l₁ l₂ : list M} {a : M}

@[simp, to_additive]
lemma prod_nil : ([] : list M).prod = 1 := rfl

@[to_additive]
lemma prod_singleton : [a].prod = a := one_mul a

@[simp, to_additive]
lemma prod_cons : (a :: l).prod = a * l.prod :=
calc (a :: l).prod = foldl (*) (a * 1) l : by simp only [list.prod, foldl_cons, one_mul, mul_one]
  ... = _ : foldl_assoc

@[simp, to_additive]
lemma prod_append : (l₁ ++ l₂).prod = l₁.prod * l₂.prod :=
calc (l₁ ++ l₂).prod = foldl (*) (foldl (*) 1 l₁ * 1) l₂ : by simp [list.prod]
  ... = l₁.prod * l₂.prod : foldl_assoc

@[to_additive]
lemma prod_concat : (l.concat a).prod = l.prod * a :=
by rw [concat_eq_append, prod_append, prod_singleton]

@[simp, to_additive]
lemma prod_join {l : list (list M)} : l.join.prod = (l.map list.prod).prod :=
by induction l; [refl, simp only [*, list.join, map, prod_append, prod_cons]]

@[to_additive]
lemma prod_eq_foldr : l.prod = foldr (*) 1 l :=
list.rec_on l rfl $ λ a l ihl, by rw [prod_cons, foldr_cons, ihl]

@[simp, priority 500, to_additive]
theorem prod_repeat (a : M) (n : ℕ) : (repeat a n).prod = a ^ n :=
begin
  induction n with n ih,
  { rw pow_zero, refl },
  { rw [list.repeat_succ, list.prod_cons, ih, pow_succ] }
end

@[to_additive sum_eq_card_nsmul]
lemma prod_eq_pow_card (l : list M) (m : M) (h : ∀ (x ∈ l), x = m) :
  l.prod = m ^ l.length :=
by rw [← prod_repeat, ← list.eq_repeat.mpr ⟨rfl, h⟩]

@[to_additive]
lemma prod_hom_rel (l : list ι) {r : M → N → Prop} {f : ι → M} {g : ι → N} (h₁ : r 1 1)
  (h₂ : ∀ ⦃i a b⦄, r a b → r (f i * a) (g i * b)) :
  r (l.map f).prod (l.map g).prod :=
list.rec_on l h₁ (λ a l hl, by simp only [map_cons, prod_cons, h₂ hl])

@[to_additive]
lemma prod_hom (l : list M) {F : Type*} [monoid_hom_class F M N] (f : F) :
  (l.map f).prod = f l.prod :=
by { simp only [prod, foldl_map, ← map_one f],
  exact l.foldl_hom _ _ _ 1 (map_mul f) }

@[to_additive]
lemma prod_hom₂ (l : list ι) (f : M → N → P)
  (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → M) (f₂ : ι → N) :
  (l.map $ λ i, f (f₁ i) (f₂ i)).prod = f (l.map f₁).prod (l.map f₂).prod :=
begin
  simp only [prod, foldl_map],
  convert l.foldl_hom₂ (λ a b, f a b) _ _ _ _ _ (λ a b i, _),
  { exact hf'.symm },
  { exact hf _ _ _ _ }
end

@[simp, to_additive]
lemma prod_map_mul {α : Type*} [comm_monoid α] {l : list ι} {f g : ι → α} :
  (l.map $ λ i, f i * g i).prod = (l.map f).prod * (l.map g).prod :=
l.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _

@[to_additive]
lemma prod_map_hom (L : list ι) (f : ι → M) {G : Type*} [monoid_hom_class G M N] (g : G) :
  (L.map (g ∘ f)).prod = g ((L.map f).prod) :=
by rw [← prod_hom, map_map]

@[to_additive]
lemma prod_is_unit : Π {L : list M} (u : ∀ m ∈ L, is_unit m), is_unit L.prod
| [] _ := by simp
| (h :: t) u :=
begin
  simp only [list.prod_cons],
  exact is_unit.mul (u h (mem_cons_self h t)) (prod_is_unit (λ m mt, u m (mem_cons_of_mem h mt)))
end

@[simp, to_additive]
lemma prod_take_mul_prod_drop :
  ∀ (L : list M) (i : ℕ), (L.take i).prod * (L.drop i).prod = L.prod
| [] i := by simp
| L 0 := by simp
| (h :: t) (n+1) := by { dsimp, rw [prod_cons, prod_cons, mul_assoc, prod_take_mul_prod_drop] }

@[simp, to_additive]
lemma prod_take_succ :
  ∀ (L : list M) (i : ℕ) (p), (L.take (i + 1)).prod = (L.take i).prod * L.nth_le i p
| [] i p := by cases p
| (h :: t) 0 _ := by simp
| (h :: t) (n+1) _ := by { dsimp, rw [prod_cons, prod_cons, prod_take_succ, mul_assoc] }

/-- A list with product not one must have positive length. -/
@[to_additive "A list with sum not zero must have positive length."]
lemma length_pos_of_prod_ne_one (L : list M) (h : L.prod ≠ 1) : 0 < L.length :=
by { cases L, { contrapose h, simp }, { simp } }

/-- A list with product greater than one must have positive length. -/
@[to_additive length_pos_of_sum_pos "A list with positive sum must have positive length."]
lemma length_pos_of_one_lt_prod [preorder M] (L : list M) (h : 1 < L.prod) :
  0 < L.length :=
length_pos_of_prod_ne_one L h.ne'

/-- A list with product less than one must have positive length. -/
@[to_additive "A list with negative sum must have positive length."]
lemma length_pos_of_prod_lt_one [preorder M] (L : list M) (h : L.prod < 1) :
  0 < L.length :=
length_pos_of_prod_ne_one L h.ne

@[to_additive]
lemma prod_update_nth : ∀ (L : list M) (n : ℕ) (a : M),
  (L.update_nth n a).prod =
    (L.take n).prod * (if n < L.length then a else 1) * (L.drop (n + 1)).prod
| (x :: xs) 0     a := by simp [update_nth]
| (x :: xs) (i+1) a := by simp [update_nth, prod_update_nth xs i a, mul_assoc]
| []      _     _ := by simp [update_nth, (nat.zero_le _).not_lt]

open mul_opposite

/-- We'd like to state this as `L.head * L.tail.prod = L.prod`, but because `L.head` relies on an
inhabited instance to return a garbage value on the empty list, this is not possible.
Instead, we write the statement in terms of `(L.nth 0).get_or_else 1`.
-/
@[to_additive "We'd like to state this as `L.head + L.tail.sum = L.sum`, but because `L.head`
relies on an inhabited instance to return a garbage value on the empty list, this is not possible.
Instead, we write the statement in terms of `(L.nth 0).get_or_else 0`."]
lemma nth_zero_mul_tail_prod (l : list M) : (l.nth 0).get_or_else 1 * l.tail.prod = l.prod :=
by cases l; simp

/-- Same as `nth_zero_mul_tail_prod`, but avoiding the `list.head` garbage complication by requiring
the list to be nonempty. -/
@[to_additive "Same as `nth_zero_add_tail_sum`, but avoiding the `list.head` garbage complication
by requiring the list to be nonempty."]
lemma head_mul_tail_prod_of_ne_nil [inhabited M] (l : list M) (h : l ≠ []) :
  l.head * l.tail.prod = l.prod :=
by cases l; [contradiction, simp]

@[to_additive]
lemma _root_.commute.list_prod_right (l : list M) (y : M) (h : ∀ (x ∈ l), commute y x) :
  commute y l.prod :=
begin
  induction l with z l IH,
  { simp },
  { rw list.ball_cons at h,
    rw list.prod_cons,
    exact commute.mul_right h.1 (IH h.2), }
end

@[to_additive]
lemma _root_.commute.list_prod_left (l : list M) (y : M) (h : ∀ (x ∈ l), commute x y) :
  commute l.prod y  :=
(commute.list_prod_right _ _ $ λ x hx, (h _ hx).symm).symm

lemma _root_.commute.list_sum_right [non_unital_non_assoc_semiring R] (a : R) (l : list R)
  (h : ∀ b ∈ l, commute a b) :
  commute a l.sum :=
begin
  induction l with x xs ih,
  { exact commute.zero_right _, },
  { rw sum_cons,
    exact (h _ $ mem_cons_self _ _).add_right (ih $ λ j hj, h _ $ mem_cons_of_mem _ hj) }
end

lemma _root_.commute.list_sum_left [non_unital_non_assoc_semiring R] (b : R) (l : list R)
  (h : ∀ a ∈ l, commute a b) :
  commute l.sum b :=
(commute.list_sum_right _ _ $ λ x hx, (h _ hx).symm).symm

@[to_additive sum_le_sum] lemma forall₂.prod_le_prod' [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  {l₁ l₂ : list M} (h : forall₂ (≤) l₁ l₂) : l₁.prod ≤ l₂.prod :=
begin
  induction h with a b la lb hab ih ih',
  { refl },
  { simpa only [prod_cons] using mul_le_mul' hab ih' }
end

/-- If `l₁` is a sublist of `l₂` and all elements of `l₂` are greater than or equal to one, then
`l₁.prod ≤ l₂.prod`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 1 ≤ a` instead
of `∀ a ∈ l₂, 1 ≤ a` but this lemma is not yet in `mathlib`. -/
@[to_additive sum_le_sum "If `l₁` is a sublist of `l₂` and all elements of `l₂` are nonnegative,
then `l₁.sum ≤ l₂.sum`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 0 ≤ a` instead
of `∀ a ∈ l₂, 0 ≤ a` but this lemma is not yet in `mathlib`."]
lemma sublist.prod_le_prod' [preorder M] [covariant_class M M (function.swap (*)) (≤)]
  [covariant_class M M (*) (≤)] {l₁ l₂ : list M} (h : l₁ <+ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) :
  l₁.prod ≤ l₂.prod :=
begin
  induction h, { refl },
  case cons : l₁ l₂ a ih ih'
  { simp only [prod_cons, forall_mem_cons] at h₁ ⊢,
    exact (ih' h₁.2).trans (le_mul_of_one_le_left' h₁.1) },
  case cons2 : l₁ l₂ a ih ih'
  { simp only [prod_cons, forall_mem_cons] at h₁ ⊢,
    exact mul_le_mul_left' (ih' h₁.2) _ }
end

@[to_additive sum_le_sum] lemma sublist_forall₂.prod_le_prod' [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  {l₁ l₂ : list M} (h : sublist_forall₂ (≤) l₁ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) :
  l₁.prod ≤ l₂.prod :=
let ⟨l, hall, hsub⟩ := sublist_forall₂_iff.1 h
in hall.prod_le_prod'.trans $ hsub.prod_le_prod' h₁

@[to_additive sum_le_sum] lemma prod_le_prod' [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  {l : list ι} {f g : ι → M} (h : ∀ i ∈ l, f i ≤ g i) :
  (l.map f).prod ≤ (l.map g).prod :=
forall₂.prod_le_prod' $ by simpa

@[to_additive sum_lt_sum] lemma prod_lt_prod'
  [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)]
  [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)]
  {l : list ι} (f g : ι → M) (h₁ : ∀ i ∈ l, f i ≤ g i) (h₂ : ∃ i ∈ l, f i < g i) :
  (l.map f).prod < (l.map g).prod :=
begin
  induction l with i l ihl, { rcases h₂ with ⟨_, ⟨⟩, _⟩ },
  simp only [ball_cons, bex_cons, map_cons, prod_cons] at h₁ h₂ ⊢,
  cases h₂,
  exacts [mul_lt_mul_of_lt_of_le h₂ (prod_le_prod' h₁.2),
    mul_lt_mul_of_le_of_lt h₁.1 $ ihl h₁.2 h₂]
end

@[to_additive] lemma prod_lt_prod_of_ne_nil
  [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)]
  [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)]
  {l : list ι} (hl : l ≠ []) (f g : ι → M) (hlt : ∀ i ∈ l, f i < g i) :
  (l.map f).prod < (l.map g).prod :=
prod_lt_prod' f g (λ i hi, (hlt i hi).le) $ (exists_mem_of_ne_nil l hl).imp $ λ i hi, ⟨hi, hlt i hi⟩

@[to_additive sum_le_card_nsmul]
lemma prod_le_pow_card [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  (l : list M) (n : M) (h : ∀ (x ∈ l), x ≤ n) :
  l.prod ≤ n ^ l.length :=
by simpa only [map_id'', map_const, prod_repeat] using prod_le_prod' h

@[to_additive card_nsmul_le_sum]
lemma pow_card_le_prod [preorder M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)]
  (l : list M) (n : M) (h : ∀ (x ∈ l), n ≤ x) :
  n ^ l.length ≤ l.prod :=
@prod_le_pow_card Mᵒᵈ _ _ _ _ l n h

@[to_additive exists_lt_of_sum_lt] lemma exists_lt_of_prod_lt' [linear_order M]
  [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] {l : list ι}
  (f g : ι → M) (h : (l.map f).prod < (l.map g).prod) :
  ∃ i ∈ l, f i < g i :=
by { contrapose! h, exact prod_le_prod' h }

@[to_additive exists_le_of_sum_le]
lemma exists_le_of_prod_le' [linear_order M] [covariant_class M M (*) (<)]
  [covariant_class M M (*) (≤)] [covariant_class M M (function.swap (*)) (<)]
  [covariant_class M M (function.swap (*)) (≤)] {l : list ι} (hl : l ≠ [])
  (f g : ι → M) (h : (l.map f).prod ≤ (l.map g).prod) :
  ∃ x ∈ l, f x ≤ g x :=
by { contrapose! h, exact prod_lt_prod_of_ne_nil hl _ _ h }

@[to_additive sum_nonneg]
lemma one_le_prod_of_one_le [preorder M] [covariant_class M M (*) (≤)] {l : list M}
  (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) :
  1 ≤ l.prod :=
begin
  -- We don't use `pow_card_le_prod` to avoid assumption
  -- [covariant_class M M (function.swap (*)) (≤)]
  induction l with hd tl ih, { refl },
  rw prod_cons,
  exact one_le_mul (hl₁ hd (mem_cons_self hd tl)) (ih (λ x h, hl₁ x (mem_cons_of_mem hd h)))
end

end monoid

section monoid_with_zero

variables [monoid_with_zero M₀]

/-- If zero is an element of a list `L`, then `list.prod L = 0`. If the domain is a nontrivial
monoid with zero with no divisors, then this implication becomes an `iff`, see
`list.prod_eq_zero_iff`. -/
lemma prod_eq_zero {L : list M₀} (h : (0 : M₀) ∈ L) : L.prod = 0 :=
begin
  induction L with a L ihL,
  { exact absurd h (not_mem_nil _) },
  { rw prod_cons,
    cases (mem_cons_iff _ _ _).1 h with ha hL,
    exacts [mul_eq_zero_of_left ha.symm _, mul_eq_zero_of_right _ (ihL hL)] }
end

/-- Product of elements of a list `L` equals zero if and only if `0 ∈ L`. See also
`list.prod_eq_zero` for an implication that needs weaker typeclass assumptions. -/
@[simp] lemma prod_eq_zero_iff [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} :
  L.prod = 0 ↔ (0 : M₀) ∈ L :=
begin
  induction L with a L ihL,
  { simp },
  { rw [prod_cons, mul_eq_zero, ihL, mem_cons_iff, eq_comm] }
end

lemma prod_ne_zero [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} (hL : (0 : M₀) ∉ L) :
  L.prod ≠ 0 :=
mt prod_eq_zero_iff.1 hL

end monoid_with_zero

section group
variables [group G]

/-- This is the `list.prod` version of `mul_inv_rev` -/
@[to_additive "This is the `list.sum` version of `add_neg_rev`"]
lemma prod_inv_reverse : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).reverse.prod
| [] := by simp
| (x :: xs) := by simp [prod_inv_reverse xs]

/-- A non-commutative variant of `list.prod_reverse` -/
@[to_additive "A non-commutative variant of `list.sum_reverse`"]
lemma prod_reverse_noncomm : ∀ (L : list G), L.reverse.prod = (L.map (λ x, x⁻¹)).prod⁻¹ :=
by simp [prod_inv_reverse]

/-- Counterpart to `list.prod_take_succ` when we have an inverse operation -/
@[simp, to_additive /-"Counterpart to `list.sum_take_succ` when we have an negation operation"-/]
lemma prod_drop_succ :
  ∀ (L : list G) (i : ℕ) (p), (L.drop (i + 1)).prod = (L.nth_le i p)⁻¹ * (L.drop i).prod
| [] i p := false.elim (nat.not_lt_zero _ p)
| (x :: xs) 0 p := by simp
| (x :: xs) (i + 1) p := prod_drop_succ xs i _

end group

section comm_group
variables [comm_group G]

/-- This is the `list.prod` version of `mul_inv` -/
@[to_additive "This is the `list.sum` version of `add_neg`"]
lemma prod_inv : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).prod
| [] := by simp
| (x :: xs) := by simp [mul_comm, prod_inv xs]

/-- Alternative version of `list.prod_update_nth` when the list is over a group -/
@[to_additive /-"Alternative version of `list.sum_update_nth` when the list is over a group"-/]
lemma prod_update_nth' (L : list G) (n : ℕ) (a : G) :
  (L.update_nth n a).prod =
    L.prod * (if hn : n < L.length then (L.nth_le n hn)⁻¹ * a else 1) :=
begin
  refine (prod_update_nth L n a).trans _,
  split_ifs with hn hn,
  { rw [mul_comm _ a, mul_assoc a, prod_drop_succ L n hn, mul_comm _ (drop n L).prod,
      ← mul_assoc (take n L).prod, prod_take_mul_prod_drop, mul_comm a, mul_assoc] },
  { simp only [take_all_of_le (le_of_not_lt hn), prod_nil, mul_one,
      drop_eq_nil_of_le ((le_of_not_lt hn).trans n.le_succ)] }
end

end comm_group

@[to_additive]
lemma eq_of_prod_take_eq [left_cancel_monoid M] {L L' : list M} (h : L.length = L'.length)
  (h' : ∀ i ≤ L.length, (L.take i).prod = (L'.take i).prod) : L = L' :=
begin
  apply ext_le h (λ i h₁ h₂, _),
  have : (L.take (i + 1)).prod = (L'.take (i + 1)).prod := h' _ (nat.succ_le_of_lt h₁),
  rw [prod_take_succ L i h₁, prod_take_succ L' i h₂, h' i (le_of_lt h₁)] at this,
  convert mul_left_cancel this
end

@[to_additive]
lemma monotone_prod_take [canonically_ordered_monoid M] (L : list M) :
  monotone (λ i, (L.take i).prod) :=
begin
  apply monotone_nat_of_le_succ (λ n, _),
  cases lt_or_le n L.length with h h,
  { rw prod_take_succ _ _ h,
    exact le_self_mul },
  { simp [take_all_of_le h, take_all_of_le (le_trans h (nat.le_succ _))] }
end

@[to_additive sum_pos]
lemma one_lt_prod_of_one_lt [ordered_comm_monoid M] :
  ∀ (l : list M) (hl : ∀ x ∈ l, (1 : M) < x) (hl₂ : l ≠ []), 1 < l.prod
| [] _ h := (h rfl).elim
| [b] h _ := by simpa using h
| (a :: b :: l) hl₁ hl₂ :=
begin
  simp only [forall_eq_or_imp, list.mem_cons_iff _ a] at hl₁,
  rw list.prod_cons,
  apply one_lt_mul_of_lt_of_le' hl₁.1,
  apply le_of_lt ((b :: l).one_lt_prod_of_one_lt hl₁.2 (l.cons_ne_nil b)),
end

@[to_additive]
lemma single_le_prod [ordered_comm_monoid M] {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) :
  ∀ x ∈ l, x ≤ l.prod :=
begin
  induction l,
  { simp },
  simp_rw [prod_cons, forall_mem_cons] at ⊢ hl₁,
  split,
  { exact le_mul_of_one_le_right' (one_le_prod_of_one_le hl₁.2) },
  { exact λ x H, le_mul_of_one_le_of_le hl₁.1 (l_ih hl₁.right x H) },
end

@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero]
lemma all_one_of_le_one_le_of_prod_eq_one [ordered_comm_monoid M]
  {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) (hl₂ : l.prod = 1) {x : M} (hx : x ∈ l) :
  x = 1 :=
le_antisymm (hl₂ ▸ single_le_prod hl₁ _ hx) (hl₁ x hx)

@[to_additive] lemma prod_eq_one_iff [canonically_ordered_monoid M] (l : list M) :
  l.prod = 1 ↔ ∀ x ∈ l, x = (1 : M) :=
⟨all_one_of_le_one_le_of_prod_eq_one (λ _ _, one_le _),
  λ h, by rw [eq_repeat.2 ⟨rfl, h⟩, prod_repeat, one_pow]⟩

/-- If all elements in a list are bounded below by `1`, then the length of the list is bounded
by the sum of the elements. -/
lemma length_le_sum_of_one_le (L : list ℕ) (h : ∀ i ∈ L, 1 ≤ i) : L.length ≤ L.sum :=
begin
  induction L with j L IH h, { simp },
  rw [sum_cons, length, add_comm],
  exact add_le_add (h _ (set.mem_insert _ _)) (IH (λ i hi, h i (set.mem_union_right _ hi)))
end

-- TODO: develop theory of tropical rings
lemma sum_le_foldr_max [add_monoid M] [add_monoid N] [linear_order N] (f : M → N)
  (h0 : f 0 ≤ 0) (hadd : ∀ x y, f (x + y) ≤ max (f x) (f y)) (l : list M) :
  f l.sum ≤ (l.map f).foldr max 0 :=
begin
  induction l with hd tl IH,
  { simpa using h0 },
  simp only [list.sum_cons, list.foldr_map, list.foldr] at IH ⊢,
  exact (hadd _ _).trans (max_le_max le_rfl IH)
end

@[simp, to_additive]
lemma prod_erase [decidable_eq M] [comm_monoid M] {a} :
  ∀ {l : list M}, a ∈ l → a * (l.erase a).prod = l.prod
| (b :: l) h :=
  begin
    obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h,
    { simp only [list.erase, if_pos, prod_cons] },
    { simp only [list.erase, if_neg (mt eq.symm ne), prod_cons, prod_erase h, mul_left_comm a b] }
  end

lemma dvd_prod [comm_monoid M] {a} {l : list M} (ha : a ∈ l) : a ∣ l.prod :=
let ⟨s, t, h⟩ := mem_split ha in
by { rw [h, prod_append, prod_cons, mul_left_comm], exact dvd_mul_right _ _ }

@[simp] lemma sum_const_nat (m n : ℕ) : sum (list.repeat m n) = m * n :=
by induction n; [refl, simp only [*, repeat_succ, sum_cons, nat.mul_succ, add_comm]]

lemma dvd_sum [semiring R] {a} {l : list R} (h : ∀ x ∈ l, a ∣ x) : a ∣ l.sum :=
begin
  induction l with x l ih,
  { exact dvd_zero _ },
  { rw [list.sum_cons],
    exact dvd_add (h _ (mem_cons_self _ _)) (ih (λ x hx, h x (mem_cons_of_mem _ hx))) }
end

/-- The product of a list of positive natural numbers is positive,
and likewise for any nontrivial ordered semiring. -/
lemma prod_pos [ordered_semiring R] [nontrivial R] (l : list R) (h : ∀ a ∈ l, (0 : R) < a) :
  0 < l.prod :=
begin
  induction l with a l ih,
  { simp },
  { rw prod_cons,
    exact mul_pos (h _ $ mem_cons_self _ _) (ih $ λ a ha, h a $ mem_cons_of_mem _ ha) }
end

/-!
Several lemmas about sum/head/tail for `list ℕ`.
These are hard to generalize well, as they rely on the fact that `default ℕ = 0`.
If desired, we could add a class stating that `default = 0`.
-/

/-- This relies on `default ℕ = 0`. -/
lemma head_add_tail_sum (L : list ℕ) : L.head + L.tail.sum = L.sum :=
by { cases L, { simp, refl }, { simp } }

/-- This relies on `default ℕ = 0`. -/
lemma head_le_sum (L : list ℕ) : L.head ≤ L.sum := nat.le.intro (head_add_tail_sum L)

/-- This relies on `default ℕ = 0`. -/
lemma tail_sum (L : list ℕ) : L.tail.sum = L.sum - L.head :=
by rw [← head_add_tail_sum L, add_comm, add_tsub_cancel_right]

section alternating
section
variables [has_one α] [has_mul α] [has_inv α]

@[simp, to_additive] lemma alternating_prod_nil : alternating_prod ([] : list α) = 1 := rfl
@[simp, to_additive] lemma alternating_prod_singleton (a : α) : alternating_prod [a] = a := rfl

@[to_additive] lemma alternating_prod_cons_cons' (a b : α) (l : list α) :
  alternating_prod (a :: b :: l) = a * b⁻¹ * alternating_prod l := rfl

end

@[to_additive] lemma alternating_prod_cons_cons [div_inv_monoid α] (a b : α) (l : list α) :
  alternating_prod (a :: b :: l) = a / b * alternating_prod l :=
by rw [div_eq_mul_inv, alternating_prod_cons_cons']

variables [comm_group α]

@[to_additive] lemma alternating_prod_cons' :
  ∀ (a : α) (l : list α), alternating_prod (a :: l) = a * (alternating_prod l)⁻¹
| a [] := by rw [alternating_prod_nil, inv_one, mul_one, alternating_prod_singleton]
| a (b :: l) :=
by rw [alternating_prod_cons_cons', alternating_prod_cons' b l, mul_inv, inv_inv, mul_assoc]

@[simp, to_additive] lemma alternating_prod_cons (a : α) (l : list α) :
  alternating_prod (a :: l) = a / alternating_prod l :=
by rw [div_eq_mul_inv, alternating_prod_cons']

@[to_additive]
lemma alternating_prod_append : ∀ l₁ l₂ : list α,
  alternating_prod (l₁ ++ l₂) = alternating_prod l₁ * alternating_prod l₂ ^ (-1 : ℤ) ^ length l₁
| [] l₂ := by simp
| (a :: l₁) l₂ := by simp_rw [cons_append, alternating_prod_cons, alternating_prod_append,
  length_cons, pow_succ, neg_mul, one_mul, zpow_neg, ←div_eq_mul_inv, div_div]

@[to_additive]
lemma alternating_prod_reverse :
  ∀ l : list α, alternating_prod (reverse l) = alternating_prod l ^ (-1 : ℤ) ^ (length l + 1)
| [] := by simp only [alternating_prod_nil, one_zpow, reverse_nil]
| (a :: l) :=
begin
  simp_rw [reverse_cons, alternating_prod_append, alternating_prod_reverse,
    alternating_prod_singleton, alternating_prod_cons, length_reverse, length, pow_succ, neg_mul,
    one_mul, zpow_neg, inv_inv],
  rw [mul_comm, ←div_eq_mul_inv, div_zpow],
end

end alternating

lemma sum_map_mul_left [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) :
  (L.map (λ b, r * f b)).sum = r * (L.map f).sum :=
sum_map_hom L f $ add_monoid_hom.mul_left r

lemma sum_map_mul_right [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) :
  (L.map (λ b, f b * r)).sum = (L.map f).sum * r :=
sum_map_hom L f $ add_monoid_hom.mul_right r

end list

namespace mul_opposite

open list
variables [monoid M]

lemma op_list_prod : ∀ (l : list M), op (l.prod) = (l.map op).reverse.prod
| [] := rfl
| (x :: xs) := by rw [list.prod_cons, list.map_cons, list.reverse_cons', list.prod_concat, op_mul,
                      op_list_prod]

lemma _root_.mul_opposite.unop_list_prod (l : list Mᵐᵒᵖ) :
  (l.prod).unop = (l.map unop).reverse.prod :=
by rw [← op_inj, op_unop, mul_opposite.op_list_prod, map_reverse, map_map, reverse_reverse,
  op_comp_unop, map_id]

end mul_opposite

section monoid_hom

variables [monoid M] [monoid N]

@[to_additive]
lemma map_list_prod {F : Type*} [monoid_hom_class F M N] (f : F)
  (l : list M) : f l.prod = (l.map f).prod :=
(l.prod_hom f).symm

/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements. -/
lemma unop_map_list_prod {F : Type*} [monoid_hom_class F M Nᵐᵒᵖ] (f : F) (l : list M) :
  (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod :=
by rw [map_list_prod f l, mul_opposite.unop_list_prod, list.map_map]

namespace monoid_hom

/-- Deprecated, use `_root_.map_list_prod` instead. -/
@[to_additive "Deprecated, use `_root_.map_list_sum` instead."]
protected lemma map_list_prod (f : M →* N) (l : list M) :
  f l.prod = (l.map f).prod :=
map_list_prod f l

/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements.

Deprecated, use `_root_.unop_map_list_prod` instead. -/
protected lemma unop_map_list_prod (f : M →* Nᵐᵒᵖ) (l : list M) :
  (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod :=
unop_map_list_prod f l

end monoid_hom

end monoid_hom