/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.special_functions.pow
import order.partition.equipartition

/-!
# Numerical bounds for Szemerédi Regularity Lemma

This file gathers the numerical facts required by the proof of Szemerédi's regularity lemma.

## Main declarations

* `szemeredi_regularity.step_bound`: During the inductive step, a partition of size `n` is blown to
  size at most `step_bound n`.
* `szemeredi_regularity.initial_bound`: The size of the partition we start the induction with.
* `szemeredi_regularity.bound`: The upper bound on the size of the partition produced by our version
  of Szemerédi's regularity lemma.
-/

open finset fintype function real

namespace szemeredi_regularity

/-- Auxiliary function for Szemerédi's regularity lemma. Blowing up a partition of size `n` during
the induction results in a partition of size at most `step_bound n`. -/
def step_bound (n : ℕ) : ℕ := n * 4 ^ n

lemma le_step_bound : id ≤ step_bound := λ n, nat.le_mul_of_pos_right $ pow_pos (by norm_num) n

lemma step_bound_mono : monotone step_bound :=
λ a b h, nat.mul_le_mul h $ nat.pow_le_pow_of_le_right (by norm_num) h

lemma step_bound_pos_iff {n : ℕ} : 0 < step_bound n ↔ 0 < n :=
zero_lt_mul_right $ pow_pos (by norm_num) _

alias step_bound_pos_iff ↔ _ szemeredi_regularity.step_bound_pos

variables {α : Type*} [decidable_eq α] [fintype α] {P : finpartition (univ : finset α)}
  {u : finset α} {ε : ℝ}

local notation `m` := (card α/step_bound P.parts.card : ℕ)
local notation `a` := (card α/P.parts.card - m * 4^P.parts.card : ℕ)

lemma m_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : 0 < m :=
nat.div_pos ((nat.mul_le_mul_left _ $ nat.pow_le_pow_of_le_left (by norm_num) _).trans hPα) $
  step_bound_pos (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos

lemma m_coe_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : (0 : ℝ) < m :=
nat.cast_pos.2 $ m_pos hPα

lemma coe_m_add_one_pos : 0 < (m : ℝ) + 1 := nat.cast_add_one_pos _

lemma one_le_m_coe [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : (1 : ℝ) ≤ m :=
nat.one_le_cast.2 $ m_pos hPα

lemma eps_pow_five_pos (hPε : 100 ≤ 4^P.parts.card * ε^5) : 0 < ε^5 :=
pos_of_mul_pos_left ((by norm_num : (0 : ℝ) < 100).trans_le hPε) $ pow_nonneg (by norm_num) _

lemma eps_pos (hPε : 100 ≤ 4^P.parts.card * ε^5) : 0 < ε :=
pow_bit1_pos_iff.1 $ eps_pow_five_pos hPε

lemma four_pow_pos {n : ℕ} : 0 < (4 : ℝ)^n := pow_pos (by norm_num) n

lemma hundred_div_ε_pow_five_le_m [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α)
  (hPε : 100 ≤ 4^P.parts.card * ε^5) :
  100 / ε^5 ≤ m :=
(div_le_of_nonneg_of_le_mul (eps_pow_five_pos hPε).le four_pow_pos.le hPε).trans
begin
  norm_cast,
  rwa [nat.le_div_iff_mul_le'(step_bound_pos (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos),
    step_bound, mul_left_comm, ←mul_pow],
end

lemma hundred_le_m [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α)
  (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε : ε ≤ 1) : 100 ≤ m :=
by exact_mod_cast
  (le_div_self (by norm_num) (eps_pow_five_pos hPε) $ pow_le_one _ (eps_pos hPε).le hε).trans
    (hundred_div_ε_pow_five_le_m hPα hPε)

lemma a_add_one_le_four_pow_parts_card : a + 1 ≤ 4^P.parts.card :=
begin
  have h : 1 ≤ 4^P.parts.card := one_le_pow_of_one_le (by norm_num) _,
  rw [step_bound, ←nat.div_div_eq_div_mul, nat.add_le_to_le_sub _ h, tsub_le_iff_left,
    ←nat.add_sub_assoc h],
  exact nat.le_pred_of_lt (nat.lt_div_mul_add h),
end

lemma card_aux₁ (hucard : u.card = m * 4^P.parts.card + a) :
  (4^P.parts.card - a) * m + a * (m + 1) = u.card :=
by rw [hucard, mul_add, mul_one, ←add_assoc, ←add_mul, nat.sub_add_cancel
  ((nat.le_succ _).trans a_add_one_le_four_pow_parts_card), mul_comm]

lemma card_aux₂ (hP : P.is_equipartition) (hu : u ∈ P.parts)
  (hucard : ¬u.card = m * 4^P.parts.card + a) :
  (4^P.parts.card - (a + 1)) * m + (a + 1) * (m + 1) = u.card :=
begin
  have : m * 4 ^ P.parts.card ≤ card α / P.parts.card,
  { rw [step_bound, ←nat.div_div_eq_div_mul],
    exact nat.div_mul_le_self _ _ },
  rw nat.add_sub_of_le this at hucard,
  rw [(hP.card_parts_eq_average hu).resolve_left hucard, mul_add, mul_one, ←add_assoc, ←add_mul,
    nat.sub_add_cancel a_add_one_le_four_pow_parts_card, ←add_assoc, mul_comm,
    nat.add_sub_of_le this, card_univ],
end

lemma pow_mul_m_le_card_part (hP : P.is_equipartition) (hu : u ∈ P.parts) :
  (4 : ℝ) ^ P.parts.card * m ≤ u.card :=
begin
  norm_cast,
  rw [step_bound, ←nat.div_div_eq_div_mul],
  exact (nat.mul_div_le _ _).trans (hP.average_le_card_part hu),
end

variables (P ε) (l : ℕ)

/-- Auxiliary function for Szemerédi's regularity lemma. The size of the partition by which we start
blowing. -/
noncomputable def initial_bound : ℕ := max 7 $ max l $ ⌊log (100 / ε^5) / log 4⌋₊ + 1

lemma le_initial_bound : l ≤ initial_bound ε l := (le_max_left _ _).trans $ le_max_right _ _
lemma seven_le_initial_bound : 7 ≤ initial_bound ε l := le_max_left _ _
lemma initial_bound_pos : 0 < initial_bound ε l :=
nat.succ_pos'.trans_le $ seven_le_initial_bound _ _

lemma hundred_lt_pow_initial_bound_mul {ε : ℝ} (hε : 0 < ε) (l : ℕ) :
  100 < 4^initial_bound ε l * ε^5 :=
begin
  rw [←rpow_nat_cast 4, ←div_lt_iff (pow_pos hε 5), lt_rpow_iff_log_lt _ zero_lt_four,
    ←div_lt_iff, initial_bound, nat.cast_max, nat.cast_max],
  { exact lt_max_of_lt_right (lt_max_of_lt_right $ nat.lt_floor_add_one _) },
  { exact log_pos (by norm_num) },
  { exact div_pos (by norm_num) (pow_pos hε 5) }
end

/-- An explicit bound on the size of the equipartition whose existence is given by Szemerédi's
regularity lemma. -/
noncomputable def bound : ℕ :=
(step_bound^[⌊4 / ε^5⌋₊] $ initial_bound ε l) * 16 ^ (step_bound^[⌊4 / ε^5⌋₊] $ initial_bound ε l)

lemma initial_bound_le_bound : initial_bound ε l ≤ bound ε l :=
(id_le_iterate_of_id_le le_step_bound _ _).trans $ nat.le_mul_of_pos_right $ pow_pos (by norm_num) _

lemma le_bound : l ≤ bound ε l := (le_initial_bound ε l).trans $ initial_bound_le_bound ε l
lemma bound_pos : 0 < bound ε l := (initial_bound_pos ε l).trans_le $ initial_bound_le_bound ε l

end szemeredi_regularity


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

! This file was ported from Lean 3 source module order.lattice
! leanprover-community/mathlib commit d6aad9528ddcac270ed35c6f7b5f1d8af25341d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Bool.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Order.Monotone.Basic
import Mathlib.Tactic.Simps.Basic

/-!
# (Semi-)lattices

Semilattices are partially ordered sets with join (greatest lower bound, or `sup`) or
meet (least upper bound, or `inf`) operations. Lattices are posets that are both
join-semilattices and meet-semilattices.

Distributive lattices are lattices which satisfy any of four equivalent distributivity properties,
of `sup` over `inf`, on the left or on the right.

## Main declarations

* `SemilatticeSup`: a type class for join semilattices
* `SemilatticeSup.mk'`: an alternative constructor for `SemilatticeSup` via proofs that `⊔` is
  commutative, associative and idempotent.
* `SemilatticeInf`: a type class for meet semilattices
* `SemilatticeSup.mk'`: an alternative constructor for `SemilatticeInf` via proofs that `⊓` is
  commutative, associative and idempotent.

* `Lattice`: a type class for lattices
* `Lattice.mk'`: an alternative constructor for `Lattice` via profs that `⊔` and `⊓` are
  commutative, associative and satisfy a pair of "absorption laws".

* `DistribLattice`: a type class for distributive lattices.

## Notations

* `a ⊔ b`: the supremum or join of `a` and `b`
* `a ⊓ b`: the infimum or meet of `a` and `b`

## TODO

* (Semi-)lattice homomorphisms
* Alternative constructors for distributive lattices from the other distributive properties

## Tags

semilattice, lattice

-/

universe u v w

variable {α : Type u} {β : Type v}

-- TODO: move this eventually, if we decide to use them
-- Porting note: no ematch attribute
--attribute [ematch] le_trans lt_of_le_of_lt lt_of_lt_of_le lt_trans

section

-- TODO: this seems crazy, but it also seems to work reasonably well
-- Porting note: no ematch attribute
--@[ematch]
theorem le_antisymm' [PartialOrder α] : ∀ {a b : α}, a ≤ b → b ≤ a → a = b :=
  @le_antisymm _ _
#align le_antisymm' le_antisymm'

end

/-!
### Join-semilattices
-/

-- TODO: automatic construction of dual definitions / theorems
/-- A `SemilatticeSup` is a join-semilattice, that is, a partial order
  with a join (a.k.a. lub / least upper bound, sup / supremum) operation
  `⊔` which is the least element larger than both factors. -/
class SemilatticeSup (α : Type u) extends Sup α, PartialOrder α where
  /-- The supremum is an upper bound on the first argument -/
  protected le_sup_left : ∀ a b : α, a ≤ a ⊔ b
  /-- The supremum is an upper bound on the second argument -/
  protected le_sup_right : ∀ a b : α, b ≤ a ⊔ b
  /-- The supremum is the *least* upper bound -/
  protected sup_le : ∀ a b c : α, a ≤ c → b ≤ c → a ⊔ b ≤ c
#align semilattice_sup SemilatticeSup

/--
A type with a commutative, associative and idempotent binary `sup` operation has the structure of a
join-semilattice.

The partial order is defined so that `a ≤ b` unfolds to `a ⊔ b = b`; cf. `sup_eq_right`.
-/
def SemilatticeSup.mk' {α : Type _} [Sup α] (sup_comm : ∀ a b : α, a ⊔ b = b ⊔ a)
    (sup_assoc : ∀ a b c : α, a ⊔ b ⊔ c = a ⊔ (b ⊔ c)) (sup_idem : ∀ a : α, a ⊔ a = a) :
    SemilatticeSup α where
  sup := (· ⊔ ·)
  le a b := a ⊔ b = b
  le_refl := sup_idem
  le_trans a b c hab hbc := by
    -- Porting note: dsimp doesn't work here?
    -- This is the same issue as discussed at https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/unfolding.20earlier.20fields
    show a ⊔ c = c
    rw [← hbc, ← sup_assoc, hab]
  le_antisymm a b hab hba := by
    rwa [← hba, sup_comm]
  le_sup_left a b := show a ⊔ (a ⊔ b) = a ⊔ b by rw [← sup_assoc, sup_idem]
  le_sup_right a b := show b ⊔ (a ⊔ b) = a ⊔ b by rw [sup_comm, sup_assoc, sup_idem]
  sup_le a b c hac hbc := by
    show (a ⊔ b) ⊔ c = c
    rwa [sup_assoc, hbc]
#align semilattice_sup.mk' SemilatticeSup.mk'

instance (α : Type _) [Inf α] : Sup αᵒᵈ :=
  ⟨((· ⊓ ·) : α → α → α)⟩

instance (α : Type _) [Sup α] : Inf αᵒᵈ :=
  ⟨((· ⊔ ·) : α → α → α)⟩

section SemilatticeSup

variable [SemilatticeSup α] {a b c d : α}

@[simp]
theorem le_sup_left : a ≤ a ⊔ b :=
  SemilatticeSup.le_sup_left a b
#align le_sup_left le_sup_left

-- Porting note: no ematch attribute
--@[ematch]
theorem le_sup_left' : a ≤ a ⊔ b :=
  le_sup_left
#align le_sup_left' le_sup_left'

@[simp]
theorem le_sup_right : b ≤ a ⊔ b :=
  SemilatticeSup.le_sup_right a b
#align le_sup_right le_sup_right

-- Porting note: no ematch attribute
--@[ematch]
theorem le_sup_right' : b ≤ a ⊔ b :=
  le_sup_right
#align le_sup_right' le_sup_right'

theorem le_sup_of_le_left (h : c ≤ a) : c ≤ a ⊔ b :=
  le_trans h le_sup_left
#align le_sup_of_le_left le_sup_of_le_left

theorem le_sup_of_le_right (h : c ≤ b) : c ≤ a ⊔ b :=
  le_trans h le_sup_right
#align le_sup_of_le_right le_sup_of_le_right

theorem lt_sup_of_lt_left (h : c < a) : c < a ⊔ b :=
  h.trans_le le_sup_left
#align lt_sup_of_lt_left lt_sup_of_lt_left

theorem lt_sup_of_lt_right (h : c < b) : c < a ⊔ b :=
  h.trans_le le_sup_right
#align lt_sup_of_lt_right lt_sup_of_lt_right

theorem sup_le : a ≤ c → b ≤ c → a ⊔ b ≤ c :=
  SemilatticeSup.sup_le a b c
#align sup_le sup_le

@[simp]
theorem sup_le_iff : a ⊔ b ≤ c ↔ a ≤ c ∧ b ≤ c :=
  ⟨fun h : a ⊔ b ≤ c => ⟨le_trans le_sup_left h, le_trans le_sup_right h⟩,
   fun ⟨h₁, h₂⟩ => sup_le h₁ h₂⟩
#align sup_le_iff sup_le_iff

@[simp]
theorem sup_eq_left : a ⊔ b = a ↔ b ≤ a :=
  le_antisymm_iff.trans $ by simp [le_rfl]
#align sup_eq_left sup_eq_left

@[simp]
theorem sup_eq_right : a ⊔ b = b ↔ a ≤ b :=
  le_antisymm_iff.trans $ by simp [le_rfl]
#align sup_eq_right sup_eq_right

@[simp]
theorem left_eq_sup : a = a ⊔ b ↔ b ≤ a :=
  eq_comm.trans sup_eq_left
#align left_eq_sup left_eq_sup

@[simp]
theorem right_eq_sup : b = a ⊔ b ↔ a ≤ b :=
  eq_comm.trans sup_eq_right
#align right_eq_sup right_eq_sup

alias sup_eq_left ↔ _ sup_of_le_left
#align sup_of_le_left sup_of_le_left

alias sup_eq_right ↔ le_of_sup_eq sup_of_le_right
#align sup_of_le_right sup_of_le_right
#align le_of_sup_eq le_of_sup_eq

attribute [simp] sup_of_le_left sup_of_le_right

@[simp]
theorem left_lt_sup : a < a ⊔ b ↔ ¬b ≤ a :=
  le_sup_left.lt_iff_ne.trans $ not_congr left_eq_sup
#align left_lt_sup left_lt_sup

@[simp]
theorem right_lt_sup : b < a ⊔ b ↔ ¬a ≤ b :=
  le_sup_right.lt_iff_ne.trans $ not_congr right_eq_sup
#align right_lt_sup right_lt_sup

theorem left_or_right_lt_sup (h : a ≠ b) : a < a ⊔ b ∨ b < a ⊔ b :=
  h.not_le_or_not_le.symm.imp left_lt_sup.2 right_lt_sup.2
#align left_or_right_lt_sup left_or_right_lt_sup

theorem le_iff_exists_sup : a ≤ b ↔ ∃ c, b = a ⊔ c := by
  constructor
  · intro h
    exact ⟨b, (sup_eq_right.mpr h).symm⟩

  · rintro ⟨c, rfl : _ = _ ⊔ _⟩
    exact le_sup_left

#align le_iff_exists_sup le_iff_exists_sup

theorem sup_le_sup (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊔ c ≤ b ⊔ d :=
  sup_le (le_sup_of_le_left h₁) (le_sup_of_le_right h₂)
#align sup_le_sup sup_le_sup

theorem sup_le_sup_left (h₁ : a ≤ b) (c) : c ⊔ a ≤ c ⊔ b :=
  sup_le_sup le_rfl h₁
#align sup_le_sup_left sup_le_sup_left

theorem sup_le_sup_right (h₁ : a ≤ b) (c) : a ⊔ c ≤ b ⊔ c :=
  sup_le_sup h₁ le_rfl
#align sup_le_sup_right sup_le_sup_right

-- Porting note: was @[simp], but now proved by simp so not needed.
theorem sup_idem : a ⊔ a = a := by simp
#align sup_idem sup_idem

instance : IsIdempotent α (· ⊔ ·) :=
  ⟨@sup_idem _ _⟩

theorem sup_comm : a ⊔ b = b ⊔ a := by apply le_antisymm <;> simp
#align sup_comm sup_comm

instance : IsCommutative α (· ⊔ ·) :=
  ⟨@sup_comm _ _⟩

theorem sup_assoc : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) :=
  eq_of_forall_ge_iff $ fun x => by simp only [sup_le_iff]; rw [and_assoc]
#align sup_assoc sup_assoc

instance : IsAssociative α (· ⊔ ·) :=
  ⟨@sup_assoc _ _⟩

theorem sup_left_right_swap (a b c : α) : a ⊔ b ⊔ c = c ⊔ b ⊔ a := by
  rw [sup_comm, @sup_comm _ _ a, sup_assoc]
#align sup_left_right_swap sup_left_right_swap

-- Porting note: was @[simp], but now proved by simp so not needed.
theorem sup_left_idem : a ⊔ (a ⊔ b) = a ⊔ b := by simp
#align sup_left_idem sup_left_idem

-- Porting note: was @[simp], but now proved by simp so not needed.
theorem sup_right_idem : a ⊔ b ⊔ b = a ⊔ b := by simp
#align sup_right_idem sup_right_idem

theorem sup_left_comm (a b c : α) : a ⊔ (b ⊔ c) = b ⊔ (a ⊔ c) := by
  rw [← sup_assoc, ← sup_assoc, @sup_comm α _ a]
#align sup_left_comm sup_left_comm

theorem sup_right_comm (a b c : α) : a ⊔ b ⊔ c = a ⊔ c ⊔ b := by
  rw [sup_assoc, sup_assoc, @sup_comm _ _ b]
#align sup_right_comm sup_right_comm

theorem sup_sup_sup_comm (a b c d : α) : a ⊔ b ⊔ (c ⊔ d) = a ⊔ c ⊔ (b ⊔ d) := by
  rw [sup_assoc, sup_left_comm b, ← sup_assoc]
#align sup_sup_sup_comm sup_sup_sup_comm

theorem sup_sup_distrib_left (a b c : α) : a ⊔ (b ⊔ c) = a ⊔ b ⊔ (a ⊔ c) := by
  rw [sup_sup_sup_comm, sup_idem]
#align sup_sup_distrib_left sup_sup_distrib_left

theorem sup_sup_distrib_right (a b c : α) : a ⊔ b ⊔ c = a ⊔ c ⊔ (b ⊔ c) := by
  rw [sup_sup_sup_comm, sup_idem]
#align sup_sup_distrib_right sup_sup_distrib_right

theorem sup_congr_left (hb : b ≤ a ⊔ c) (hc : c ≤ a ⊔ b) : a ⊔ b = a ⊔ c :=
  (sup_le le_sup_left hb).antisymm $ sup_le le_sup_left hc
#align sup_congr_left sup_congr_left

theorem sup_congr_right (ha : a ≤ b ⊔ c) (hb : b ≤ a ⊔ c) : a ⊔ c = b ⊔ c :=
  (sup_le ha le_sup_right).antisymm $ sup_le hb le_sup_right
#align sup_congr_right sup_congr_right

theorem sup_eq_sup_iff_left : a ⊔ b = a ⊔ c ↔ b ≤ a ⊔ c ∧ c ≤ a ⊔ b :=
  ⟨fun h => ⟨h ▸ le_sup_right, h.symm ▸ le_sup_right⟩, fun h => sup_congr_left h.1 h.2⟩
#align sup_eq_sup_iff_left sup_eq_sup_iff_left

theorem sup_eq_sup_iff_right : a ⊔ c = b ⊔ c ↔ a ≤ b ⊔ c ∧ b ≤ a ⊔ c :=
  ⟨fun h => ⟨h ▸ le_sup_left, h.symm ▸ le_sup_left⟩, fun h => sup_congr_right h.1 h.2⟩
#align sup_eq_sup_iff_right sup_eq_sup_iff_right

theorem Ne.lt_sup_or_lt_sup (hab : a ≠ b) : a < a ⊔ b ∨ b < a ⊔ b :=
  hab.symm.not_le_or_not_le.imp left_lt_sup.2 right_lt_sup.2
#align ne.lt_sup_or_lt_sup Ne.lt_sup_or_lt_sup

/-- If `f` is monotone, `g` is antitone, and `f ≤ g`, then for all `a`, `b` we have `f a ≤ g b`. -/
theorem Monotone.forall_le_of_antitone {β : Type _} [Preorder β] {f g : α → β} (hf : Monotone f)
    (hg : Antitone g) (h : f ≤ g) (m n : α) : f m ≤ g n :=
  calc
    f m ≤ f (m ⊔ n) := hf le_sup_left
    _ ≤ g (m ⊔ n) := h _
    _ ≤ g n := hg le_sup_right

#align monotone.forall_le_of_antitone Monotone.forall_le_of_antitone

theorem SemilatticeSup.ext_sup {α} {A B : SemilatticeSup α}
    (H : ∀ x y : α, (haveI := A; x ≤ y) ↔ x ≤ y)
    (x y : α) :
    (haveI := A; x ⊔ y) = x ⊔ y :=
  eq_of_forall_ge_iff $ fun c => by simp only [sup_le_iff]; rw [← H, @sup_le_iff α A, H, H]
#align semilattice_sup.ext_sup SemilatticeSup.ext_sup

theorem SemilatticeSup.ext {α} {A B : SemilatticeSup α}
    (H : ∀ x y : α, (haveI := A; x ≤ y) ↔ x ≤ y) :
    A = B := by
  have ss : A.toSup = B.toSup := by ext; apply SemilatticeSup.ext_sup H
  cases A
  cases B
  cases PartialOrder.ext H
  congr
#align semilattice_sup.ext SemilatticeSup.ext

theorem ite_le_sup (s s' : α) (P : Prop) [Decidable P] : ite P s s' ≤ s ⊔ s' :=
  if h : P then (if_pos h).trans_le le_sup_left else (if_neg h).trans_le le_sup_right
#align ite_le_sup ite_le_sup

end SemilatticeSup

/-!
### Meet-semilattices
-/

/-- A `SemilatticeInf` is a meet-semilattice, that is, a partial order
  with a meet (a.k.a. glb / greatest lower bound, inf / infimum) operation
  `⊓` which is the greatest element smaller than both factors. -/
class SemilatticeInf (α : Type u) extends Inf α, PartialOrder α where
  /-- The infimum is a lower bound on the first argument -/
  protected inf_le_left : ∀ a b : α, a ⊓ b ≤ a
  /-- The infimum is a lower bound on the second argument -/
  protected inf_le_right : ∀ a b : α, a ⊓ b ≤ b
  /-- The infimum is the *greatest* lower bound -/
  protected le_inf : ∀ a b c : α, a ≤ b → a ≤ c → a ≤ b ⊓ c
#align semilattice_inf SemilatticeInf

instance OrderDual.semilatticeSup (α) [SemilatticeInf α] : SemilatticeSup αᵒᵈ where
  __ := inferInstanceAs (PartialOrder αᵒᵈ)
  __ := inferInstanceAs (Sup αᵒᵈ)
  le_sup_left := @SemilatticeInf.inf_le_left α _
  le_sup_right := @SemilatticeInf.inf_le_right α _
  sup_le := fun _ _ _ hca hcb => @SemilatticeInf.le_inf α _ _ _ _ hca hcb

instance OrderDual.semilatticeInf (α) [SemilatticeSup α] : SemilatticeInf αᵒᵈ where
  __ := inferInstanceAs (PartialOrder αᵒᵈ)
  __ := inferInstanceAs (Inf αᵒᵈ)
  inf_le_left := @le_sup_left α _
  inf_le_right := @le_sup_right α _
  le_inf := fun _ _ _ hca hcb => @sup_le α _ _ _ _ hca hcb

theorem SemilatticeSup.dual_dual (α : Type _) [H : SemilatticeSup α] :
  OrderDual.semilatticeSup αᵒᵈ = H :=
  SemilatticeSup.ext $ fun _ _ => Iff.rfl
#align semilattice_sup.dual_dual SemilatticeSup.dual_dual

section SemilatticeInf

variable [SemilatticeInf α] {a b c d : α}

@[simp]
theorem inf_le_left : a ⊓ b ≤ a :=
  SemilatticeInf.inf_le_left a b
#align inf_le_left inf_le_left

-- Porting note: no ematch attribute
--@[ematch]
theorem inf_le_left' : a ⊓ b ≤ a :=
  SemilatticeInf.inf_le_left a b
#align inf_le_left' inf_le_left'

@[simp]
theorem inf_le_right : a ⊓ b ≤ b :=
  SemilatticeInf.inf_le_right a b
#align inf_le_right inf_le_right

-- Porting note: no ematch attribute
--@[ematch]
theorem inf_le_right' : a ⊓ b ≤ b :=
  SemilatticeInf.inf_le_right a b
#align inf_le_right' inf_le_right'

theorem le_inf : a ≤ b → a ≤ c → a ≤ b ⊓ c :=
  SemilatticeInf.le_inf a b c
#align le_inf le_inf

theorem inf_le_of_left_le (h : a ≤ c) : a ⊓ b ≤ c :=
  le_trans inf_le_left h
#align inf_le_of_left_le inf_le_of_left_le

theorem inf_le_of_right_le (h : b ≤ c) : a ⊓ b ≤ c :=
  le_trans inf_le_right h
#align inf_le_of_right_le inf_le_of_right_le

theorem inf_lt_of_left_lt (h : a < c) : a ⊓ b < c :=
  lt_of_le_of_lt inf_le_left h
#align inf_lt_of_left_lt inf_lt_of_left_lt

theorem inf_lt_of_right_lt (h : b < c) : a ⊓ b < c :=
  lt_of_le_of_lt inf_le_right h
#align inf_lt_of_right_lt inf_lt_of_right_lt

@[simp]
theorem le_inf_iff : a ≤ b ⊓ c ↔ a ≤ b ∧ a ≤ c :=
  @sup_le_iff αᵒᵈ _ _ _ _
#align le_inf_iff le_inf_iff

@[simp]
theorem inf_eq_left : a ⊓ b = a ↔ a ≤ b :=
  le_antisymm_iff.trans $ by simp [le_rfl]
#align inf_eq_left inf_eq_left

@[simp]
theorem inf_eq_right : a ⊓ b = b ↔ b ≤ a :=
  le_antisymm_iff.trans $ by simp [le_rfl]
#align inf_eq_right inf_eq_right

@[simp]
theorem left_eq_inf : a = a ⊓ b ↔ a ≤ b :=
  eq_comm.trans inf_eq_left
#align left_eq_inf left_eq_inf

@[simp]
theorem right_eq_inf : b = a ⊓ b ↔ b ≤ a :=
  eq_comm.trans inf_eq_right
#align right_eq_inf right_eq_inf

alias inf_eq_left ↔ le_of_inf_eq inf_of_le_left
#align inf_of_le_left inf_of_le_left
#align le_of_inf_eq le_of_inf_eq

alias inf_eq_right ↔ _ inf_of_le_right
#align inf_of_le_right inf_of_le_right

attribute [simp] inf_of_le_left inf_of_le_right

@[simp]
theorem inf_lt_left : a ⊓ b < a ↔ ¬a ≤ b :=
  @left_lt_sup αᵒᵈ _ _ _
#align inf_lt_left inf_lt_left

@[simp]
theorem inf_lt_right : a ⊓ b < b ↔ ¬b ≤ a :=
  @right_lt_sup αᵒᵈ _ _ _
#align inf_lt_right inf_lt_right

theorem inf_lt_left_or_right (h : a ≠ b) : a ⊓ b < a ∨ a ⊓ b < b :=
  @left_or_right_lt_sup αᵒᵈ _ _ _ h
#align inf_lt_left_or_right inf_lt_left_or_right

theorem inf_le_inf (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊓ c ≤ b ⊓ d :=
  @sup_le_sup αᵒᵈ _ _ _ _ _ h₁ h₂
#align inf_le_inf inf_le_inf

theorem inf_le_inf_right (a : α) {b c : α} (h : b ≤ c) : b ⊓ a ≤ c ⊓ a :=
  inf_le_inf h le_rfl
#align inf_le_inf_right inf_le_inf_right

theorem inf_le_inf_left (a : α) {b c : α} (h : b ≤ c) : a ⊓ b ≤ a ⊓ c :=
  inf_le_inf le_rfl h
#align inf_le_inf_left inf_le_inf_left

-- Porting note: was @[simp]
theorem inf_idem : a ⊓ a = a :=
  @sup_idem αᵒᵈ _ _
#align inf_idem inf_idem

instance : IsIdempotent α (· ⊓ ·) :=
  ⟨@inf_idem _ _⟩

theorem inf_comm : a ⊓ b = b ⊓ a :=
  @sup_comm αᵒᵈ _ _ _
#align inf_comm inf_comm

instance : IsCommutative α (· ⊓ ·) :=
  ⟨@inf_comm _ _⟩

theorem inf_assoc : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) :=
  @sup_assoc αᵒᵈ _ a b c
#align inf_assoc inf_assoc

instance : IsAssociative α (· ⊓ ·) :=
  ⟨@inf_assoc _ _⟩

theorem inf_left_right_swap (a b c : α) : a ⊓ b ⊓ c = c ⊓ b ⊓ a :=
  @sup_left_right_swap αᵒᵈ _ _ _ _
#align inf_left_right_swap inf_left_right_swap

-- Porting note: was @[simp]
theorem inf_left_idem : a ⊓ (a ⊓ b) = a ⊓ b :=
  @sup_left_idem αᵒᵈ _ a b
#align inf_left_idem inf_left_idem

-- Porting note: was @[simp]
theorem inf_right_idem : a ⊓ b ⊓ b = a ⊓ b :=
  @sup_right_idem αᵒᵈ _ a b
#align inf_right_idem inf_right_idem

theorem inf_left_comm (a b c : α) : a ⊓ (b ⊓ c) = b ⊓ (a ⊓ c) :=
  @sup_left_comm αᵒᵈ _ a b c
#align inf_left_comm inf_left_comm

theorem inf_right_comm (a b c : α) : a ⊓ b ⊓ c = a ⊓ c ⊓ b :=
  @sup_right_comm αᵒᵈ _ a b c
#align inf_right_comm inf_right_comm

theorem inf_inf_inf_comm (a b c d : α) : a ⊓ b ⊓ (c ⊓ d) = a ⊓ c ⊓ (b ⊓ d) :=
  @sup_sup_sup_comm αᵒᵈ _ _ _ _ _
#align inf_inf_inf_comm inf_inf_inf_comm

theorem inf_inf_distrib_left (a b c : α) : a ⊓ (b ⊓ c) = a ⊓ b ⊓ (a ⊓ c) :=
  @sup_sup_distrib_left αᵒᵈ _ _ _ _
#align inf_inf_distrib_left inf_inf_distrib_left

theorem inf_inf_distrib_right (a b c : α) : a ⊓ b ⊓ c = a ⊓ c ⊓ (b ⊓ c) :=
  @sup_sup_distrib_right αᵒᵈ _ _ _ _
#align inf_inf_distrib_right inf_inf_distrib_right

theorem inf_congr_left (hb : a ⊓ c ≤ b) (hc : a ⊓ b ≤ c) : a ⊓ b = a ⊓ c :=
  @sup_congr_left αᵒᵈ _ _ _ _ hb hc
#align inf_congr_left inf_congr_left

theorem inf_congr_right (h1 : b ⊓ c ≤ a) (h2 : a ⊓ c ≤ b) : a ⊓ c = b ⊓ c :=
  @sup_congr_right αᵒᵈ _ _ _ _ h1 h2
#align inf_congr_right inf_congr_right

theorem inf_eq_inf_iff_left : a ⊓ b = a ⊓ c ↔ a ⊓ c ≤ b ∧ a ⊓ b ≤ c :=
  @sup_eq_sup_iff_left αᵒᵈ _ _ _ _
#align inf_eq_inf_iff_left inf_eq_inf_iff_left

theorem inf_eq_inf_iff_right : a ⊓ c = b ⊓ c ↔ b ⊓ c ≤ a ∧ a ⊓ c ≤ b :=
  @sup_eq_sup_iff_right αᵒᵈ _ _ _ _
#align inf_eq_inf_iff_right inf_eq_inf_iff_right

theorem Ne.inf_lt_or_inf_lt : a ≠ b → a ⊓ b < a ∨ a ⊓ b < b :=
  @Ne.lt_sup_or_lt_sup αᵒᵈ _ _ _
#align ne.inf_lt_or_inf_lt Ne.inf_lt_or_inf_lt

theorem SemilatticeInf.ext_inf {α} {A B : SemilatticeInf α}
    (H : ∀ x y : α, (haveI := A; x ≤ y) ↔ x ≤ y)
    (x y : α) :
    (haveI := A; x ⊓ y) = x ⊓ y :=
  eq_of_forall_le_iff $ fun c => by simp only [le_inf_iff]; rw [← H, @le_inf_iff α A, H, H]
#align semilattice_inf.ext_inf SemilatticeInf.ext_inf

theorem SemilatticeInf.ext {α} {A B : SemilatticeInf α}
    (H : ∀ x y : α, (haveI := A; x ≤ y) ↔ x ≤ y) :
    A = B := by
  have ss : A.toInf = B.toInf := by ext; apply SemilatticeInf.ext_inf H
  cases A
  cases B
  cases PartialOrder.ext H
  congr
#align semilattice_inf.ext SemilatticeInf.ext

theorem SemilatticeInf.dual_dual (α : Type _) [H : SemilatticeInf α] :
  OrderDual.semilatticeInf αᵒᵈ = H :=
  SemilatticeInf.ext $ fun _ _ => Iff.rfl
#align semilattice_inf.dual_dual SemilatticeInf.dual_dual

theorem inf_le_ite (s s' : α) (P : Prop) [Decidable P] : s ⊓ s' ≤ ite P s s' :=
  @ite_le_sup αᵒᵈ _ _ _ _ _
#align inf_le_ite inf_le_ite

end SemilatticeInf

/--
A type with a commutative, associative and idempotent binary `inf` operation has the structure of a
meet-semilattice.

The partial order is defined so that `a ≤ b` unfolds to `b ⊓ a = a`; cf. `inf_eq_right`.
-/
def SemilatticeInf.mk' {α : Type _} [Inf α] (inf_comm : ∀ a b : α, a ⊓ b = b ⊓ a)
    (inf_assoc : ∀ a b c : α, a ⊓ b ⊓ c = a ⊓ (b ⊓ c)) (inf_idem : ∀ a : α, a ⊓ a = a) :
    SemilatticeInf α := by
  haveI : SemilatticeSup αᵒᵈ := SemilatticeSup.mk' inf_comm inf_assoc inf_idem
  haveI i := OrderDual.semilatticeInf αᵒᵈ
  exact i
#align semilattice_inf.mk' SemilatticeInf.mk'

/-!
### Lattices
-/

/-- A lattice is a join-semilattice which is also a meet-semilattice. -/
class Lattice (α : Type u) extends SemilatticeSup α, SemilatticeInf α
#align lattice Lattice

instance OrderDual.lattice (α) [Lattice α] : Lattice αᵒᵈ :=
  { OrderDual.semilatticeSup α, OrderDual.semilatticeInf α with }

/-- The partial orders from `SemilatticeSup_mk'` and `SemilatticeInf_mk'` agree
if `sup` and `inf` satisfy the lattice absorption laws `sup_inf_self` (`a ⊔ a ⊓ b = a`)
and `inf_sup_self` (`a ⊓ (a ⊔ b) = a`). -/
theorem semilatticeSup_mk'_partialOrder_eq_semilatticeInf_mk'_partialOrder
    {α : Type _} [Sup α] [Inf α]
    (sup_comm : ∀ a b : α, a ⊔ b = b ⊔ a) (sup_assoc : ∀ a b c : α, a ⊔ b ⊔ c = a ⊔ (b ⊔ c))
    (sup_idem : ∀ a : α, a ⊔ a = a) (inf_comm : ∀ a b : α, a ⊓ b = b ⊓ a)
    (inf_assoc : ∀ a b c : α, a ⊓ b ⊓ c = a ⊓ (b ⊓ c)) (inf_idem : ∀ a : α, a ⊓ a = a)
    (sup_inf_self : ∀ a b : α, a ⊔ a ⊓ b = a) (inf_sup_self : ∀ a b : α, a ⊓ (a ⊔ b) = a) :
    @SemilatticeSup.toPartialOrder _ (SemilatticeSup.mk' sup_comm sup_assoc sup_idem) =
      @SemilatticeInf.toPartialOrder _ (SemilatticeInf.mk' inf_comm inf_assoc inf_idem) :=
  PartialOrder.ext $ fun a b =>
    show a ⊔ b = b ↔ b ⊓ a = a from
      ⟨fun h => by rw [← h, inf_comm, inf_sup_self], fun h => by rw [← h, sup_comm, sup_inf_self]⟩
#align semilattice_sup_mk'_partial_order_eq_semilattice_inf_mk'_partial_order semilatticeSup_mk'_partialOrder_eq_semilatticeInf_mk'_partialOrder

/-- A type with a pair of commutative and associative binary operations which satisfy two absorption
laws relating the two operations has the structure of a lattice.

The partial order is defined so that `a ≤ b` unfolds to `a ⊔ b = b`; cf. `sup_eq_right`.
-/
def Lattice.mk' {α : Type _} [Sup α] [Inf α] (sup_comm : ∀ a b : α, a ⊔ b = b ⊔ a)
    (sup_assoc : ∀ a b c : α, a ⊔ b ⊔ c = a ⊔ (b ⊔ c)) (inf_comm : ∀ a b : α, a ⊓ b = b ⊓ a)
    (inf_assoc : ∀ a b c : α, a ⊓ b ⊓ c = a ⊓ (b ⊓ c)) (sup_inf_self : ∀ a b : α, a ⊔ a ⊓ b = a)
    (inf_sup_self : ∀ a b : α, a ⊓ (a ⊔ b) = a) : Lattice α :=
  have sup_idem : ∀ b : α, b ⊔ b = b := fun b =>
    calc
      b ⊔ b = b ⊔ b ⊓ (b ⊔ b) := by rw [inf_sup_self]
      _ = b := by rw [sup_inf_self]

  have inf_idem : ∀ b : α, b ⊓ b = b := fun b =>
    calc
      b ⊓ b = b ⊓ (b ⊔ b ⊓ b) := by rw [sup_inf_self]
      _ = b := by rw [inf_sup_self]

  let semilatt_inf_inst := SemilatticeInf.mk' inf_comm inf_assoc inf_idem
  let semilatt_sup_inst := SemilatticeSup.mk' sup_comm sup_assoc sup_idem
  have partial_order_eq : @SemilatticeSup.toPartialOrder _ semilatt_sup_inst =
                          @SemilatticeInf.toPartialOrder _ semilatt_inf_inst :=
    semilatticeSup_mk'_partialOrder_eq_semilatticeInf_mk'_partialOrder _ _ _ _ _ _
      sup_inf_self inf_sup_self
  { semilatt_sup_inst, semilatt_inf_inst with
    inf_le_left := fun a b => by
      rw [partial_order_eq]
      apply inf_le_left,
    inf_le_right := fun a b => by
      rw [partial_order_eq]
      apply inf_le_right,
    le_inf := fun a b c => by
      rw [partial_order_eq]
      apply le_inf }
#align lattice.mk' Lattice.mk'

section Lattice

variable [Lattice α] {a b c d : α}

theorem inf_le_sup : a ⊓ b ≤ a ⊔ b :=
  inf_le_left.trans le_sup_left
#align inf_le_sup inf_le_sup

-- Porting note: was @[simp]
theorem sup_le_inf : a ⊔ b ≤ a ⊓ b ↔ a = b := by simp [le_antisymm_iff, and_comm]
#align sup_le_inf sup_le_inf

@[simp] lemma inf_eq_sup : a ⊓ b = a ⊔ b ↔ a = b := by rw [←inf_le_sup.ge_iff_eq, sup_le_inf]
@[simp] lemma sup_eq_inf : a ⊔ b = a ⊓ b ↔ a = b := eq_comm.trans inf_eq_sup
@[simp] lemma inf_lt_sup : a ⊓ b < a ⊔ b ↔ a ≠ b := by rw [inf_le_sup.lt_iff_ne, Ne.def, inf_eq_sup]
#align inf_lt_sup inf_lt_sup
#align sup_eq_inf sup_eq_inf
#align inf_eq_sup inf_eq_sup

lemma inf_eq_and_sup_eq_iff : a ⊓ b = c ∧ a ⊔ b = c ↔ a = c ∧ b = c := by
  refine' ⟨fun h ↦ _, _⟩
  { obtain rfl := sup_eq_inf.1 (h.2.trans h.1.symm)
    simpa using h }
  { rintro ⟨rfl, rfl⟩
    exact ⟨inf_idem, sup_idem⟩ }
#align inf_eq_and_sup_eq_iff inf_eq_and_sup_eq_iff

/-!
#### Distributivity laws
-/

-- TODO: better names?
theorem sup_inf_le : a ⊔ b ⊓ c ≤ (a ⊔ b) ⊓ (a ⊔ c) :=
  le_inf (sup_le_sup_left inf_le_left _) (sup_le_sup_left inf_le_right _)
#align sup_inf_le sup_inf_le

theorem le_inf_sup : a ⊓ b ⊔ a ⊓ c ≤ a ⊓ (b ⊔ c) :=
  sup_le (inf_le_inf_left _ le_sup_left) (inf_le_inf_left _ le_sup_right)
#align le_inf_sup le_inf_sup

theorem inf_sup_self : a ⊓ (a ⊔ b) = a := by simp
#align inf_sup_self inf_sup_self

theorem sup_inf_self : a ⊔ a ⊓ b = a := by simp
#align sup_inf_self sup_inf_self

theorem sup_eq_iff_inf_eq : a ⊔ b = b ↔ a ⊓ b = a := by rw [sup_eq_right, ← inf_eq_left]
#align sup_eq_iff_inf_eq sup_eq_iff_inf_eq

theorem Lattice.ext {α} {A B : Lattice α} (H : ∀ x y : α, (haveI := A; x ≤ y) ↔ x ≤ y) :
    A = B := by
  cases A
  cases B
  cases SemilatticeSup.ext H
  cases SemilatticeInf.ext H
  congr
#align lattice.ext Lattice.ext

end Lattice

/-!
### Distributive lattices
-/

/-- A distributive lattice is a lattice that satisfies any of four
equivalent distributive properties (of `sup` over `inf` or `inf` over `sup`,
on the left or right).

The definition here chooses `le_sup_inf`: `(x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ (y ⊓ z)`. To prove distributivity
from the dual law, use `DistribLattice.of_inf_sup_le`.

A classic example of a distributive lattice
is the lattice of subsets of a set, and in fact this example is
generic in the sense that every distributive lattice is realizable
as a sublattice of a powerset lattice. -/
class DistribLattice (α) extends Lattice α where
  /-- The infimum distributes over the supremum -/
  protected le_sup_inf : ∀ x y z : α, (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ y ⊓ z
#align distrib_lattice DistribLattice

section DistribLattice

variable [DistribLattice α] {x y z : α}

theorem le_sup_inf : ∀ {x y z : α}, (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ y ⊓ z :=
  fun {x y z} => DistribLattice.le_sup_inf x y z
#align le_sup_inf le_sup_inf

theorem sup_inf_left : x ⊔ y ⊓ z = (x ⊔ y) ⊓ (x ⊔ z) :=
  le_antisymm sup_inf_le le_sup_inf
#align sup_inf_left sup_inf_left

theorem sup_inf_right : y ⊓ z ⊔ x = (y ⊔ x) ⊓ (z ⊔ x) := by
  simp only [sup_inf_left, fun y : α => @sup_comm α _ y x, eq_self_iff_true]
#align sup_inf_right sup_inf_right

theorem inf_sup_left : x ⊓ (y ⊔ z) = x ⊓ y ⊔ x ⊓ z :=
  calc
    x ⊓ (y ⊔ z) = x ⊓ (x ⊔ z) ⊓ (y ⊔ z) := by rw [inf_sup_self]
    _ = x ⊓ (x ⊓ y ⊔ z) := by simp only [inf_assoc, sup_inf_right, eq_self_iff_true]
    _ = (x ⊔ x ⊓ y) ⊓ (x ⊓ y ⊔ z) := by rw [sup_inf_self]
    _ = (x ⊓ y ⊔ x) ⊓ (x ⊓ y ⊔ z) := by rw [sup_comm]
    _ = x ⊓ y ⊔ x ⊓ z := by rw [sup_inf_left]

#align inf_sup_left inf_sup_left

instance OrderDual.distribLattice (α : Type _) [DistribLattice α] : DistribLattice αᵒᵈ where
  __ := inferInstanceAs (Lattice αᵒᵈ)
  le_sup_inf := fun _ _ _ => le_of_eq (@inf_sup_left α).symm

theorem inf_sup_right : (y ⊔ z) ⊓ x = y ⊓ x ⊔ z ⊓ x := by
  simp only [inf_sup_left, fun y : α => @inf_comm α _ y x, eq_self_iff_true]
#align inf_sup_right inf_sup_right

theorem le_of_inf_le_sup_le (h₁ : x ⊓ z ≤ y ⊓ z) (h₂ : x ⊔ z ≤ y ⊔ z) : x ≤ y :=
  calc
    x ≤ y ⊓ z ⊔ x := le_sup_right
    _ = (y ⊔ x) ⊓ (x ⊔ z) := by rw [sup_inf_right, @sup_comm _ _ x]
    _ ≤ (y ⊔ x) ⊓ (y ⊔ z) := inf_le_inf_left _ h₂
    _ = y ⊔ x ⊓ z := sup_inf_left.symm
    _ ≤ y ⊔ y ⊓ z := sup_le_sup_left h₁ _
    _ ≤ _ := sup_le (le_refl y) inf_le_left

#align le_of_inf_le_sup_le le_of_inf_le_sup_le

theorem eq_of_inf_eq_sup_eq {α : Type u} [DistribLattice α] {a b c : α} (h₁ : b ⊓ a = c ⊓ a)
  (h₂ : b ⊔ a = c ⊔ a) :
    b = c :=
  le_antisymm (le_of_inf_le_sup_le (le_of_eq h₁) (le_of_eq h₂))
    (le_of_inf_le_sup_le (le_of_eq h₁.symm) (le_of_eq h₂.symm))
#align eq_of_inf_eq_sup_eq eq_of_inf_eq_sup_eq

end DistribLattice

-- See note [reducible non-instances]
/-- Prove distributivity of an existing lattice from the dual distributive law. -/
@[reducible]
def DistribLattice.ofInfSupLe [Lattice α] (inf_sup_le : ∀ a b c : α, a ⊓ (b ⊔ c) ≤ a ⊓ b ⊔ a ⊓ c) :
    DistribLattice α :=
  { le_sup_inf := (@OrderDual.distribLattice αᵒᵈ {inferInstanceAs (Lattice αᵒᵈ) with
      le_sup_inf := inf_sup_le}).le_sup_inf, }
#align distrib_lattice.of_inf_sup_le DistribLattice.ofInfSupLe

/-!
### Lattices derived from linear orders
-/

-- see Note [lower instance priority]
instance (priority := 100) LinearOrder.toLattice {α : Type u} [o : LinearOrder α] : Lattice α :=
  { o with
    sup := max,
    le_sup_left := le_max_left, le_sup_right := le_max_right, sup_le := fun _ _ _ => max_le,
    inf := min,
    inf_le_left := min_le_left, inf_le_right := min_le_right, le_inf := fun _ _ _ => le_min }

section LinearOrder

variable [LinearOrder α] {a b c d : α}

theorem sup_eq_max : a ⊔ b = max a b :=
  rfl
#align sup_eq_max sup_eq_max

theorem inf_eq_min : a ⊓ b = min a b :=
  rfl
#align inf_eq_min inf_eq_min

theorem sup_ind (a b : α) {p : α → Prop} (ha : p a) (hb : p b) : p (a ⊔ b) :=
  (IsTotal.total a b).elim (fun h : a ≤ b => by rwa [sup_eq_right.2 h]) fun h => by
  rwa [sup_eq_left.2 h]
#align sup_ind sup_ind

@[simp]
theorem le_sup_iff : a ≤ b ⊔ c ↔ a ≤ b ∨ a ≤ c := by
  exact ⟨fun h =>
    (le_total c b).imp
      (fun bc => by rwa [sup_eq_left.2 bc] at h)
      (fun bc => by rwa [sup_eq_right.2 bc] at h),
    fun h => h.elim le_sup_of_le_left le_sup_of_le_right⟩
#align le_sup_iff le_sup_iff

@[simp]
theorem lt_sup_iff : a < b ⊔ c ↔ a < b ∨ a < c := by
  exact ⟨fun h =>
    (le_total c b).imp
      (fun bc => by rwa [sup_eq_left.2 bc] at h)
      (fun bc => by rwa [sup_eq_right.2 bc] at h),
    fun h => h.elim lt_sup_of_lt_left lt_sup_of_lt_right⟩
#align lt_sup_iff lt_sup_iff

-- Porting note: why does sup_ind need an explicit motive?
@[simp]
theorem sup_lt_iff : b ⊔ c < a ↔ b < a ∧ c < a :=
  ⟨fun h => ⟨le_sup_left.trans_lt h, le_sup_right.trans_lt h⟩,
   fun h => @sup_ind α _ b c (fun x => x < a) h.1 h.2⟩
#align sup_lt_iff sup_lt_iff

theorem inf_ind (a b : α) {p : α → Prop} : p a → p b → p (a ⊓ b) :=
  @sup_ind αᵒᵈ _ _ _ _
#align inf_ind inf_ind

@[simp]
theorem inf_le_iff : b ⊓ c ≤ a ↔ b ≤ a ∨ c ≤ a :=
  @le_sup_iff αᵒᵈ _ _ _ _
#align inf_le_iff inf_le_iff

@[simp]
theorem inf_lt_iff : b ⊓ c < a ↔ b < a ∨ c < a :=
  @lt_sup_iff αᵒᵈ _ _ _ _
#align inf_lt_iff inf_lt_iff

@[simp]
theorem lt_inf_iff : a < b ⊓ c ↔ a < b ∧ a < c :=
  @sup_lt_iff αᵒᵈ _ _ _ _
#align lt_inf_iff lt_inf_iff

variable (a b c d)

theorem max_max_max_comm : max (max a b) (max c d) = max (max a c) (max b d) :=
  sup_sup_sup_comm _ _ _ _
#align max_max_max_comm max_max_max_comm

theorem min_min_min_comm : min (min a b) (min c d) = min (min a c) (min b d) :=
  inf_inf_inf_comm _ _ _ _
#align min_min_min_comm min_min_min_comm

end LinearOrder

theorem sup_eq_maxDefault [SemilatticeSup α] [DecidableRel ((· ≤ ·) : α → α → Prop)]
    [IsTotal α (· ≤ ·)] :
    (· ⊔ ·) = (maxDefault : α → α → α) := by
  ext (x y)
  unfold maxDefault
  split_ifs with h'
  exacts[sup_of_le_right h', sup_of_le_left $ (total_of (· ≤ ·) x y).resolve_left h']
#align sup_eq_max_default sup_eq_maxDefault

theorem inf_eq_minDefault [SemilatticeInf α] [DecidableRel ((· ≤ ·) : α → α → Prop)]
    [IsTotal α (· ≤ ·)] :
    (· ⊓ ·) = (minDefault : α → α → α) := by
  ext (x y)
  unfold minDefault
  split_ifs with h'
  exacts[inf_of_le_left h', inf_of_le_right $ (total_of (· ≤ ·) x y).resolve_left h']
#align inf_eq_min_default inf_eq_minDefault

/-- A lattice with total order is a linear order.

See note [reducible non-instances]. -/
@[reducible]
def Lattice.toLinearOrder (α : Type u) [Lattice α] [DecidableEq α]
    [DecidableRel ((· ≤ ·) : α → α → Prop)]
    [DecidableRel ((· < ·) : α → α → Prop)] [IsTotal α (· ≤ ·)] : LinearOrder α :=
  { ‹Lattice α› with
    decidable_le := ‹_›,
    decidable_eq := ‹_›,
    decidable_lt := ‹_›,
    le_total := total_of (· ≤ ·),
    max := (· ⊔ ·),
    max_def := by exact congr_fun₂ sup_eq_maxDefault,
    min := (· ⊓ ·),
    min_def := by exact congr_fun₂ inf_eq_minDefault }
#align lattice.to_linear_order Lattice.toLinearOrder

-- see Note [lower instance priority]
instance (priority := 100) {α : Type u} [LinearOrder α] :
  DistribLattice α where
  __ := inferInstanceAs (Lattice α)
  le_sup_inf _ b c :=
    match le_total b c with
    | Or.inl h => inf_le_of_left_le $ sup_le_sup_left (le_inf (le_refl b) h) _
    | Or.inr h => inf_le_of_right_le $ sup_le_sup_left (le_inf h (le_refl c)) _

instance : DistribLattice ℕ := inferInstance

/-! ### Dual order -/

open OrderDual

@[simp]
theorem ofDual_inf [Sup α] (a b : αᵒᵈ) : ofDual (a ⊓ b) = ofDual a ⊔ ofDual b :=
  rfl
#align of_dual_inf ofDual_inf

@[simp]
theorem ofDual_sup [Inf α] (a b : αᵒᵈ) : ofDual (a ⊔ b) = ofDual a ⊓ ofDual b :=
  rfl
#align of_dual_sup ofDual_sup

@[simp]
theorem toDual_inf [Inf α] (a b : α) : toDual (a ⊓ b) = toDual a ⊔ toDual b :=
  rfl
#align to_dual_inf toDual_inf

@[simp]
theorem toDual_sup [Sup α] (a b : α) : toDual (a ⊔ b) = toDual a ⊓ toDual b :=
  rfl
#align to_dual_sup toDual_sup

section LinearOrder

variable [LinearOrder α]

@[simp]
theorem ofDual_min (a b : αᵒᵈ) : ofDual (min a b) = max (ofDual a) (ofDual b) :=
  rfl
#align of_dual_min ofDual_min

@[simp]
theorem ofDual_max (a b : αᵒᵈ) : ofDual (max a b) = min (ofDual a) (ofDual b) :=
  rfl
#align of_dual_max ofDual_max

@[simp]
theorem toDual_min (a b : α) : toDual (min a b) = max (toDual a) (toDual b) :=
  rfl
#align to_dual_min toDual_min

@[simp]
theorem toDual_max (a b : α) : toDual (max a b) = min (toDual a) (toDual b) :=
  rfl
#align to_dual_max toDual_max

end LinearOrder

/-! ### Function lattices -/

namespace Pi

variable {ι : Type _} {α' : ι → Type _}

instance [∀ i, Sup (α' i)] : Sup (∀ i, α' i) :=
  ⟨fun f g i => f i ⊔ g i⟩

@[simp]
theorem sup_apply [∀ i, Sup (α' i)] (f g : ∀ i, α' i) (i : ι) : (f ⊔ g) i = f i ⊔ g i :=
  rfl
#align pi.sup_apply Pi.sup_apply

theorem sup_def [∀ i, Sup (α' i)] (f g : ∀ i, α' i) : f ⊔ g = fun i => f i ⊔ g i :=
  rfl
#align pi.sup_def Pi.sup_def

instance [∀ i, Inf (α' i)] : Inf (∀ i, α' i) :=
  ⟨fun f g i => f i ⊓ g i⟩

@[simp]
theorem inf_apply [∀ i, Inf (α' i)] (f g : ∀ i, α' i) (i : ι) : (f ⊓ g) i = f i ⊓ g i :=
  rfl
#align pi.inf_apply Pi.inf_apply

theorem inf_def [∀ i, Inf (α' i)] (f g : ∀ i, α' i) : f ⊓ g = fun i => f i ⊓ g i :=
  rfl
#align pi.inf_def Pi.inf_def

instance semilatticeSup [∀ i, SemilatticeSup (α' i)] : SemilatticeSup (∀ i, α' i) where
  le_sup_left _ _ _ := le_sup_left
  le_sup_right _ _ _ := le_sup_right
  sup_le _ _ _ ac bc i := sup_le (ac i) (bc i)

instance semilatticeInf [∀ i, SemilatticeInf (α' i)] : SemilatticeInf (∀ i, α' i) where
  inf_le_left _ _ _ := inf_le_left
  inf_le_right _ _ _ := inf_le_right
  le_inf _ _ _ ac bc i := le_inf (ac i) (bc i)

instance lattice [∀ i, Lattice (α' i)] : Lattice (∀ i, α' i) where
  __ := inferInstanceAs (SemilatticeSup (∀ i, α' i))
  __ := inferInstanceAs (SemilatticeInf (∀ i, α' i))

instance distribLattice [∀ i, DistribLattice (α' i)] : DistribLattice (∀ i, α' i) where
  le_sup_inf _ _ _ _ := le_sup_inf

end Pi

/-!
### Monotone functions and lattices
-/

namespace Monotone

/-- Pointwise supremum of two monotone functions is a monotone function. -/
protected theorem sup [Preorder α] [SemilatticeSup β] {f g : α → β} (hf : Monotone f)
    (hg : Monotone g) :
    Monotone (f ⊔ g) := fun _ _ h => sup_le_sup (hf h) (hg h)
#align monotone.sup Monotone.sup

/-- Pointwise infimum of two monotone functions is a monotone function. -/
protected theorem inf [Preorder α] [SemilatticeInf β] {f g : α → β} (hf : Monotone f)
    (hg : Monotone g) :
    Monotone (f ⊓ g) := fun _ _ h => inf_le_inf (hf h) (hg h)
#align monotone.inf Monotone.inf

/-- Pointwise maximum of two monotone functions is a monotone function. -/
protected theorem max [Preorder α] [LinearOrder β] {f g : α → β} (hf : Monotone f)
    (hg : Monotone g) :
    Monotone fun x => max (f x) (g x) :=
  hf.sup hg
#align monotone.max Monotone.max

/-- Pointwise minimum of two monotone functions is a monotone function. -/
protected theorem min [Preorder α] [LinearOrder β] {f g : α → β} (hf : Monotone f)
    (hg : Monotone g) :
    Monotone fun x => min (f x) (g x) :=
  hf.inf hg
#align monotone.min Monotone.min

theorem le_map_sup [SemilatticeSup α] [SemilatticeSup β] {f : α → β} (h : Monotone f) (x y : α) :
    f x ⊔ f y ≤ f (x ⊔ y) :=
  sup_le (h le_sup_left) (h le_sup_right)
#align monotone.le_map_sup Monotone.le_map_sup

theorem map_inf_le [SemilatticeInf α] [SemilatticeInf β] {f : α → β} (h : Monotone f) (x y : α) :
    f (x ⊓ y) ≤ f x ⊓ f y :=
  le_inf (h inf_le_left) (h inf_le_right)
#align monotone.map_inf_le Monotone.map_inf_le

theorem of_map_inf [SemilatticeInf α] [SemilatticeInf β] {f : α → β}
    (h : ∀ x y, f (x ⊓ y) = f x ⊓ f y) : Monotone f :=
  fun x y hxy => inf_eq_left.1 $ by rw [← h, inf_eq_left.2 hxy]
#align monotone.of_map_inf Monotone.of_map_inf

theorem of_map_sup [SemilatticeSup α] [SemilatticeSup β] {f : α → β}
    (h : ∀ x y, f (x ⊔ y) = f x ⊔ f y) : Monotone f :=
  (@of_map_inf (OrderDual α) (OrderDual β) _ _ _ h).dual
#align monotone.of_map_sup Monotone.of_map_sup

variable [LinearOrder α]

theorem map_sup [SemilatticeSup β] {f : α → β} (hf : Monotone f) (x y : α) :
    f (x ⊔ y) = f x ⊔ f y :=
  (IsTotal.total x y).elim (fun h : x ≤ y => by simp only [h, hf h, sup_of_le_right]) fun h => by
    simp only [h, hf h, sup_of_le_left]
#align monotone.map_sup Monotone.map_sup

theorem map_inf [SemilatticeInf β] {f : α → β} (hf : Monotone f) (x y : α) :
    f (x ⊓ y) = f x ⊓ f y :=
  hf.dual.map_sup _ _
#align monotone.map_inf Monotone.map_inf

end Monotone

namespace MonotoneOn

/-- Pointwise supremum of two monotone functions is a monotone function. -/
protected theorem sup [Preorder α] [SemilatticeSup β] {f g : α → β} {s : Set α}
    (hf : MonotoneOn f s) (hg : MonotoneOn g s) : MonotoneOn (f ⊔ g) s :=
  fun _ hx _ hy h => sup_le_sup (hf hx hy h) (hg hx hy h)
#align monotone_on.sup MonotoneOn.sup

/-- Pointwise infimum of two monotone functions is a monotone function. -/
protected theorem inf [Preorder α] [SemilatticeInf β] {f g : α → β} {s : Set α}
    (hf : MonotoneOn f s) (hg : MonotoneOn g s) : MonotoneOn (f ⊓ g) s :=
  (hf.dual.sup hg.dual).dual
#align monotone_on.inf MonotoneOn.inf

/-- Pointwise maximum of two monotone functions is a monotone function. -/
protected theorem max [Preorder α] [LinearOrder β] {f g : α → β} {s : Set α} (hf : MonotoneOn f s)
    (hg : MonotoneOn g s) : MonotoneOn (fun x => max (f x) (g x)) s :=
  hf.sup hg
#align monotone_on.max MonotoneOn.max

/-- Pointwise minimum of two monotone functions is a monotone function. -/
protected theorem min [Preorder α] [LinearOrder β] {f g : α → β} {s : Set α} (hf : MonotoneOn f s)
    (hg : MonotoneOn g s) : MonotoneOn (fun x => min (f x) (g x)) s :=
  hf.inf hg
#align monotone_on.min MonotoneOn.min

end MonotoneOn

namespace Antitone

/-- Pointwise supremum of two monotone functions is a monotone function. -/
protected theorem sup [Preorder α] [SemilatticeSup β] {f g : α → β} (hf : Antitone f)
    (hg : Antitone g) :
    Antitone (f ⊔ g) := fun _ _ h => sup_le_sup (hf h) (hg h)
#align antitone.sup Antitone.sup

/-- Pointwise infimum of two monotone functions is a monotone function. -/
protected theorem inf [Preorder α] [SemilatticeInf β] {f g : α → β} (hf : Antitone f)
    (hg : Antitone g) :
    Antitone (f ⊓ g) := fun _ _ h => inf_le_inf (hf h) (hg h)
#align antitone.inf Antitone.inf

/-- Pointwise maximum of two monotone functions is a monotone function. -/
protected theorem max [Preorder α] [LinearOrder β] {f g : α → β} (hf : Antitone f)
    (hg : Antitone g) :
    Antitone fun x => max (f x) (g x) :=
  hf.sup hg
#align antitone.max Antitone.max

/-- Pointwise minimum of two monotone functions is a monotone function. -/
protected theorem min [Preorder α] [LinearOrder β] {f g : α → β} (hf : Antitone f)
    (hg : Antitone g) :
    Antitone fun x => min (f x) (g x) :=
  hf.inf hg
#align antitone.min Antitone.min

theorem map_sup_le [SemilatticeSup α] [SemilatticeInf β] {f : α → β} (h : Antitone f) (x y : α) :
    f (x ⊔ y) ≤ f x ⊓ f y :=
  h.dual_right.le_map_sup x y
#align antitone.map_sup_le Antitone.map_sup_le

theorem le_map_inf [SemilatticeInf α] [SemilatticeSup β] {f : α → β} (h : Antitone f) (x y : α) :
    f x ⊔ f y ≤ f (x ⊓ y) :=
  h.dual_right.map_inf_le x y
#align antitone.le_map_inf Antitone.le_map_inf

variable [LinearOrder α]

theorem map_sup [SemilatticeInf β] {f : α → β} (hf : Antitone f) (x y : α) :
    f (x ⊔ y) = f x ⊓ f y :=
  hf.dual_right.map_sup x y
#align antitone.map_sup Antitone.map_sup

theorem map_inf [SemilatticeSup β] {f : α → β} (hf : Antitone f) (x y : α) :
    f (x ⊓ y) = f x ⊔ f y :=
  hf.dual_right.map_inf x y
#align antitone.map_inf Antitone.map_inf

end Antitone

namespace AntitoneOn

/-- Pointwise supremum of two antitone functions is a antitone function. -/
protected theorem sup [Preorder α] [SemilatticeSup β] {f g : α → β} {s : Set α}
    (hf : AntitoneOn f s) (hg : AntitoneOn g s) : AntitoneOn (f ⊔ g) s :=
  fun _ hx _ hy h => sup_le_sup (hf hx hy h) (hg hx hy h)
#align antitone_on.sup AntitoneOn.sup

/-- Pointwise infimum of two antitone functions is a antitone function. -/
protected theorem inf [Preorder α] [SemilatticeInf β] {f g : α → β} {s : Set α}
    (hf : AntitoneOn f s) (hg : AntitoneOn g s) : AntitoneOn (f ⊓ g) s :=
  (hf.dual.sup hg.dual).dual
#align antitone_on.inf AntitoneOn.inf

/-- Pointwise maximum of two antitone functions is a antitone function. -/
protected theorem max [Preorder α] [LinearOrder β] {f g : α → β} {s : Set α} (hf : AntitoneOn f s)
    (hg : AntitoneOn g s) : AntitoneOn (fun x => max (f x) (g x)) s :=
  hf.sup hg
#align antitone_on.max AntitoneOn.max

/-- Pointwise minimum of two antitone functions is a antitone function. -/
protected theorem min [Preorder α] [LinearOrder β] {f g : α → β} {s : Set α} (hf : AntitoneOn f s)
    (hg : AntitoneOn g s) : AntitoneOn (fun x => min (f x) (g x)) s :=
  hf.inf hg
#align antitone_on.min AntitoneOn.min

end AntitoneOn

/-!
### Products of (semi-)lattices
-/

namespace Prod

variable (α β)

instance [Sup α] [Sup β] : Sup (α × β) :=
  ⟨fun p q => ⟨p.1 ⊔ q.1, p.2 ⊔ q.2⟩⟩

instance [Inf α] [Inf β] : Inf (α × β) :=
  ⟨fun p q => ⟨p.1 ⊓ q.1, p.2 ⊓ q.2⟩⟩

@[simp]
theorem mk_sup_mk [Sup α] [Sup β] (a₁ a₂ : α) (b₁ b₂ : β) :
    (a₁, b₁) ⊔ (a₂, b₂) = (a₁ ⊔ a₂, b₁ ⊔ b₂) :=
  rfl
#align prod.mk_sup_mk Prod.mk_sup_mk

@[simp]
theorem mk_inf_mk [Inf α] [Inf β] (a₁ a₂ : α) (b₁ b₂ : β) :
    (a₁, b₁) ⊓ (a₂, b₂) = (a₁ ⊓ a₂, b₁ ⊓ b₂) :=
  rfl
#align prod.mk_inf_mk Prod.mk_inf_mk

@[simp]
theorem fst_sup [Sup α] [Sup β] (p q : α × β) : (p ⊔ q).fst = p.fst ⊔ q.fst :=
  rfl
#align prod.fst_sup Prod.fst_sup

@[simp]
theorem fst_inf [Inf α] [Inf β] (p q : α × β) : (p ⊓ q).fst = p.fst ⊓ q.fst :=
  rfl
#align prod.fst_inf Prod.fst_inf

@[simp]
theorem snd_sup [Sup α] [Sup β] (p q : α × β) : (p ⊔ q).snd = p.snd ⊔ q.snd :=
  rfl
#align prod.snd_sup Prod.snd_sup

@[simp]
theorem snd_inf [Inf α] [Inf β] (p q : α × β) : (p ⊓ q).snd = p.snd ⊓ q.snd :=
  rfl
#align prod.snd_inf Prod.snd_inf

@[simp]
theorem swap_sup [Sup α] [Sup β] (p q : α × β) : (p ⊔ q).swap = p.swap ⊔ q.swap :=
  rfl
#align prod.swap_sup Prod.swap_sup

@[simp]
theorem swap_inf [Inf α] [Inf β] (p q : α × β) : (p ⊓ q).swap = p.swap ⊓ q.swap :=
  rfl
#align prod.swap_inf Prod.swap_inf

theorem sup_def [Sup α] [Sup β] (p q : α × β) : p ⊔ q = (p.fst ⊔ q.fst, p.snd ⊔ q.snd) :=
  rfl
#align prod.sup_def Prod.sup_def

theorem inf_def [Inf α] [Inf β] (p q : α × β) : p ⊓ q = (p.fst ⊓ q.fst, p.snd ⊓ q.snd) :=
  rfl
#align prod.inf_def Prod.inf_def

instance semilatticeSup [SemilatticeSup α] [SemilatticeSup β] : SemilatticeSup (α × β) where
  __ := inferInstanceAs (PartialOrder (α × β))
  __ := inferInstanceAs (Sup (α × β))
  sup_le _ _ _ h₁ h₂ := ⟨sup_le h₁.1 h₂.1, sup_le h₁.2 h₂.2⟩
  le_sup_left _ _ := ⟨le_sup_left, le_sup_left⟩
  le_sup_right _ _ := ⟨le_sup_right, le_sup_right⟩

instance semilatticeInf [SemilatticeInf α] [SemilatticeInf β] : SemilatticeInf (α × β) where
  __ := inferInstanceAs (PartialOrder (α × β))
  __ := inferInstanceAs (Inf (α × β))
  le_inf _ _ _ h₁ h₂ := ⟨le_inf h₁.1 h₂.1, le_inf h₁.2 h₂.2⟩
  inf_le_left _ _ := ⟨inf_le_left, inf_le_left⟩
  inf_le_right _ _ := ⟨inf_le_right, inf_le_right⟩

instance lattice [Lattice α] [Lattice β] : Lattice (α × β) where
  __ := inferInstanceAs (SemilatticeSup (α × β))
  __ := inferInstanceAs (SemilatticeInf (α × β))

instance distribLattice [DistribLattice α] [DistribLattice β] : DistribLattice (α × β) where
  __ := inferInstanceAs (Lattice (α × β))
  le_sup_inf _ _ _ := ⟨le_sup_inf, le_sup_inf⟩

end Prod

/-!
### Subtypes of (semi-)lattices
-/

namespace Subtype

/-- A subtype forms a `⊔`-semilattice if `⊔` preserves the property.
See note [reducible non-instances]. -/
@[reducible]
protected def semilatticeSup [SemilatticeSup α] {P : α → Prop}
    (Psup : ∀ ⦃x y⦄, P x → P y → P (x ⊔ y)) :
    SemilatticeSup { x : α // P x } :=
  { inferInstanceAs (PartialOrder (Subtype P)) with
    sup := fun x y => ⟨x.1 ⊔ y.1, Psup x.2 y.2⟩,
    le_sup_left := fun _ _ => le_sup_left,
    le_sup_right := fun _ _ => le_sup_right,
    sup_le := fun _ _ _ h1 h2 => sup_le h1 h2 }
#align subtype.semilattice_sup Subtype.semilatticeSup

/-- A subtype forms a `⊓`-semilattice if `⊓` preserves the property.
See note [reducible non-instances]. -/
@[reducible]
protected def semilatticeInf [SemilatticeInf α] {P : α → Prop}
    (Pinf : ∀ ⦃x y⦄, P x → P y → P (x ⊓ y)) :
    SemilatticeInf { x : α // P x } :=
  { inferInstanceAs (PartialOrder (Subtype P)) with
    inf := fun x y => ⟨x.1 ⊓ y.1, Pinf x.2 y.2⟩,
    inf_le_left := fun _ _ => inf_le_left,
    inf_le_right := fun _ _ => inf_le_right,
    le_inf := fun _ _ _ h1 h2 => le_inf h1 h2 }
#align subtype.semilattice_inf Subtype.semilatticeInf

/-- A subtype forms a lattice if `⊔` and `⊓` preserve the property.
See note [reducible non-instances]. -/
@[reducible]
protected def lattice [Lattice α] {P : α → Prop} (Psup : ∀ ⦃x y⦄, P x → P y → P (x ⊔ y))
    (Pinf : ∀ ⦃x y⦄, P x → P y → P (x ⊓ y)) : Lattice { x : α // P x } :=
  { Subtype.semilatticeInf Pinf, Subtype.semilatticeSup Psup with }
#align subtype.lattice Subtype.lattice

@[simp, norm_cast]
theorem coe_sup [SemilatticeSup α] {P : α → Prop}
    (Psup : ∀ ⦃x y⦄, P x → P y → P (x ⊔ y)) (x y : Subtype P) :
    (haveI := Subtype.semilatticeSup Psup; (x ⊔ y : Subtype P) : α) = (x ⊔ y : α) :=
  rfl
#align subtype.coe_sup Subtype.coe_sup

@[simp, norm_cast]
theorem coe_inf [SemilatticeInf α] {P : α → Prop}
    (Pinf : ∀ ⦃x y⦄, P x → P y → P (x ⊓ y)) (x y : Subtype P) :
    (haveI := Subtype.semilatticeInf Pinf; (x ⊓ y : Subtype P) : α) = (x ⊓ y : α) :=
  rfl
#align subtype.coe_inf Subtype.coe_inf

@[simp]
theorem mk_sup_mk [SemilatticeSup α] {P : α → Prop}
    (Psup : ∀ ⦃x y⦄, P x → P y → P (x ⊔ y)) {x y : α} (hx : P x) (hy : P y) :
    (haveI := Subtype.semilatticeSup Psup; (⟨x, hx⟩ ⊔ ⟨y, hy⟩ : Subtype P)) =
      ⟨x ⊔ y, Psup hx hy⟩ :=
  rfl
#align subtype.mk_sup_mk Subtype.mk_sup_mk

@[simp]
theorem mk_inf_mk [SemilatticeInf α] {P : α → Prop}
    (Pinf : ∀ ⦃x y⦄, P x → P y → P (x ⊓ y)) {x y : α} (hx : P x) (hy : P y) :
    (haveI := Subtype.semilatticeInf Pinf; (⟨x, hx⟩ ⊓ ⟨y, hy⟩ : Subtype P)) =
      ⟨x ⊓ y, Pinf hx hy⟩ :=
  rfl
#align subtype.mk_inf_mk Subtype.mk_inf_mk

end Subtype

section lift

/-- A type endowed with `⊔` is a `SemilatticeSup`, if it admits an injective map that
preserves `⊔` to a `SemilatticeSup`.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.semilatticeSup [Sup α] [SemilatticeSup β] (f : α → β)
    (hf_inj : Function.Injective f) (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) : SemilatticeSup α :=
  { PartialOrder.lift f hf_inj with
    sup := Sup.sup,
    le_sup_left := fun a b => by
      change f a ≤ f (a ⊔ b)
      rw [map_sup]
      exact le_sup_left,
    le_sup_right := fun a b => by
      change f b ≤ f (a ⊔ b)
      rw [map_sup]
      exact le_sup_right,
    sup_le := fun a b c ha hb => by
      change f (a ⊔ b) ≤ f c
      rw [map_sup]
      exact sup_le ha hb }
#align function.injective.semilattice_sup Function.Injective.semilatticeSup

/-- A type endowed with `⊓` is a `SemilatticeInf`, if it admits an injective map that
preserves `⊓` to a `SemilatticeInf`.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.semilatticeInf [Inf α] [SemilatticeInf β] (f : α → β)
    (hf_inj : Function.Injective f) (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) : SemilatticeInf α :=
  { PartialOrder.lift f hf_inj with
    inf := Inf.inf,
    inf_le_left := fun a b => by
      change f (a ⊓ b) ≤ f a
      rw [map_inf]
      exact inf_le_left,
    inf_le_right := fun a b => by
      change f (a ⊓ b) ≤ f b
      rw [map_inf]
      exact inf_le_right,
    le_inf := fun a b c ha hb => by
      change f a ≤ f (b ⊓ c)
      rw [map_inf]
      exact le_inf ha hb }
#align function.injective.semilattice_inf Function.Injective.semilatticeInf

/-- A type endowed with `⊔` and `⊓` is a `Lattice`, if it admits an injective map that
preserves `⊔` and `⊓` to a `Lattice`.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.lattice [Sup α] [Inf α] [Lattice β] (f : α → β)
    (hf_inj : Function.Injective f)
    (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) : Lattice α :=
  { hf_inj.semilatticeSup f map_sup, hf_inj.semilatticeInf f map_inf with }
#align function.injective.lattice Function.Injective.lattice

/-- A type endowed with `⊔` and `⊓` is a `DistribLattice`, if it admits an injective map that
preserves `⊔` and `⊓` to a `DistribLattice`.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.distribLattice [Sup α] [Inf α] [DistribLattice β] (f : α → β)
    (hf_inj : Function.Injective f) (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b)
    (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) :
    DistribLattice α :=
  { hf_inj.lattice f map_sup map_inf with
    le_sup_inf := fun a b c => by
      change f ((a ⊔ b) ⊓ (a ⊔ c)) ≤ f (a ⊔ b ⊓ c)
      rw [map_inf, map_sup, map_sup, map_sup, map_inf]
      exact le_sup_inf }
#align function.injective.distrib_lattice Function.Injective.distribLattice

end lift

--To avoid noncomputability poisoning from `Bool.completeBooleanAlgebra`
instance : DistribLattice Bool :=
  inferInstance


import ..myint.le

namespace hidden

open myint
open myring
open ordered_myring
open ordered_integral_domain

structure frac :=
-- Numerator
(num : myint)
-- Denominator
(denom : myint)
-- Proof that the denominator is positive
(denom_pos : 0 < denom)

namespace frac

variables {x y z : frac}

theorem num_and_denom_eq : x = y ↔ x.num = y.num ∧ x.denom = y.denom :=
begin
  split; assume h, {
    split; rw h,
  }, {
    cases x,
    cases y,
    cc,
  },
end

def frac_eq (x y: frac): Prop :=
x.num * y.denom = y.num * x.denom

private theorem frac_eq_refl: reflexive frac_eq :=
begin
  intro x,
  unfold frac_eq,
end

private theorem frac_eq_symm: symmetric frac_eq :=
begin
  intros x y,
  assume h,
  from h.symm,
end

private theorem frac_eq_trans: transitive frac_eq :=
begin
  intros x y z,
  assume hxy hyz,
  unfold frac_eq at hxy hyz,
  unfold frac_eq,
  have h := congr_arg (λ x : myint, x * z.denom) hxy,
  dsimp only [] at h,
  rw [mul_assoc y.num, mul_comm x.denom, ←mul_assoc y.num, hyz] at h,
  suffices : y.denom * (x.num * z.denom) = y.denom * (z.num * x.denom),
    from integral_domain.mul_cancel_left _ _ _ (lt_impl_ne y.denom_pos).symm this,
  rw [←mul_assoc, mul_comm y.denom, h],
  ac_refl,
end

instance frac.setoid : setoid frac :=
⟨frac_eq, ⟨frac_eq_refl, frac_eq_symm, frac_eq_trans⟩⟩

theorem setoid_equiv (x y : frac) :
x ≈ y ↔ x.num * y.denom = y.num * x.denom := iff.rfl

theorem sound_exact_iff (x y: frac):
⟦x⟧ = ⟦y⟧ ↔ x ≈ y := iff.intro quotient.exact quotient.sound

instance decidable_frac_eq: ∀ a b: frac, decidable (a ≈ b) :=
begin
  intros a b,
  rw setoid_equiv,
  from myint.decidable_eq _ _,
end

def neg (x : frac) : frac :=
⟨-x.num, x.denom, x.denom_pos⟩

instance: has_neg frac := ⟨neg⟩

theorem neg_num {x : frac} :
(-x).num = -x.num := rfl

theorem neg_denom {x : frac} :
(-x).denom = x.denom := rfl

theorem frac_neg_neg {x: frac}: -x = neg x := rfl

theorem neg_well_defined (x y : frac) :
x ≈ y → ⟦-x⟧ = ⟦-y⟧ :=
begin
  assume h,
  apply quotient.sound,
  rw setoid_equiv,
  repeat { rw neg_num <|> rw neg_denom <|> rw neg_mul },
  rw ←neg_eq,
  rwa ←setoid_equiv,
end

def add (x y: frac) : frac :=
⟨x.num * y.denom + y.num * x.denom, x.denom * y.denom,
by from zero_lt_mul x.denom_pos y.denom_pos⟩

instance: has_add frac := ⟨add⟩

theorem frac_add_add (x y: frac): add x y = x + y := rfl

theorem add_num {x y : frac} :
(x + y).num = x.num * y.denom + y.num * x.denom := rfl

theorem add_denom {x y : frac} :
(x + y).denom = x.denom * y.denom := rfl

theorem add_well_defined (a x b y : frac) :
a ≈ b → x ≈ y → ⟦a + x⟧ = ⟦b + y⟧ :=
begin
  assume hab hxy,
  rw frac.setoid_equiv at hab hxy,
  apply quotient.sound,
  rw [setoid_equiv, add_num, add_num, add_denom, add_denom,
      add_mul, add_mul],
  -- State what we want ac_refl to do, then do it and rewrite
  have h₁ : x.num * a.denom * (b.denom * y.denom) =
            x.num * y.denom * a.denom * b.denom,
    ac_refl,
  rw [h₁, hxy],
  have h₂ : a.num * x.denom * (b.denom * y.denom) =
            a.num * b.denom * x.denom * y.denom,
    ac_refl,
  rw [h₂, hab],
  ac_refl,
end

def mul (x y : frac) : frac :=
⟨x.num * y.num, x.denom * y.denom,
by from zero_lt_mul x.denom_pos y.denom_pos⟩

instance: has_mul frac := ⟨mul⟩

theorem mul_num {x y : frac} :
(x * y).num = x.num * y.num := rfl

theorem mul_denom {x y : frac} :
(x * y).denom = x.denom * y.denom := rfl

theorem mul_well_defined (a x b y : frac) :
a ≈ b → x ≈ y → ⟦a * x⟧ = ⟦b * y⟧ :=
begin
  assume hab hxy,
  rw setoid_equiv at hab hxy,
  apply quotient.sound,
  rw [setoid_equiv, mul_num, mul_num, mul_denom, mul_denom],
  -- State what we want ac_refl to do, then do it and rewrite
  have h₁ : a.num * x.num * (b.denom * y.denom) =
            x.num * y.denom * a.num * b.denom,
    ac_refl,
  rw [h₁, hxy],
  have h₂ : b.num * y.num * (a.denom * x.denom) =
            b.num * a.denom * x.denom * y.num,
    ac_refl,
  rw [h₂, ←hab],
  ac_refl,
end

private lemma one_pos: (0: myint) < 1 := nontrivial_zero_lt_one myint.nontrivial

-- Reciprocal of zero is zero
-- This has to be an if, because 0 is a different case
def inv (x: frac): frac :=
if h : x.num = 0 then ⟨0, 1, one_pos⟩ else
⟨(sign x.num) * x.denom, (sign x.num) * x.num,
  zero_lt_sign_mul_self _ h⟩

instance: has_inv frac := ⟨inv⟩

private theorem inv_ite {x : frac} : x⁻¹ = dite (x.num = 0) (λ (h : x.num = 0), ⟨0, 1, one_pos⟩)
    (λ (h : ¬x.num = 0),⟨(sign x.num) * x.denom, (sign x.num) * x.num, zero_lt_sign_mul_self _ h⟩)
:= rfl

theorem inv_zero {x : frac} (h : x.num = 0) : x⁻¹ = ⟨0, 1, one_pos⟩ :=
by rw [inv_ite, dif_pos h]

theorem inv_num_nonzero {x : frac} (h : x.num ≠ 0) :
x⁻¹.num = (sign x.num) * x.denom :=
by rw [inv_ite, dif_neg h]

theorem inv_denom_nonzero {x : frac} (h : x.num ≠ 0) :
x⁻¹.denom = (sign x.num) * x.num :=
by rw [inv_ite, dif_neg h]

theorem inv_well_defined (x y : frac) :
x ≈ y → ⟦x⁻¹⟧ = ⟦y⁻¹⟧ :=
begin
  assume hxy,
  rw setoid_equiv at hxy,
  apply quotient.sound,
  rw setoid_equiv,
  by_cases x.num = 0, {
    rw [h, zero_mul] at hxy,
    have hzero := integral_domain.mul_integral hxy.symm,
    cases hzero, {
      rw [inv_zero h, inv_zero hzero],
    }, {
      exfalso, from (lt_impl_ne x.denom_pos) hzero.symm,
    },
  }, {
    have hydn0 : y.denom ≠ 0,
      from (lt_impl_ne y.denom_pos).symm,
    have hlhsn0 : x.num * y.denom ≠ 0,
      assume hz,
      cases integral_domain.mul_integral hz; contradiction,
    have : y.num ≠ 0,
      rw hxy at hlhsn0,
      assume hy0,
      rw hy0 at hlhsn0,
      rw zero_mul at hlhsn0,
      contradiction,
    rw [inv_denom_nonzero h, inv_num_nonzero h],
    rw [inv_denom_nonzero this, inv_num_nonzero this],
    have h₁ : sign x.num * x.denom * (sign y.num * y.num) =
      sign x.num * sign y.num * (y.num * x.denom),
      ac_refl,
    rw [h₁, ←hxy],
    ac_refl,
  },
end

end frac

end hidden


import tuto_lib
/-
This file continues the elementary study of limits of sequences.
It can be skipped if the previous file was too easy, it won't introduce
any new tactic or trick.

Remember useful lemmas:

abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub_comm (x y : ℝ) : |x - y| = |y - x|

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

and the definition:

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

You can also use a property proved in the previous file:

unique_limit : seq_limit u l → seq_limit u l' → l = l'

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m
-/

variable { φ : ℕ → ℕ}

/-
The next lemma is proved by an easy induction, but we haven't seen induction
in this tutorial. If you did the natural number game then you can delete
the proof below and try to reconstruct it.
-/
/-- An extraction is greater than id -/
lemma id_le_extraction' : extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

/-- Extractions take arbitrarily large values for arbitrarily large
inputs. -/
-- 0039
lemma extraction_ge : extraction φ → ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  intros hyp N N',
  induction N' with N' hN',
  induction N with d hd,
  use 0, split, linarith, exact nat.zero_le _,
  cases hd with n hn,
  cases hn with H hn, use (n+1),
  split, linarith, have key := hyp n (n+1) (by linarith),
  rw (show nat.succ d = d+1, by refl), linarith,
  cases hN' with K hN',
  cases hN' with H hN',
  use (K+1), split, rw (show nat.succ N' = N'+1, by refl),
  linarith,
  have key := hyp (K) (K+1) (by linarith),
  linarith,
end

/-- A real number `a` is a cluster point of a sequence `u`
if `u` has a subsequence converging to `a`.

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a
-/

variables {u : ℕ → ℝ} {a l : ℝ}

/-
In the exercise, we use `∃ n ≥ N, ...` which is the abbreviation of
`∃ n, n ≥ N ∧ ...`.
Lean can read this abbreviation, but displays it as the confusing:
`∃ (n : ℕ) (H : n ≥ N)`
One gets used to it. Alternatively, one can get rid of it using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q
-/

/-- If `a` is a cluster point of `u` then there are values of
`u` arbitrarily close to `a` for arbitrarily large input. -/
-- 0040
lemma near_cluster :
  cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  intro h, cases h with φ h, cases h with h h',
  intros ε ε_pos N,
  specialize h' ε ε_pos, cases h' with N' hN',
  have j := extraction_ge h N N', cases j with n j, cases j with H j,
  use φ n, split, exact j, specialize hN' n H, exact hN',
end

/-
The above exercice can be done in five lines.
Hint: you can use the anonymous constructor syntax when proving
existential statements.
-/

/-- If `u` tends to `l` then its subsequences tend to `l`. -/
-- 0041
lemma subseq_tendsto_of_tendsto' (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N, intros n H,
  exact hN (φ n) (by linarith[id_le_extraction hφ n]),
end

/-- If `u` tends to `l` all its cluster points are equal to `l`. -/
-- 0042
lemma cluster_limit (hl : seq_limit u l) (ha : cluster_point u a) : a = l :=
begin
  cases ha with φ ha,
  cases ha with hext hlim,
  have j := subseq_tendsto_of_tendsto' hl hext,
  exact unique_limit hlim j,
end

/-- Cauchy_sequence sequence -/
def cauchy_sequence (u : ℕ → ℝ) := ∀ ε > 0, ∃ N, ∀ p q, p ≥ N → q ≥ N → |u p - u q| ≤ ε

-- 0043
example : (∃ l, seq_limit u l) → cauchy_sequence u :=
begin
  intros h ε ε_pos, cases h with l h, specialize h (ε/2) (by linarith),
  cases h with N hN, use N, intros p q pN qN,
  have pin := hN p pN, have qin := hN q qN, rw abs_sub_comm (u q) l at qin,
  calc |u p - u q| = |(u p - l) + (l - u q)|   : by ring_nf
               ... ≤ |u p - l| + |l - u q| : by apply abs_add
               ... ≤ ε                     : by linarith,
end

/-
In the next exercise, you can reuse
 near_cluster : cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε
-/
-- 0044
example (hu : cauchy_sequence u) (hl : cluster_point u l) : seq_limit u l :=
begin
  intros ε ε_pos, have j:= near_cluster hl, specialize j (ε/2) (by linarith),
  specialize hu (ε/2) (by linarith), cases hu with N hu, specialize j N,
  cases j with N' H, cases H with H j, use N', intros n hn,
  specialize hu n N' (by linarith) (by linarith),
  calc |u n - l| = |(u n - u N') + (u N' - l)| : by ring_nf
             ... ≤ |u n - u N'| + |u N' - l|   : by apply abs_add
             ... ≤ ε                           : by linarith,
end


import Mathlib.Data.Real.Basic
import Mathlib.Algebra.Order.AbsoluteValue

def Real.openBall (center : ℝ) (radius : ℝ) := { x : ℝ | |x - center| < radius }

def Real.closedBall (center : ℝ) (radius : ℝ) := { x : ℝ | |x - center| ≤ radius }

def Real.sphere (center : ℝ) (radius : ℝ) := { x : ℝ | |x - center| = radius }

def Set.interior (s : Set ℝ) := { c : ℝ | ∃ r > 0, c.openBall r ⊆ s }

def Set.IsOpen (s : Set ℝ) := s ⊆ s.interior

def Set.closure (s : Set ℝ) := { c : ℝ | ∀ r > 0, (c.openBall r ∩ s).Nonempty }

def Set.IsClosed (s : Set ℝ) := s.closure ⊆ s

def Real.neighborhood (x : ℝ) := { s : Set ℝ | x ∈ s.interior }

def Set.clusterPoint (s : Set ℝ) := { x : ℝ | x ∈ (s \ {x}).closure }

def Set.isolatedPoint (s : Set ℝ) := { x ∈ s | x ∉ (s \ {x}).closure }

theorem Set.interior_compl (s : Set ℝ) : s.interiorᶜ = sᶜ.closure := by
  ext c
  show (¬∃ _, _) ↔ ∀ _, _
  push_neg
  rw [forall_congr']
  intro x
  rw [imp_congr_right]
  intro _
  rw [not_subset]
  rfl

theorem Set.isOpen_iff_compl_isClosed {s : Set ℝ} : s.IsOpen ↔ sᶜ.IsClosed := by
  dsimp [IsOpen, IsClosed]
  rw [←compl_subset_compl]
  rw [interior_compl]

def Function.TendsTo (f : ℝ → ℝ) (a : ℝ) (l : ℝ) :=
  ∀ V ∈ l.neighborhood, ∃ U ∈ a.neighborhood, U.image f ⊆ V

theorem Set.IsOpen.eq_union_openBall {s : Set ℝ} (hs : s.IsOpen)
  : ∃ I : Type, ∃ c : I → ℝ, ∃ r : I → ℝ, s = ⋃ i, (c i).openBall (r i) :=
  show ∃ I c r, s = {x | ∃ t, (∃ i, _) ∧ _} from
  ⟨{ x : ℝ // x ∈ s }, λ ⟨x, hx⟩ => x, λ ⟨x, hx⟩ => (hs hx).choose,
  ext λ x => ⟨
    λ hx =>
    let r := (hs hx).choose
    ⟨x.openBall r, ⟨⟨⟨x, hx⟩, rfl⟩, sorry⟩⟩
    ,
    by
    dsimp
    exact
    sorry⟩
  ⟩

namespace Analysis
namespace Topology

section
end

end Topology
end Analysis


import tactic
import data.real.irrational

/-- Between any two different real numbers there is a rational
number and an irrational number. -/
lemma exercise : ∀ {a b : ℝ} (hab : a < b), (∃ (x : ℚ), a < x ∧ ↑x < b) ∧ (∃ (y : ℝ) (hy : irrational y), a < y ∧ y < b) := begin
  sorry
end


example : ∃ P Q : Prop, (P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) :=
begin
    apply exists.intro false,
    apply exists.intro true,
    split,
        show false ∨ true, from or.inr true.intro,
        split,
            show ¬false ∨ ¬true,
            apply or.inl,
            assume f, assumption,
            show ¬false ∨ true, from or.inr true.intro,
end

example : ¬ ∃ P Q : Prop, (P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) ∧ (¬Q) :=
begin
    assume h,
    apply exists.elim h,
    intros,
    apply exists.elim a_1,
    intros,
    have na2 : ¬a_2 := a_3.2.2.2,

    cases a_3.1 with pfa pfa_2,
    cases a_3.2.1 with pfna pfna_2,
        exact pfna pfa,
    cases a_3.2.2.1 with pfna pfa_2,
        exact pfna pfa,
        exact na2 pfa_2,
        exact na2 pfa_2,
end

example : ∃ P Q R : Prop,(P ∨ Q ∨ R) ∧ (¬P ∨ ¬Q ∨ ¬R) ∧ (¬P ∨ Q ∨ R) ∧ (¬Q ∨ ¬R)
:=
begin
    apply exists.intro true,
    apply exists.intro true,
    apply exists.intro false,
    split,
        exact or.inl true.intro,
        split,
            apply or.inr,
            apply or.inr,
            assume f, assumption,

            split,
                apply or.inr,
                apply or.inl,
                exact true.intro,

                apply or.inr,
                assume f, assumption
end