/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module ring_theory.eisenstein_criterion
! leanprover-community/mathlib commit da420a8c6dd5bdfb85c4ced85c34388f633bc6ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Cast.WithTop
import Mathbin.RingTheory.Prime
import Mathbin.RingTheory.Polynomial.Content
import Mathbin.RingTheory.Ideal.QuotientOperations

/-!
# Eisenstein's criterion

A proof of a slight generalisation of Eisenstein's criterion for the irreducibility of
a polynomial over an integral domain.
-/

open Polynomial Ideal.Quotient

variable {R : Type _} [CommRing R]

namespace Polynomial

open Polynomial

namespace EisensteinCriterionAux

-- Section for auxiliary lemmas used in the proof of `irreducible_of_eisenstein_criterion`
theorem map_eq_c_mul_x_pow_of_forall_coeff_mem {f : R[X]} {P : Ideal R}
    (hfP : ∀ n : ℕ, ↑n < f.degree → f.coeff n ∈ P) :
    map (mk P) f = C ((mk P) f.leadingCoeff) * X ^ f.natDegree :=
  Polynomial.ext fun n => by
    by_cases hf0 : f = 0; · simp [hf0]
    rcases lt_trichotomy (↑n) (degree f) with (h | h | h)
    · erw [coeff_map, eq_zero_iff_mem.2 (hfP n h), coeff_C_mul, coeff_X_pow, if_neg,
        MulZeroClass.mul_zero]
      rintro rfl
      exact not_lt_of_ge degree_le_nat_degree h
    · have : nat_degree f = n := nat_degree_eq_of_degree_eq_some h.symm
      rw [coeff_C_mul, coeff_X_pow, if_pos this.symm, mul_one, leading_coeff, this, coeff_map]
    · rw [coeff_eq_zero_of_degree_lt, coeff_eq_zero_of_degree_lt]
      · refine' lt_of_le_of_lt (degree_C_mul_X_pow_le _ _) _
        rwa [← degree_eq_nat_degree hf0]
      · exact lt_of_le_of_lt (degree_map_le _ _) h
#align polynomial.eisenstein_criterion_aux.map_eq_C_mul_X_pow_of_forall_coeff_mem Polynomial.EisensteinCriterionAux.map_eq_c_mul_x_pow_of_forall_coeff_mem

theorem le_natDegree_of_map_eq_mul_x_pow {n : ℕ} {P : Ideal R} (hP : P.IsPrime) {q : R[X]}
    {c : Polynomial (R ⧸ P)} (hq : map (mk P) q = c * X ^ n) (hc0 : c.degree = 0) :
    n ≤ q.natDegree :=
  WithBot.coe_le_coe.1
    (calc
      ↑n = degree (q.map (mk P)) := by
        rw [hq, degree_mul, hc0, zero_add, degree_pow, degree_X, nsmul_one, Nat.cast_withBot]
      _ ≤ degree q := (degree_map_le _ _)
      _ ≤ natDegree q := degree_le_natDegree
      )
#align polynomial.eisenstein_criterion_aux.le_nat_degree_of_map_eq_mul_X_pow Polynomial.EisensteinCriterionAux.le_natDegree_of_map_eq_mul_x_pow

theorem eval_zero_mem_ideal_of_eq_mul_x_pow {n : ℕ} {P : Ideal R} {q : R[X]}
    {c : Polynomial (R ⧸ P)} (hq : map (mk P) q = c * X ^ n) (hn0 : 0 < n) : eval 0 q ∈ P := by
  rw [← coeff_zero_eq_eval_zero, ← eq_zero_iff_mem, ← coeff_map, coeff_zero_eq_eval_zero, hq,
    eval_mul, eval_pow, eval_X, zero_pow hn0, MulZeroClass.mul_zero]
#align polynomial.eisenstein_criterion_aux.eval_zero_mem_ideal_of_eq_mul_X_pow Polynomial.EisensteinCriterionAux.eval_zero_mem_ideal_of_eq_mul_x_pow

theorem isUnit_of_natDegree_eq_zero_of_forall_dvd_isUnit {p q : R[X]}
    (hu : ∀ x : R, C x ∣ p * q → IsUnit x) (hpm : p.natDegree = 0) : IsUnit p :=
  by
  rw [eq_C_of_degree_le_zero (nat_degree_eq_zero_iff_degree_le_zero.1 hpm), is_unit_C]
  refine' hu _ _
  rw [← eq_C_of_degree_le_zero (nat_degree_eq_zero_iff_degree_le_zero.1 hpm)]
  exact dvd_mul_right _ _
#align polynomial.eisenstein_criterion_aux.is_unit_of_nat_degree_eq_zero_of_forall_dvd_is_unit Polynomial.EisensteinCriterionAux.isUnit_of_natDegree_eq_zero_of_forall_dvd_isUnit

end EisensteinCriterionAux

open EisensteinCriterionAux

variable [IsDomain R]

/-- If `f` is a non constant polynomial with coefficients in `R`, and `P` is a prime ideal in `R`,
then if every coefficient in `R` except the leading coefficient is in `P`, and
the trailing coefficient is not in `P^2` and no non units in `R` divide `f`, then `f` is
irreducible. -/
theorem irreducible_of_eisenstein_criterion {f : R[X]} {P : Ideal R} (hP : P.IsPrime)
    (hfl : f.leadingCoeff ∉ P) (hfP : ∀ n : ℕ, ↑n < degree f → f.coeff n ∈ P) (hfd0 : 0 < degree f)
    (h0 : f.coeff 0 ∉ P ^ 2) (hu : f.IsPrimitive) : Irreducible f :=
  have hf0 : f ≠ 0 := fun _ => by simp_all only [not_true, Submodule.zero_mem, coeff_zero]
  have hf : f.map (mk P) = C (mk P (leadingCoeff f)) * X ^ natDegree f :=
    map_eq_c_mul_x_pow_of_forall_coeff_mem hfP
  have hfd0 : 0 < f.natDegree := WithBot.coe_lt_coe.1 (lt_of_lt_of_le hfd0 degree_le_natDegree)
  ⟨mt degree_eq_zero_of_isUnit fun h => by simp_all only [lt_irrefl],
    by
    rintro p q rfl
    rw [Polynomial.map_mul] at hf
    rcases mul_eq_mul_prime_pow
        (show Prime (X : Polynomial (R ⧸ P)) from monic_X.prime_of_degree_eq_one degree_X) hf with
      ⟨m, n, b, c, hmnd, hbc, hp, hq⟩
    have hmn : 0 < m → 0 < n → False := by
      intro hm0 hn0
      refine' h0 _
      rw [coeff_zero_eq_eval_zero, eval_mul, sq]
      exact
        Ideal.mul_mem_mul (eval_zero_mem_ideal_of_eq_mul_X_pow hp hm0)
          (eval_zero_mem_ideal_of_eq_mul_X_pow hq hn0)
    have hpql0 : (mk P) (p * q).leadingCoeff ≠ 0 := by rwa [Ne.def, eq_zero_iff_mem]
    have hp0 : p ≠ 0 := fun h => by
      simp_all only [MulZeroClass.zero_mul, eq_self_iff_true, not_true, Ne.def]
    have hq0 : q ≠ 0 := fun h => by
      simp_all only [eq_self_iff_true, not_true, Ne.def, MulZeroClass.mul_zero]
    have hbc0 : degree b = 0 ∧ degree c = 0 :=
      by
      apply_fun degree  at hbc
      rwa [degree_C hpql0, degree_mul, eq_comm, Nat.WithBot.add_eq_zero_iff] at hbc
    have hmp : m ≤ nat_degree p := le_nat_degree_of_map_eq_mul_X_pow hP hp hbc0.1
    have hnq : n ≤ nat_degree q := le_nat_degree_of_map_eq_mul_X_pow hP hq hbc0.2
    have hpmqn : p.nat_degree = m ∧ q.nat_degree = n :=
      by
      rw [nat_degree_mul hp0 hq0] at hmnd
      clear * - hmnd hmp hnq
      contrapose hmnd
      apply ne_of_lt
      rw [not_and_or] at hmnd
      cases hmnd
      · exact add_lt_add_of_lt_of_le (lt_of_le_of_ne hmp (Ne.symm hmnd)) hnq
      · exact add_lt_add_of_le_of_lt hmp (lt_of_le_of_ne hnq (Ne.symm hmnd))
    obtain rfl | rfl : m = 0 ∨ n = 0 := by
      rwa [pos_iff_ne_zero, pos_iff_ne_zero, imp_false, Classical.not_not, ← or_iff_not_imp_left] at
        hmn
    · exact Or.inl (is_unit_of_nat_degree_eq_zero_of_forall_dvd_is_unit hu hpmqn.1)
    ·
      exact
        Or.inr
          (is_unit_of_nat_degree_eq_zero_of_forall_dvd_is_unit (by simpa only [mul_comm] using hu)
            hpmqn.2)⟩
#align polynomial.irreducible_of_eisenstein_criterion Polynomial.irreducible_of_eisenstein_criterion

end Polynomial


/-
Copyright (c) 2021 Yakov Pechersky All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import logic.equiv.basic
import tactic.norm_fin

/-!
# `norm_swap`

Evaluating `swap x y z` for numerals `x y z` that are `ℕ`, `ℤ`, or `ℚ`, via a `norm_num` plugin.
Terms are passed to `eval`, quickly failing if not of the form `swap x y z`.
The expressions for numerals `x y z` are converted to `nat`, and then compared.
Based on equality of these `nat`s, equality proofs are generated using either
`equiv.swap_apply_left`, `equiv.swap_apply_right`, or `swap_apply_of_ne_of_ne`.
-/

open equiv tactic expr

open norm_num

namespace norm_swap

/--
A `norm_num` plugin for normalizing `equiv.swap a b c`
where `a b c` are numerals of `ℕ`, `ℤ`, `ℚ` or `fin n`.

```
example : equiv.swap 1 2 1 = 2 := by norm_num
```
-/
@[norm_num] meta def eval : expr → tactic (expr × expr) := λ e, do
  (swapt, fun_ty, coe_fn_inst, fexpr, c) ← e.match_app_coe_fn
    <|> fail "did not get an app coe_fn expr",
  guard (fexpr.get_app_fn.const_name = ``equiv.swap) <|> fail "coe_fn not of equiv.swap",
  [α, deceq_inst, a, b] ← pure fexpr.get_app_args <|>
    fail "swap did not have exactly two args applied",
  na ← a.to_rat <|> (do (fa, _) ← norm_fin.eval_fin_num a, fa.to_rat),
  nb ← b.to_rat <|> (do (fb, _) ← norm_fin.eval_fin_num b, fb.to_rat),
  nc ← c.to_rat <|> (do (fc, _) ← norm_fin.eval_fin_num c, fc.to_rat),
  if nc = na then do
    p ← mk_mapp `equiv.swap_apply_left [α, deceq_inst, a, b],
    pure (b, p)
  else if nc = nb then do
    p ← mk_mapp `equiv.swap_apply_right [α, deceq_inst, a, b],
    pure (a, p)
  else do
    nic ← mk_instance_cache α,
    hca ← (prod.snd <$> prove_ne nic c a nc na) <|>
      (do (_, ff, p) ← norm_fin.prove_eq_ne_fin c a, pure p),
    hcb ← (prod.snd <$> prove_ne nic c b nc nb) <|>
      (do (_, ff, p) ← norm_fin.prove_eq_ne_fin c b, pure p),
    p ← mk_mapp `equiv.swap_apply_of_ne_of_ne [α, deceq_inst, a, b, c, hca, hcb],
    pure (c, p)

end norm_swap


/-
So far, all of the propositions that we've
seen are in the form of assertions about
equalities: 0 = 0, 1 = 1, 2 + 3 = 4, and so
on. And we've seen how to prove propositions
of this kind (that are actually true) using
eq.refl and rfl as a shorthand.

We are now about to set out to explore the
different forms of propositions that arise
in predicate logic.

In this unit, we meet the simplest of all
propositions, even simpler than equality
statements, namely the propositions that
in lean are called "true"  and "false".
First, true is the proposition that is
always trivially provable.
-/

/- The "true introduction" inference rule -/

/-
Here's the inference rule for true. Note
that it doesn't require an inputs/premises
at all. It is truly an axiom. Makes sense:
You can alway assume that the proposition
true is true.

  -------- (true.intro)
  pf: true

The true.intro inference rule is called
true.intro because it is an introduction
rule in the sense that it introduces a
true in the conclusion that wasn't in the
premises (of which there are none here).

Here then is a formal (mathematically
precise) and mechanically checked proof
of the proposition, true, in Lean.
-/

theorem t : true := true.intro
#check t
#reduce t

/-
We could of course have used tactics
as well.

EXERCISE prove t' : true using a
tactic script.
-/

lemma t' : true :=
begin
  apply true.intro
end

/-
That's it! Super easy.
-/

/-
There is no introduction rule for false!
-/

/-
Whereas true is trivially provable, the
proposition, false, has not proof and can
never be proved. Viewed as a type, it has
no values at all. It's what we call an
uninhabited type. Therefore there can be
no inference rule or sequence of rules
that derive a proof of false, because
such a thing simply does not exist! That
is after all the meaning of false: it is
not true, so there must be no proof of
it, otherwise it would be true, and
that would be a fatal contradiction.
-/

/-
The difference between tt/ff and the
propositions, true and false.
-/

/-
To clarify one major potential point of
confusion it's imperative to see that the
propositions, true and false, are not the
same as the boolean truth values, which
in Lean are called tt and ff. In some
other languages, they're called "true"
and "false", which really is a source of
possible confusion.
-/

/-
First, let's confirm that the types of
tt and ff are bool.
-/

#check tt
#check ff

/-
You will recall that we can assign
these values to variables of type bool
-/

def boolean_false := ff

#check boolean_false
#reduce boolean_false

/-
By contrast, we cannot assign the
value tt as a proof of true. It's not
even of the right type. Uncomment the
following line to see that this is the
case. Read the error message carefully.

EXERCISE: Read and explain the error
message to a colleague in your class.
-/

-- theorem bad : true := tt

/- * EX FALSO QUOD LIBET * -/

/-
Now we come to a very fundamental
concept in logic: from a contradiction,
you can derive a proof of any proposition
whatsoever. To put it in English terms,
if the impossible has happened, then
anything goes!

The inference rule for this says that
if you're given a proof of false, let's
call it f, and any proposition, P,
whatsoever (any value, P, of type
Prop!), then you can derive a proof
of P, and the false disappears from
the conclusion (which is why we call
this inference rule false elimination).

Here's the rule:

  P : Prop, f : false
  ------------------- false.elim
        pf : P

Note that the proposition argument,
P, is not to be given explicitly as
an argument to false.elim, but is to
be inferred from context, instead.
-/

/-
Let's see how this works in Lean.
Let's start by simply asserting as
an axiom, without proof, that f is
a proof of false.
-/

axiom f : false

/-
Well, it was probably a bad idea.
It just says, "trust me and accept
that the impossible just occurred."
The problem is that our logic is
now inconsistent and anything at
all can be proved. We just feed
our proof of false to false.elim
to prove any proposition at all.
Let's try to prove 0 = 1.
-/

theorem zeqo : 0 = 1 := false.elim f

/-
It will very occasionally be useful
to add an axiom to Lean, but one must
take extraordinary care to ensure that
it is consistent with the underlying
logic of lean. The axiom that there
is a proof of false immediately makes
the whole logic useful because it
collapses the distinction between
true and false entirely, and in this
case, any claim can be proven true,
and that would put us logically in
a post-truth work, which would be a
bad and useless place to be.
-/

/-
EXERCISE: Prove true = false (given
that we've assume there is a proof of
false).
-/

/-
As a final observation, we note that
there are some propositions that one
might think of as being false, and thus
provable from a contradiction, but that
we cannot even state in Lean. For
example, we can't even state the claim
that 1 = tt because Lean requires that
the types of the arguments on each side
of the = be the same.

EXERCISE: Try it. The error message that
appears is a little bit complicate but in
a nutshell it's saying "I can't find a way
to coerce/convert 1 into a bool, and so I
can't do anything with this expression."
In simple terms, the expression 1 = tt
has a type error. It's not even a well
formed expression.
-/


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl, Yuyang Zhao

! This file was ported from Lean 3 source module algebra.order.monoid.nat_cast
! leanprover-community/mathlib commit 07fee0ca54c320250c98bacf31ca5f288b2bcbe2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Monoid.Lemmas
import Mathlib.Algebra.Order.ZeroLEOne
import Mathlib.Data.Nat.Cast.Defs

/-!
# Order of numerals in an `AddMonoidWithOne`.
-/

variable {α : Type _}

open Function

lemma lt_add_one [One α] [AddZeroClass α] [PartialOrder α] [ZeroLEOneClass α]
  [NeZero (1 : α)] [CovariantClass α α (·+·) (·<·)] (a : α) : a < a + 1 :=
lt_add_of_pos_right _ zero_lt_one
#align lt_add_one lt_add_one

lemma lt_one_add [One α] [AddZeroClass α] [PartialOrder α] [ZeroLEOneClass α]
  [NeZero (1 : α)] [CovariantClass α α (swap (·+·)) (·<·)] (a : α) : a < 1 + a :=
lt_add_of_pos_left _ zero_lt_one
#align lt_one_add lt_one_add

variable [AddMonoidWithOne α]

lemma zero_le_two [Preorder α] [ZeroLEOneClass α] [CovariantClass α α (·+·) (·≤·)] :
    (0 : α) ≤ 2 := by
  rw [← one_add_one_eq_two]
  exact add_nonneg zero_le_one zero_le_one
#align zero_le_two zero_le_two

lemma zero_le_three [Preorder α] [ZeroLEOneClass α] [CovariantClass α α (·+·) (·≤·)] :
  (0 : α) ≤ 3 := by
  rw [← two_add_one_eq_three]
  exact add_nonneg zero_le_two zero_le_one
#align zero_le_three zero_le_three

lemma zero_le_four [Preorder α] [ZeroLEOneClass α] [CovariantClass α α (·+·) (·≤·)] :
    (0 : α) ≤ 4 := by
  rw [← three_add_one_eq_four]
  exact add_nonneg zero_le_three zero_le_one
#align zero_le_four zero_le_four

lemma one_le_two [LE α] [ZeroLEOneClass α] [CovariantClass α α (·+·) (·≤·)] :
  (1 : α) ≤ 2 :=
calc (1 : α) = 1 + 0 := (add_zero 1).symm
     _ ≤ 1 + 1 := add_le_add_left zero_le_one _
     _ = 2 := one_add_one_eq_two
#align one_le_two one_le_two

lemma one_le_two' [LE α] [ZeroLEOneClass α] [CovariantClass α α (swap (·+·)) (·≤·)] :
  (1 : α) ≤ 2 :=
calc (1 : α) = 0 + 1 := (zero_add 1).symm
     _ ≤ 1 + 1 := add_le_add_right zero_le_one _
     _ = 2 := one_add_one_eq_two
#align one_le_two' one_le_two'

section
variable [PartialOrder α] [ZeroLEOneClass α] [NeZero (1 : α)]

section
variable [CovariantClass α α (·+·) (·≤·)]

/-- See `zero_lt_two'` for a version with the type explicit. -/
@[simp] lemma zero_lt_two : (0 : α) < 2 := zero_lt_one.trans_le one_le_two
/-- See `zero_lt_three'` for a version with the type explicit. -/
@[simp] lemma zero_lt_three : (0 : α) < 3 := by
  rw [← two_add_one_eq_three]
  exact lt_add_of_lt_of_nonneg zero_lt_two zero_le_one
/-- See `zero_lt_four'` for a version with the type explicit. -/
@[simp] lemma zero_lt_four : (0 : α) < 4 := by
  rw [← three_add_one_eq_four]
  exact lt_add_of_lt_of_nonneg zero_lt_three zero_le_one
#align zero_lt_four zero_lt_four
#align zero_lt_three zero_lt_three
#align zero_lt_two zero_lt_two

variable (α)

/-- See `zero_lt_two` for a version with the type implicit. -/
lemma zero_lt_two' : (0 : α) < 2 := zero_lt_two
/-- See `zero_lt_three` for a version with the type implicit. -/
lemma zero_lt_three' : (0 : α) < 3 := zero_lt_three
/-- See `zero_lt_four` for a version with the type implicit. -/
lemma zero_lt_four' : (0 : α) < 4 := zero_lt_four
#align zero_lt_four' zero_lt_four'
#align zero_lt_three' zero_lt_three'
#align zero_lt_two' zero_lt_two'

instance ZeroLEOneClass.neZero.two : NeZero (2 : α) := ⟨zero_lt_two.ne'⟩
instance ZeroLEOneClass.neZero.three : NeZero (3 : α) := ⟨zero_lt_three.ne'⟩
instance ZeroLEOneClass.neZero.four : NeZero (4 : α) := ⟨zero_lt_four.ne'⟩

end

lemma one_lt_two [CovariantClass α α (·+·) (·<·)] : (1 : α) < 2 := by
  rw [← one_add_one_eq_two]
  exact lt_add_one _
#align one_lt_two one_lt_two

end

alias zero_lt_two ← two_pos
alias zero_lt_three ← three_pos
alias zero_lt_four ← four_pos
#align four_pos four_pos
#align three_pos three_pos
#align two_pos two_pos


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Floris van Doorn
-/
import algebra.module.basic
import algebra.bounds
import algebra.order.archimedean
import algebra.star.basic
import data.real.cau_seq_completion
import order.conditionally_complete_lattice

/-!
# Real numbers from Cauchy sequences

This file defines `ℝ` as the type of equivalence classes of Cauchy sequences of rational numbers.
This choice is motivated by how easy it is to prove that `ℝ` is a commutative ring, by simply
lifting everything to `ℚ`.
-/

open_locale pointwise

/-- The type `ℝ` of real numbers constructed as equivalence classes of Cauchy sequences of rational
numbers. -/
structure real := of_cauchy ::
(cauchy : @cau_seq.completion.Cauchy ℚ _ _ _ abs _)
notation `ℝ` := real

attribute [pp_using_anonymous_constructor] real

namespace real
open cau_seq cau_seq.completion

variables {x y : ℝ}

lemma ext_cauchy_iff : ∀ {x y : real}, x = y ↔ x.cauchy = y.cauchy
| ⟨a⟩ ⟨b⟩ := by split; cc

lemma ext_cauchy {x y : real} : x.cauchy = y.cauchy → x = y :=
ext_cauchy_iff.2

/-- The real numbers are isomorphic to the quotient of Cauchy sequences on the rationals. -/
def equiv_Cauchy : ℝ ≃ cau_seq.completion.Cauchy :=
⟨real.cauchy, real.of_cauchy, λ ⟨_⟩, rfl, λ _, rfl⟩

-- irreducible doesn't work for instances: https://github.com/leanprover-community/lean/issues/511
@[irreducible] private def zero : ℝ := ⟨0⟩
@[irreducible] private def one : ℝ := ⟨1⟩
@[irreducible] private def add : ℝ → ℝ → ℝ | ⟨a⟩ ⟨b⟩ := ⟨a + b⟩
@[irreducible] private def neg : ℝ → ℝ | ⟨a⟩ := ⟨-a⟩
@[irreducible] private def mul : ℝ → ℝ → ℝ | ⟨a⟩ ⟨b⟩ := ⟨a * b⟩

instance : has_zero ℝ := ⟨zero⟩
instance : has_one ℝ := ⟨one⟩
instance : has_add ℝ := ⟨add⟩
instance : has_neg ℝ := ⟨neg⟩
instance : has_mul ℝ := ⟨mul⟩

lemma zero_cauchy : (⟨0⟩ : ℝ) = 0 := show _ = zero, by rw zero
lemma one_cauchy : (⟨1⟩ : ℝ) = 1 := show _ = one, by rw one
lemma add_cauchy {a b} : (⟨a⟩ + ⟨b⟩ : ℝ) = ⟨a + b⟩ := show add _ _ = _, by rw add
lemma neg_cauchy {a} : (-⟨a⟩ : ℝ) = ⟨-a⟩ := show neg _ = _, by rw neg
lemma mul_cauchy {a b} : (⟨a⟩ * ⟨b⟩ : ℝ) = ⟨a * b⟩ := show mul _ _ = _, by rw mul

instance : comm_ring ℝ :=
begin
  refine_struct { zero  := (0 : ℝ),
                  one   := (1 : ℝ),
                  mul   := (*),
                  add   := (+),
                  neg   := @has_neg.neg ℝ _,
                  sub   := λ a b, a + (-b),
                  npow  := @npow_rec ℝ ⟨1⟩ ⟨(*)⟩,
                  nsmul := @nsmul_rec ℝ ⟨0⟩ ⟨(+)⟩,
                  zsmul := @zsmul_rec ℝ ⟨0⟩ ⟨(+)⟩ ⟨@has_neg.neg ℝ _⟩ };
  repeat { rintro ⟨_⟩, };
  try { refl };
  simp [← zero_cauchy, ← one_cauchy, add_cauchy, neg_cauchy, mul_cauchy];
  apply add_assoc <|> apply add_comm <|> apply mul_assoc <|> apply mul_comm <|>
    apply left_distrib <|> apply right_distrib <|> apply sub_eq_add_neg <|> skip
end

/-! Extra instances to short-circuit type class resolution.

 These short-circuits have an additional property of ensuring that a computable path is found; if
 `field ℝ` is found first, then decaying it to these typeclasses would result in a `noncomputable`
 version of them. -/
instance : ring ℝ               := by apply_instance
instance : comm_semiring ℝ      := by apply_instance
instance : semiring ℝ           := by apply_instance
instance : comm_monoid_with_zero ℝ := by apply_instance
instance : monoid_with_zero ℝ   := by apply_instance
instance : add_comm_group ℝ     := by apply_instance
instance : add_group ℝ          := by apply_instance
instance : add_comm_monoid ℝ    := by apply_instance
instance : add_monoid ℝ         := by apply_instance
instance : add_left_cancel_semigroup ℝ := by apply_instance
instance : add_right_cancel_semigroup ℝ := by apply_instance
instance : add_comm_semigroup ℝ := by apply_instance
instance : add_semigroup ℝ      := by apply_instance
instance : comm_monoid ℝ        := by apply_instance
instance : monoid ℝ             := by apply_instance
instance : comm_semigroup ℝ     := by apply_instance
instance : semigroup ℝ          := by apply_instance
instance : has_sub ℝ            := by apply_instance
instance : module ℝ ℝ           := by apply_instance
instance : inhabited ℝ          := ⟨0⟩

/-- The real numbers are a `*`-ring, with the trivial `*`-structure. -/
instance : star_ring ℝ          := star_ring_of_comm

/-- Coercion `ℚ` → `ℝ` as a `ring_hom`. Note that this
is `cau_seq.completion.of_rat`, not `rat.cast`. -/
def of_rat : ℚ →+* ℝ :=
by refine_struct { to_fun := of_cauchy ∘ of_rat };
  simp [of_rat_one, of_rat_zero, of_rat_mul, of_rat_add,
    one_cauchy, zero_cauchy, ← mul_cauchy, ← add_cauchy]

lemma of_rat_apply (x : ℚ) : of_rat x = of_cauchy (cau_seq.completion.of_rat x) := rfl

/-- Make a real number from a Cauchy sequence of rationals (by taking the equivalence class). -/
def mk (x : cau_seq ℚ abs) : ℝ := ⟨cau_seq.completion.mk x⟩

theorem mk_eq {f g : cau_seq ℚ abs} : mk f = mk g ↔ f ≈ g :=
ext_cauchy_iff.trans mk_eq

@[irreducible]
private def lt : ℝ → ℝ → Prop | ⟨x⟩ ⟨y⟩ :=
quotient.lift_on₂ x y (<) $
  λ f₁ g₁ f₂ g₂ hf hg, propext $
  ⟨λ h, lt_of_eq_of_lt (setoid.symm hf) (lt_of_lt_of_eq h hg),
   λ h, lt_of_eq_of_lt hf (lt_of_lt_of_eq h (setoid.symm hg))⟩

instance : has_lt ℝ := ⟨lt⟩

lemma lt_cauchy {f g} : (⟨⟦f⟧⟩ : ℝ) < ⟨⟦g⟧⟩ ↔ f < g := show lt _ _ ↔ _, by rw lt; refl

@[simp] theorem mk_lt {f g : cau_seq ℚ abs} : mk f < mk g ↔ f < g :=
lt_cauchy

lemma mk_zero : mk 0 = 0 := by rw ← zero_cauchy; refl
lemma mk_one : mk 1 = 1 := by rw ← one_cauchy; refl
lemma mk_add {f g : cau_seq ℚ abs} : mk (f + g) = mk f + mk g := by simp [mk, add_cauchy]
lemma mk_mul {f g : cau_seq ℚ abs} : mk (f * g) = mk f * mk g := by simp [mk, mul_cauchy]
lemma mk_neg {f : cau_seq ℚ abs} : mk (-f) = -mk f := by simp [mk, neg_cauchy]

@[simp] theorem mk_pos {f : cau_seq ℚ abs} : 0 < mk f ↔ pos f :=
by rw [← mk_zero, mk_lt]; exact iff_of_eq (congr_arg pos (sub_zero f))

@[irreducible] private def le (x y : ℝ) : Prop := x < y ∨ x = y
instance : has_le ℝ := ⟨le⟩
private lemma le_def {x y : ℝ} : x ≤ y ↔ x < y ∨ x = y := show le _ _ ↔ _, by rw le

@[simp] theorem mk_le {f g : cau_seq ℚ abs} : mk f ≤ mk g ↔ f ≤ g :=
by simp [le_def, mk_eq]; refl

@[elab_as_eliminator]
protected lemma ind_mk {C : real → Prop} (x : real) (h : ∀ y, C (mk y)) : C x :=
begin
  cases x with x,
  induction x using quot.induction_on with x,
  exact h x
end

theorem add_lt_add_iff_left {a b : ℝ} (c : ℝ) : c + a < c + b ↔ a < b :=
begin
  induction a using real.ind_mk,
  induction b using real.ind_mk,
  induction c using real.ind_mk,
  simp only [mk_lt, ← mk_add],
  show pos _ ↔ pos _, rw add_sub_add_left_eq_sub
end

instance : partial_order ℝ :=
{ le := (≤), lt := (<),
  lt_iff_le_not_le := λ a b, real.ind_mk a $ λ a, real.ind_mk b $ λ b,
    by simpa using lt_iff_le_not_le,
  le_refl := λ a, a.ind_mk (by intro a; rw mk_le),
  le_trans := λ a b c, real.ind_mk a $ λ a, real.ind_mk b $ λ b, real.ind_mk c $ λ c,
    by simpa using le_trans,
  lt_iff_le_not_le := λ a b, real.ind_mk a $ λ a, real.ind_mk b $ λ b,
    by simpa using lt_iff_le_not_le,
  le_antisymm := λ a b, real.ind_mk a $ λ a, real.ind_mk b $ λ b,
    by simpa [mk_eq] using @cau_seq.le_antisymm _ _ a b }

instance : preorder ℝ := by apply_instance

theorem of_rat_lt {x y : ℚ} : of_rat x < of_rat y ↔ x < y :=
begin
  rw [mk_lt] {md := tactic.transparency.semireducible},
  exact const_lt
end

protected theorem zero_lt_one : (0 : ℝ) < 1 :=
by convert of_rat_lt.2 zero_lt_one; simp

protected theorem mul_pos {a b : ℝ} : 0 < a → 0 < b → 0 < a * b :=
begin
  induction a using real.ind_mk with a,
  induction b using real.ind_mk with b,
  simpa only [mk_lt, mk_pos, ← mk_mul] using cau_seq.mul_pos
end

instance : ordered_comm_ring ℝ :=
{ add_le_add_left :=
  begin
    simp only [le_iff_eq_or_lt],
    rintros a b ⟨rfl, h⟩,
    { simp },
    { exact λ c, or.inr ((add_lt_add_iff_left c).2 ‹_›) }
  end,
  zero_le_one := le_of_lt real.zero_lt_one,
  mul_pos     := @real.mul_pos,
  .. real.comm_ring, .. real.partial_order, .. real.semiring }

instance : ordered_ring ℝ               := by apply_instance
instance : ordered_semiring ℝ           := by apply_instance
instance : ordered_add_comm_group ℝ     := by apply_instance
instance : ordered_cancel_add_comm_monoid ℝ := by apply_instance
instance : ordered_add_comm_monoid ℝ    := by apply_instance
instance : nontrivial ℝ := ⟨⟨0, 1, ne_of_lt real.zero_lt_one⟩⟩

open_locale classical

noncomputable instance : linear_order ℝ :=
{ le_total := begin
    intros a b,
    induction a using real.ind_mk with a,
    induction b using real.ind_mk with b,
    simpa using le_total a b,
  end,
  decidable_le := by apply_instance,
  .. real.partial_order }

noncomputable instance : linear_ordered_comm_ring ℝ :=
{ .. real.nontrivial, .. real.ordered_ring, .. real.comm_ring, .. real.linear_order }

/- Extra instances to short-circuit type class resolution -/
noncomputable instance : linear_ordered_ring ℝ        := by apply_instance
noncomputable instance : linear_ordered_semiring ℝ    := by apply_instance
instance : is_domain ℝ :=
{ .. real.nontrivial, .. real.comm_ring, .. linear_ordered_ring.is_domain }

/-- The real numbers are an ordered `*`-ring, with the trivial `*`-structure. -/
instance : star_ordered_ring ℝ :=
{ star_mul_self_nonneg := λ r, mul_self_nonneg r, }

@[irreducible] private noncomputable def inv' : ℝ → ℝ | ⟨a⟩ := ⟨a⁻¹⟩
noncomputable instance : has_inv ℝ := ⟨inv'⟩
lemma inv_cauchy {f} : (⟨f⟩ : ℝ)⁻¹ = ⟨f⁻¹⟩ := show inv' _ = _, by rw inv'

noncomputable instance : linear_ordered_field ℝ :=
{ inv := has_inv.inv,
  mul_inv_cancel := begin
    rintros ⟨a⟩ h,
    rw mul_comm,
    simp only [inv_cauchy, mul_cauchy, ← one_cauchy, ← zero_cauchy, ne.def] at *,
    exact cau_seq.completion.inv_mul_cancel h,
  end,
  inv_zero := by simp [← zero_cauchy, inv_cauchy],
  ..real.linear_ordered_comm_ring, }

/- Extra instances to short-circuit type class resolution -/

noncomputable instance : linear_ordered_add_comm_group ℝ          := by apply_instance
noncomputable instance field : field ℝ                            := by apply_instance
noncomputable instance : division_ring ℝ                          := by apply_instance
noncomputable instance : distrib_lattice ℝ                        := by apply_instance
noncomputable instance : lattice ℝ                                := by apply_instance
noncomputable instance : semilattice_inf ℝ                        := by apply_instance
noncomputable instance : semilattice_sup ℝ                        := by apply_instance
noncomputable instance : has_inf ℝ                                := by apply_instance
noncomputable instance : has_sup ℝ                                := by apply_instance
noncomputable instance decidable_lt (a b : ℝ) : decidable (a < b) := by apply_instance
noncomputable instance decidable_le (a b : ℝ) : decidable (a ≤ b) := by apply_instance
noncomputable instance decidable_eq (a b : ℝ) : decidable (a = b) := by apply_instance

open rat

@[simp] theorem of_rat_eq_cast : ∀ x : ℚ, of_rat x = x :=
of_rat.eq_rat_cast

theorem le_mk_of_forall_le {f : cau_seq ℚ abs} :
  (∃ i, ∀ j ≥ i, x ≤ f j) → x ≤ mk f :=
begin
  intro h,
  induction x using real.ind_mk with x,
  apply le_of_not_lt,
  rw mk_lt,
  rintro ⟨K, K0, hK⟩,
  obtain ⟨i, H⟩ := exists_forall_ge_and h
    (exists_forall_ge_and hK (f.cauchy₃ $ half_pos K0)),
  apply not_lt_of_le (H _ (le_refl _)).1,
  rw ← of_rat_eq_cast,
  rw [mk_lt] {md := tactic.transparency.semireducible},
  refine ⟨_, half_pos K0, i, λ j ij, _⟩,
  have := add_le_add (H _ ij).2.1
    (le_of_lt (abs_lt.1 $ (H _ (le_refl _)).2.2 _ ij).1),
  rwa [← sub_eq_add_neg, sub_self_div_two, sub_apply, sub_add_sub_cancel] at this
end

theorem mk_near_of_forall_near {f : cau_seq ℚ abs} {x : ℝ} {ε : ℝ}
  (H : ∃ i, ∀ j ≥ i, |(f j : ℝ) - x| ≤ ε) : |mk f - x| ≤ ε :=
abs_sub_le_iff.2
  ⟨sub_le_iff_le_add'.2 $ mk_le_of_forall_le $
    H.imp $ λ i h j ij, sub_le_iff_le_add'.1 (abs_sub_le_iff.1 $ h j ij).1,
  sub_le.1 $ le_mk_of_forall_le $
    H.imp $ λ i h j ij, sub_le.1 (abs_sub_le_iff.1 $ h j ij).2⟩

instance : archimedean ℝ :=
archimedean_iff_rat_le.2 $ λ x, real.ind_mk x $ λ f,
let ⟨M, M0, H⟩ := f.bounded' 0 in
⟨M, mk_le_of_forall_le ⟨0, λ i _,
  rat.cast_le.2 $ le_of_lt (abs_lt.1 (H i)).2⟩⟩

noncomputable instance : floor_ring ℝ := archimedean.floor_ring _

theorem is_cau_seq_iff_lift {f : ℕ → ℚ} : is_cau_seq abs f ↔ is_cau_seq
  abs (λ i, (f i : ℝ)) :=
⟨λ H ε ε0,
  let ⟨δ, δ0, δε⟩ := exists_pos_rat_lt ε0 in
  (H _ δ0).imp $ λ i hi j ij, lt_trans
    (by simpa using (@rat.cast_lt ℝ _ _ _).2 (hi _ ij)) δε,
 λ H ε ε0, (H _ (rat.cast_pos.2 ε0)).imp $
   λ i hi j ij, (@rat.cast_lt ℝ _ _ _).1 $ by simpa using hi _ ij⟩

theorem of_near (f : ℕ → ℚ) (x : ℝ)
  (h : ∀ ε > 0, ∃ i, ∀ j ≥ i, |(f j : ℝ) - x| < ε) :
  ∃ h', real.mk ⟨f, h'⟩ = x :=
⟨is_cau_seq_iff_lift.2 (of_near _ (const abs x) h),
 sub_eq_zero.1 $ abs_eq_zero.1 $
  eq_of_le_of_forall_le_of_dense (abs_nonneg _) $ λ ε ε0,
    mk_near_of_forall_near $
    (h _ ε0).imp (λ i h j ij, le_of_lt (h j ij))⟩

theorem exists_floor (x : ℝ) : ∃ (ub : ℤ), (ub:ℝ) ≤ x ∧
   ∀ (z : ℤ), (z:ℝ) ≤ x → z ≤ ub :=
int.exists_greatest_of_bdd
  (let ⟨n, hn⟩ := exists_int_gt x in ⟨n, λ z h',
    int.cast_le.1 $ le_trans h' $ le_of_lt hn⟩)
  (let ⟨n, hn⟩ := exists_int_lt x in ⟨n, le_of_lt hn⟩)

theorem exists_is_lub (S : set ℝ) (hne : S.nonempty) (hbdd : bdd_above S) :
  ∃ x, is_lub S x :=
begin
  rcases ⟨hne, hbdd⟩ with ⟨⟨L, hL⟩, ⟨U, hU⟩⟩,
  have : ∀ d : ℕ, bdd_above {m : ℤ | ∃ y ∈ S, (m : ℝ) ≤ y * d},
  { cases exists_int_gt U with k hk,
    refine λ d, ⟨k * d, λ z h, _⟩,
    rcases h with ⟨y, yS, hy⟩,
    refine int.cast_le.1 (hy.trans _),
    push_cast,
    exact mul_le_mul_of_nonneg_right ((hU yS).trans hk.le) d.cast_nonneg },
  choose f hf using λ d : ℕ, int.exists_greatest_of_bdd (this d) ⟨⌊L * d⌋, L, hL, int.floor_le _⟩,
  have hf₁ : ∀ n > 0, ∃ y ∈ S, ((f n / n:ℚ):ℝ) ≤ y := λ n n0,
    let ⟨y, yS, hy⟩ := (hf n).1 in
    ⟨y, yS, by simpa using (div_le_iff ((nat.cast_pos.2 n0):((_:ℝ) < _))).2 hy⟩,
  have hf₂ : ∀ (n > 0) (y ∈ S), (y - (n:ℕ)⁻¹ : ℝ) < (f n / n:ℚ),
  { intros n n0 y yS,
    have := (int.sub_one_lt_floor _).trans_le (int.cast_le.2 $ (hf n).2 _ ⟨y, yS, int.floor_le _⟩),
    simp [-sub_eq_add_neg],
    rwa [lt_div_iff ((nat.cast_pos.2 n0):((_:ℝ) < _)), sub_mul, _root_.inv_mul_cancel],
    exact ne_of_gt (nat.cast_pos.2 n0) },
  have hg : is_cau_seq abs (λ n, f n / n : ℕ → ℚ),
  { intros ε ε0,
    suffices : ∀ j k ≥ ⌈ε⁻¹⌉₊, (f j / j - f k / k : ℚ) < ε,
    { refine ⟨_, λ j ij, abs_lt.2 ⟨_, this _ _ ij (le_refl _)⟩⟩,
      rw [neg_lt, neg_sub], exact this _ _ (le_refl _) ij },
    intros j k ij ik,
    replace ij := le_trans (nat.le_ceil _) (nat.cast_le.2 ij),
    replace ik := le_trans (nat.le_ceil _) (nat.cast_le.2 ik),
    have j0 := nat.cast_pos.1 (lt_of_lt_of_le (inv_pos.2 ε0) ij),
    have k0 := nat.cast_pos.1 (lt_of_lt_of_le (inv_pos.2 ε0) ik),
    rcases hf₁ _ j0 with ⟨y, yS, hy⟩,
    refine lt_of_lt_of_le ((@rat.cast_lt ℝ _ _ _).1 _)
      ((inv_le ε0 (nat.cast_pos.2 k0)).1 ik),
    simpa using sub_lt_iff_lt_add'.2
      (lt_of_le_of_lt hy $ sub_lt_iff_lt_add.1 $ hf₂ _ k0 _ yS) },
  let g : cau_seq ℚ abs := ⟨λ n, f n / n, hg⟩,
  refine ⟨mk g, ⟨λ x xS, _, λ y h, _⟩⟩,
  { refine le_of_forall_ge_of_dense (λ z xz, _),
    cases exists_nat_gt (x - z)⁻¹ with K hK,
    refine le_mk_of_forall_le ⟨K, λ n nK, _⟩,
    replace xz := sub_pos.2 xz,
    replace hK := le_trans (le_of_lt hK) (nat.cast_le.2 nK),
    have n0 : 0 < n := nat.cast_pos.1 (lt_of_lt_of_le (inv_pos.2 xz) hK),
    refine le_trans _ (le_of_lt $ hf₂ _ n0 _ xS),
    rwa [le_sub, inv_le ((nat.cast_pos.2 n0):((_:ℝ) < _)) xz] },
  { exact mk_le_of_forall_le ⟨1, λ n n1,
      let ⟨x, xS, hx⟩ := hf₁ _ n1 in le_trans hx (h xS)⟩ }
end

noncomputable instance : has_Sup ℝ :=
⟨λ S, if h : S.nonempty ∧ bdd_above S then classical.some (exists_is_lub S h.1 h.2) else 0⟩

lemma Sup_def (S : set ℝ) :
  Sup S = if h : S.nonempty ∧ bdd_above S
    then classical.some (exists_is_lub S h.1 h.2) else 0 := rfl

protected theorem is_lub_Sup (S : set ℝ) (h₁ : S.nonempty) (h₂ : bdd_above S) : is_lub S (Sup S) :=
by { simp only [Sup_def, dif_pos (and.intro h₁ h₂)], apply classical.some_spec }

noncomputable instance : has_Inf ℝ := ⟨λ S, -Sup (-S)⟩

lemma Inf_def (S : set ℝ) : Inf S = -Sup (-S) := rfl

protected theorem is_glb_Inf (S : set ℝ) (h₁ : S.nonempty) (h₂ : bdd_below S) :
  is_glb S (Inf S) :=
begin
  rw [Inf_def, ← is_lub_neg', neg_neg],
  exact real.is_lub_Sup _ h₁.neg h₂.neg
end

noncomputable instance : conditionally_complete_linear_order ℝ :=
{ Sup := has_Sup.Sup,
  Inf := has_Inf.Inf,
  le_cSup := λ s a hs ha, (real.is_lub_Sup s ⟨a, ha⟩ hs).1 ha,
  cSup_le := λ s a hs ha, (real.is_lub_Sup s hs ⟨a, ha⟩).2 ha,
  cInf_le := λ s a hs ha, (real.is_glb_Inf s ⟨a, ha⟩ hs).1 ha,
  le_cInf := λ s a hs ha, (real.is_glb_Inf s hs ⟨a, ha⟩).2 ha,
 ..real.linear_order, ..real.lattice}

lemma lt_Inf_add_pos {s : set ℝ} (h : s.nonempty) {ε : ℝ} (hε : 0 < ε) :
  ∃ a ∈ s, a < Inf s + ε :=
exists_lt_of_cInf_lt h $ lt_add_of_pos_right _ hε

lemma add_neg_lt_Sup {s : set ℝ} (h : s.nonempty) {ε : ℝ} (hε : ε < 0) :
  ∃ a ∈ s, Sup s + ε < a :=
exists_lt_of_lt_cSup h $ add_lt_iff_neg_left.2 hε

lemma Inf_le_iff {s : set ℝ} (h : bdd_below s) (h' : s.nonempty) {a : ℝ} :
  Inf s ≤ a ↔ ∀ ε, 0 < ε → ∃ x ∈ s, x < a + ε :=
begin
  rw le_iff_forall_pos_lt_add,
  split; intros H ε ε_pos,
  { exact exists_lt_of_cInf_lt h' (H ε ε_pos) },
  { rcases H ε ε_pos with ⟨x, x_in, hx⟩,
    exact cInf_lt_of_lt h x_in hx }
end

lemma le_Sup_iff {s : set ℝ} (h : bdd_above s) (h' : s.nonempty) {a : ℝ} :
  a ≤ Sup s ↔ ∀ ε, ε < 0 → ∃ x ∈ s, a + ε < x :=
begin
  rw le_iff_forall_pos_lt_add,
  refine ⟨λ H ε ε_neg, _, λ H ε ε_pos, _⟩,
  { exact exists_lt_of_lt_cSup h' (lt_sub_iff_add_lt.mp (H _ (neg_pos.mpr ε_neg))) },
  { rcases H _ (neg_lt_zero.mpr ε_pos) with ⟨x, x_in, hx⟩,
    exact sub_lt_iff_lt_add.mp (lt_cSup_of_lt h x_in hx) }
end

@[simp] theorem Sup_empty : Sup (∅ : set ℝ) = 0 := dif_neg $ by simp

theorem Sup_of_not_bdd_above {s : set ℝ} (hs : ¬ bdd_above s) : Sup s = 0 :=
dif_neg $ assume h, hs h.2

theorem Sup_univ : Sup (@set.univ ℝ) = 0 :=
real.Sup_of_not_bdd_above $ λ ⟨x, h⟩, not_le_of_lt (lt_add_one _) $ h (set.mem_univ _)

@[simp] theorem Inf_empty : Inf (∅ : set ℝ) = 0 :=
by simp [Inf_def, Sup_empty]

theorem Inf_of_not_bdd_below {s : set ℝ} (hs : ¬ bdd_below s) : Inf s = 0 :=
neg_eq_zero.2 $ Sup_of_not_bdd_above $ mt bdd_above_neg.1 hs

/--
As `0` is the default value for `real.Sup` of the empty set or sets which are not bounded above, it
suffices to show that `S` is bounded below by `0` to show that `0 ≤ Inf S`.
-/
lemma Sup_nonneg (S : set ℝ) (hS : ∀ x ∈ S, (0:ℝ) ≤ x) : 0 ≤ Sup S :=
begin
  rcases S.eq_empty_or_nonempty with rfl | ⟨y, hy⟩,
  { exact Sup_empty.ge },
  { apply dite _ (λ h, le_cSup_of_le h hy $ hS y hy) (λ h, (Sup_of_not_bdd_above h).ge) }
end

/--
As `0` is the default value for `real.Sup` of the empty set, it suffices to show that `S` is
bounded above by `0` to show that `Sup S ≤ 0`.
-/
lemma Sup_nonpos (S : set ℝ) (hS : ∀ x ∈ S, x ≤ (0:ℝ)) : Sup S ≤ 0 :=
begin
  rcases S.eq_empty_or_nonempty with rfl | hS₂,
  exacts [Sup_empty.le, cSup_le hS₂ hS],
end

/--
As `0` is the default value for `real.Inf` of the empty set, it suffices to show that `S` is
bounded below by `0` to show that `0 ≤ Inf S`.
-/
lemma Inf_nonneg (S : set ℝ) (hS : ∀ x ∈ S, (0:ℝ) ≤ x) : 0 ≤ Inf S :=
begin
  rcases S.eq_empty_or_nonempty with rfl | hS₂,
  exacts [Inf_empty.ge, le_cInf hS₂ hS]
end

/--
As `0` is the default value for `real.Inf` of the empty set or sets which are not bounded below, it
suffices to show that `S` is bounded above by `0` to show that `Inf S ≤ 0`.
-/
lemma Inf_nonpos (S : set ℝ) (hS : ∀ x ∈ S, x ≤ (0:ℝ)) : Inf S ≤ 0 :=
begin
  rcases S.eq_empty_or_nonempty with rfl | ⟨y, hy⟩,
  { exact Inf_empty.le },
  { apply dite _ (λ h, cInf_le_of_le h hy $ hS y hy) (λ h, (Inf_of_not_bdd_below h).le) }
end

lemma Inf_le_Sup (s : set ℝ) (h₁ : bdd_below s) (h₂ : bdd_above s) : Inf s ≤ Sup s :=
begin
  rcases s.eq_empty_or_nonempty with rfl | hne,
  { rw [Inf_empty, Sup_empty] },
  { exact cInf_le_cSup h₁ h₂ hne }
end

theorem cau_seq_converges (f : cau_seq ℝ abs) : ∃ x, f ≈ const abs x :=
begin
  let S := {x : ℝ | const abs x < f},
  have lb : ∃ x, x ∈ S := exists_lt f,
  have ub' : ∀ x, f < const abs x → ∀ y ∈ S, y ≤ x :=
    λ x h y yS, le_of_lt $ const_lt.1 $ cau_seq.lt_trans yS h,
  have ub : ∃ x, ∀ y ∈ S, y ≤ x := (exists_gt f).imp ub',
  refine ⟨Sup S,
    ((lt_total _ _).resolve_left (λ h, _)).resolve_right (λ h, _)⟩,
  { rcases h with ⟨ε, ε0, i, ih⟩,
    refine (cSup_le lb (ub' _ _)).not_lt (sub_lt_self _ (half_pos ε0)),
    refine ⟨_, half_pos ε0, i, λ j ij, _⟩,
    rw [sub_apply, const_apply, sub_right_comm,
      le_sub_iff_add_le, add_halves],
    exact ih _ ij },
  { rcases h with ⟨ε, ε0, i, ih⟩,
    refine (le_cSup ub _).not_lt ((lt_add_iff_pos_left _).2 (half_pos ε0)),
    refine ⟨_, half_pos ε0, i, λ j ij, _⟩,
    rw [sub_apply, const_apply, add_comm, ← sub_sub,
      le_sub_iff_add_le, add_halves],
    exact ih _ ij }
end

noncomputable instance : cau_seq.is_complete ℝ abs := ⟨cau_seq_converges⟩

end real


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_96
  (x y z a : ℝ)
  (h₀ : 0 < x ∧ 0 < y ∧ 0 < z ∧ 0 < a)
  (h₁ : real.log x - real.log y = a)
  (h₂ : real.log y - real.log z = 15)
  (h₃ : real.log z - real.log x = -7) :
  a = -8 :=
begin
  nlinarith [h₁, h₂, h₃],
end


variable A : Type
variable f : A -> A
variable P : A -> Prop
variable h : forall x, P x -> P(f x)
variable ht : forall x, P x
example : forall y, P y -> P (f (f y)) :=
assume t,
show P t -> P (f (f t)), from
have h1 : P t -> P (f t), from h t,
have h2 : P (f t) -> P (f (f t)), from h (f t),
assume h3 : P t,
have h4 : P (f t), from h1 h3,
show  P (f (f t)), from h2 h4


section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable h : ∀ x, P x → P (f x)

-- Show the following:
  example : ∀ y, P y → P (f(f(y))):=
  assume y : A,
  assume py : P y,
  have hpf : P y → P (f (y)), from h y,
  have hpff : P (f(y)) → P (f (f(y))), from h (f(y)),
  hpff (hpf (py))
end

section
  variable U : Type
  variables A B : U → Prop

  example : (∀ x, A x ∧ B x) → ∀ x, A x :=
  assume h : (∀ x, A x ∧ B x),
  assume y,
  show A y, from and.left (h y)
end

section
  variable U : Type
  variables A B C : U → Prop
  variable h1 : ∀ x, A x ∨ B x
  variable h2 : ∀ x, A x → C x
  variable h3 : ∀ x, B x → C x

  example : ∀ x, C x :=
  assume y,
  or.elim (h1 y)
    (assume ha : A y ,  (h2 y) ha)
    (assume hb : B y, (h3 y) hb)
end

section
  variable U : Type
  variables A B : U → Prop
  example : (∃ x, A x) → ∃ x, A x ∨ B x :=
  assume h,
  exists.elim h
    (assume y (h1 : A y),
    show ∃ x, A x ∨ B x, from exists.intro y (or.inl h1))
end

section
  variable U : Type
  variables A B C : U → Prop

  example : (¬ ∃ x, A x) → ∀ x, ¬ A x :=
  sorry

  example : (∀ x, ¬ A x) → ¬ ∃ x, A x :=
  sorry
end


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import data.fin
import data.fintype.basic
/-!
# The structure of `fintype (fin n)`

This file contains some basic results about the `fintype` instance for `fin`,
especially properties of `finset.univ : finset (fin n)`.
-/

open finset
open fintype

namespace fin

@[simp]
lemma univ_filter_zero_lt {n : ℕ} :
  (univ : finset (fin n.succ)).filter (λ i, 0 < i) =
    univ.map (fin.succ_embedding _).to_embedding :=
begin
  ext i,
  simp only [mem_filter, mem_map, mem_univ, true_and,
  function.embedding.coe_fn_mk, exists_true_left],
  split,
  { refine cases _ _ i,
    { rintro ⟨⟨⟩⟩ },
    { intros i _, exact ⟨i, mem_univ _, rfl⟩ } },
  { rintro ⟨i, _, rfl⟩,
    exact succ_pos _ },
end

@[simp]
lemma univ_filter_succ_lt {n : ℕ} (j : fin n) :
  (univ : finset (fin n.succ)).filter (λ i, j.succ < i) =
    (univ.filter (λ i, j < i)).map (fin.succ_embedding _).to_embedding :=
begin
  ext i,
  simp only [mem_filter, mem_map, mem_univ, true_and,
  function.embedding.coe_fn_mk, exists_true_left],
  split,
  { refine cases _ _ i,
    { rintro ⟨⟨⟩⟩ },
    { intros i hi,
      exact ⟨i, mem_filter.mpr ⟨mem_univ _, succ_lt_succ_iff.mp hi⟩, rfl⟩ } },
  { rintro ⟨i, hi, rfl⟩,
    exact succ_lt_succ_iff.mpr (mem_filter.mp hi).2 },
end

end fin


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/

import data.int.basic data.nat.modeq

namespace int

def modeq (n a b : ℤ) := a % n = b % n

notation a ` ≡ `:50 b ` [ZMOD `:50 n `]`:0 := modeq n a b

namespace modeq
variables {n m a b c d : ℤ}

@[refl] protected theorem refl (a : ℤ) : a ≡ a [ZMOD n] := @rfl _ _

@[symm] protected theorem symm : a ≡ b [ZMOD n] → b ≡ a [ZMOD n] := eq.symm

@[trans] protected theorem trans : a ≡ b [ZMOD n] → b ≡ c [ZMOD n] → a ≡ c [ZMOD n] := eq.trans

lemma coe_nat_modeq_iff {a b n : ℕ} : a ≡ b [ZMOD n] ↔ a ≡ b [MOD n] :=
by unfold modeq nat.modeq; rw ← int.coe_nat_eq_coe_nat_iff; simp [int.coe_nat_mod]

instance : decidable (a ≡ b [ZMOD n]) := by unfold modeq; apply_instance

theorem modeq_zero_iff : a ≡ 0 [ZMOD n] ↔ n ∣ a :=
by rw [modeq, zero_mod, dvd_iff_mod_eq_zero]

theorem modeq_iff_dvd : a ≡ b [ZMOD n] ↔ (n:ℤ) ∣ b - a :=
by rw [modeq, eq_comm];
   simp [int.mod_eq_mod_iff_mod_sub_eq_zero, int.dvd_iff_mod_eq_zero]

theorem modeq_of_dvd_of_modeq (d : m ∣ n) (h : a ≡ b [ZMOD n]) : a ≡ b [ZMOD m] :=
modeq_iff_dvd.2 $ dvd_trans d (modeq_iff_dvd.1 h)

theorem modeq_mul_left' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD (c * n)] :=
or.cases_on (lt_or_eq_of_le hc) (λ hc,
  by unfold modeq;
  simp [mul_mod_mul_of_pos _ _ hc, (show _ = _, from h)] )
(λ hc, by simp [hc.symm])

theorem modeq_mul_right' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD (n * c)] :=
by rw [mul_comm a, mul_comm b, mul_comm n]; exact modeq_mul_left' hc h

theorem modeq_add (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a + c ≡ b + d [ZMOD n] :=
modeq_iff_dvd.2 $ by simpa using dvd_add (modeq_iff_dvd.1 h₁) (modeq_iff_dvd.1 h₂)

theorem modeq_add_cancel_left (h₁ : a ≡ b [ZMOD n]) (h₂ : a + c ≡ b + d [ZMOD n]) : c ≡ d [ZMOD n] :=
have (n:ℤ) ∣ a + (-a + (d + -c)),
by simpa using dvd_sub (modeq_iff_dvd.1 h₂) (modeq_iff_dvd.1 h₁),
modeq_iff_dvd.2 $ by rwa add_neg_cancel_left at this

theorem modeq_add_cancel_right (h₁ : c ≡ d [ZMOD n]) (h₂ : a + c ≡ b + d [ZMOD n]) : a ≡ b [ZMOD n] :=
by rw [add_comm a, add_comm b] at h₂; exact modeq_add_cancel_left h₁ h₂

theorem modeq_neg (h : a ≡ b [ZMOD n]) : -a ≡ -b [ZMOD n] :=
modeq_add_cancel_left h (by simp)

theorem modeq_sub (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a - c ≡ b - d [ZMOD n] :=
by rw [sub_eq_add_neg, sub_eq_add_neg]; exact modeq_add h₁ (modeq_neg h₂)

theorem modeq_mul_left (c : ℤ) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD n] :=
or.cases_on (le_total 0 c)
(λ hc, modeq_of_dvd_of_modeq (dvd_mul_left _ _) (modeq_mul_left' hc h))
(λ hc, by rw [← neg_neg c, ← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul _ b];
    exact modeq_neg (modeq_of_dvd_of_modeq (dvd_mul_left _ _)
    (modeq_mul_left' (neg_nonneg.2 hc) h)))

theorem modeq_mul_right (c : ℤ) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD n] :=
by rw [mul_comm a, mul_comm b]; exact modeq_mul_left c h

theorem modeq_mul (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a * c ≡ b * d [ZMOD n] :=
(modeq_mul_left _ h₂).trans (modeq_mul_right _ h₁)

end modeq
end int


/-
Copyright (c) 2020 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton
-/
import data.set.finite

/-!
# Infinitude of intervals

Bounded intervals in dense orders are infinite, as are unbounded intervals
in orders that are unbounded on the appropriate side. We also prove that an unbounded
preorder is an infinite type.
-/

variables {α : Type*} [preorder α]

/-- A nonempty preorder with no maximal element is infinite. This is not an instance to avoid
a cycle with `infinite α → nontrivial α → nonempty α`. -/
lemma no_max_order.infinite [nonempty α] [no_max_order α] : infinite α :=
let ⟨f, hf⟩ := nat.exists_strict_mono α in infinite.of_injective f hf.injective

/-- A nonempty preorder with no minimal element is infinite. This is not an instance to avoid
a cycle with `infinite α → nontrivial α → nonempty α`. -/
lemma no_min_order.infinite [nonempty α] [no_min_order α] : infinite α :=
@no_max_order.infinite αᵒᵈ _ _ _

namespace set

section densely_ordered

variables [densely_ordered α] {a b : α} (h : a < b)

lemma Ioo.infinite : infinite (Ioo a b) := @no_max_order.infinite _ _ (nonempty_Ioo_subtype h) _
lemma Ioo_infinite : (Ioo a b).infinite := infinite_coe_iff.1 $ Ioo.infinite h

lemma Ico_infinite : (Ico a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ico_self

lemma Ioc_infinite : (Ioc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ioc_self
lemma Ioc.infinite : infinite (Ioc a b) := infinite_coe_iff.2 $ Ioc_infinite h

lemma Icc_infinite : (Icc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Icc_self
lemma Icc.infinite : infinite (Icc a b) := infinite_coe_iff.2 $ Icc_infinite h

end densely_ordered

instance [no_min_order α] {a : α} : infinite (Iio a) := no_min_order.infinite
lemma Iio_infinite [no_min_order α] (a : α) : (Iio a).infinite := infinite_coe_iff.1 Iio.infinite

instance [no_min_order α] {a : α} : infinite (Iic a) := no_min_order.infinite
lemma Iic_infinite [no_min_order α] (a : α) : (Iic a).infinite := infinite_coe_iff.1 Iic.infinite

instance [no_max_order α] {a : α} : infinite (Ioi a) := no_max_order.infinite
lemma Ioi_infinite [no_min_order α] (a : α) : (Iio a).infinite := infinite_coe_iff.1 Iio.infinite

instance [no_max_order α] {a : α} : infinite (Ici a) := no_max_order.infinite
lemma Ici_infinite [no_max_order α] (a : α) : (Ici a).infinite := infinite_coe_iff.1 Ici.infinite

end set


/-
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, Yury Kudryashov
-/
import data.set.intervals.basic

/-!

# Upper / lower bounds

In this file we define:

* `upper_bounds`, `lower_bounds` : the set of upper bounds (resp., lower bounds) of a set;
* `bdd_above s`, `bdd_below s` : the set `s` is bounded above (resp., below), i.e., the set of upper
  (resp., lower) bounds of `s` is nonempty;
* `is_least s a`, `is_greatest s a` : `a` is a least (resp., greatest) element of `s`;
  for a partial order, it is unique if exists;
* `is_lub s a`, `is_glb s a` : `a` is a least upper bound (resp., a greatest lower bound)
  of `s`; for a partial order, it is unique if exists.

We also prove various lemmas about monotonicity, behaviour under `∪`, `∩`, `insert`, and provide
formulas for `∅`, `univ`, and intervals.
-/

open function set order_dual (to_dual of_dual)

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

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

/-!
### Definitions
-/

/-- The set of upper bounds of a set. -/
def upper_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → a ≤ x }
/-- The set of lower bounds of a set. -/
def lower_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → x ≤ a }

/-- A set is bounded above if there exists an upper bound. -/
def bdd_above (s : set α) := (upper_bounds s).nonempty
/-- A set is bounded below if there exists a lower bound. -/
def bdd_below (s : set α) := (lower_bounds s).nonempty

/-- `a` is a least element of a set `s`; for a partial order, it is unique if exists. -/
def is_least (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ lower_bounds s
/-- `a` is a greatest element of a set `s`; for a partial order, it is unique if exists -/
def is_greatest (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ upper_bounds s

/-- `a` is a least upper bound of a set `s`; for a partial order, it is unique if exists. -/
def is_lub (s : set α) : α → Prop := is_least (upper_bounds s)
/-- `a` is a greatest lower bound of a set `s`; for a partial order, it is unique if exists. -/
def is_glb (s : set α) : α → Prop := is_greatest (lower_bounds s)

lemma mem_upper_bounds : a ∈ upper_bounds s ↔ ∀ x ∈ s, x ≤ a := iff.rfl
lemma mem_lower_bounds : a ∈ lower_bounds s ↔ ∀ x ∈ s, a ≤ x := iff.rfl

lemma bdd_above_def : bdd_above s ↔ ∃ x, ∀ y ∈ s, y ≤ x := iff.rfl
lemma bdd_below_def : bdd_below s ↔ ∃ x, ∀ y ∈ s, x ≤ y := iff.rfl

lemma bot_mem_lower_bounds [order_bot α] (s : set α) : ⊥ ∈ lower_bounds s := λ _ _, bot_le
lemma top_mem_upper_bounds [order_top α] (s : set α) : ⊤ ∈ upper_bounds s := λ _ _, le_top

@[simp] lemma is_least_bot_iff [order_bot α] : is_least s ⊥ ↔ ⊥ ∈ s :=
and_iff_left $ bot_mem_lower_bounds _

@[simp] lemma is_greatest_top_iff [order_top α] : is_greatest s ⊤ ↔ ⊤ ∈ s :=
and_iff_left $ top_mem_upper_bounds _

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` such that `x`
is not greater than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(y ≤ x)`. A version for linear orders is called `not_bdd_above_iff`. -/
lemma not_bdd_above_iff' : ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, ¬(y ≤ x) :=
by simp [bdd_above, upper_bounds, set.nonempty]

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` such that `x`
is not less than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(x ≤ y)`. A version for linear orders is called `not_bdd_below_iff`. -/
lemma not_bdd_below_iff' : ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, ¬ x ≤ y := @not_bdd_above_iff' αᵒᵈ _ _

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` that is greater
than `x`. A version for preorders is called `not_bdd_above_iff'`. -/
lemma not_bdd_above_iff {α : Type*} [linear_order α] {s : set α} :
  ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, x < y :=
by simp only [not_bdd_above_iff', not_le]

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` that is less
than `x`. A version for preorders is called `not_bdd_below_iff'`. -/
lemma not_bdd_below_iff {α : Type*} [linear_order α] {s : set α} :
  ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, y < x :=
@not_bdd_above_iff αᵒᵈ _ _

lemma bdd_above.dual (h : bdd_above s) : bdd_below (of_dual ⁻¹' s) := h

lemma bdd_below.dual (h : bdd_below s) : bdd_above (of_dual ⁻¹' s) := h

lemma is_least.dual (h : is_least s a) : is_greatest (of_dual ⁻¹' s) (to_dual a) := h

lemma is_greatest.dual (h : is_greatest s a) : is_least (of_dual ⁻¹' s) (to_dual a) := h

lemma is_lub.dual (h : is_lub s a) : is_glb (of_dual ⁻¹' s) (to_dual a) := h

lemma is_glb.dual (h : is_glb s a) : is_lub (of_dual ⁻¹' s) (to_dual a) := h

/-- If `a` is the least element of a set `s`, then subtype `s` is an order with bottom element. -/
@[reducible] def is_least.order_bot (h : is_least s a) : order_bot s :=
{ bot := ⟨a, h.1⟩,
  bot_le := subtype.forall.2 h.2 }

/-- If `a` is the greatest element of a set `s`, then subtype `s` is an order with top element. -/
@[reducible] def is_greatest.order_top (h : is_greatest s a) : order_top s :=
{ top := ⟨a, h.1⟩,
  le_top := subtype.forall.2 h.2 }

/-!
### Monotonicity
-/

lemma upper_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
  upper_bounds t ⊆ upper_bounds s :=
λ b hb x h, hb $ hst h

lemma lower_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
  lower_bounds t ⊆ lower_bounds s :=
λ b hb x h, hb $ hst h

lemma upper_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : a ∈ upper_bounds s → b ∈ upper_bounds s :=
λ ha x h, le_trans (ha h) hab

lemma lower_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : b ∈ lower_bounds s → a ∈ lower_bounds s :=
λ hb x h, le_trans hab (hb h)

lemma upper_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
  a ∈ upper_bounds t → b ∈ upper_bounds s :=
λ ha, upper_bounds_mono_set hst $ upper_bounds_mono_mem hab ha

lemma lower_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
  b ∈ lower_bounds t → a ∈ lower_bounds s :=
λ hb, lower_bounds_mono_set hst $ lower_bounds_mono_mem hab hb

/-- If `s ⊆ t` and `t` is bounded above, then so is `s`. -/
lemma bdd_above.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_above t → bdd_above s :=
nonempty.mono $ upper_bounds_mono_set h

/-- If `s ⊆ t` and `t` is bounded below, then so is `s`. -/
lemma bdd_below.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_below t → bdd_below s :=
nonempty.mono $ lower_bounds_mono_set h

/-- If `a` is a least upper bound for sets `s` and `p`, then it is a least upper bound for any
set `t`, `s ⊆ t ⊆ p`. -/
lemma is_lub.of_subset_of_superset {s t p : set α} (hs : is_lub s a) (hp : is_lub p a)
  (hst : s ⊆ t) (htp : t ⊆ p) : is_lub t a :=
⟨upper_bounds_mono_set htp hp.1, lower_bounds_mono_set (upper_bounds_mono_set hst) hs.2⟩

/-- If `a` is a greatest lower bound for sets `s` and `p`, then it is a greater lower bound for any
set `t`, `s ⊆ t ⊆ p`. -/
lemma is_glb.of_subset_of_superset {s t p : set α} (hs : is_glb s a) (hp : is_glb p a)
  (hst : s ⊆ t) (htp : t ⊆ p) : is_glb t a :=
hs.dual.of_subset_of_superset hp hst htp

lemma is_least.mono (ha : is_least s a) (hb : is_least t b) (hst : s ⊆ t) : b ≤ a :=
hb.2 (hst ha.1)

lemma is_greatest.mono (ha : is_greatest s a) (hb : is_greatest t b) (hst : s ⊆ t) : a ≤ b :=
hb.2 (hst ha.1)

lemma is_lub.mono (ha : is_lub s a) (hb : is_lub t b) (hst : s ⊆ t) : a ≤ b :=
hb.mono ha $ upper_bounds_mono_set hst

lemma is_glb.mono (ha : is_glb s a) (hb : is_glb t b) (hst : s ⊆ t) : b ≤ a :=
hb.mono ha $ lower_bounds_mono_set hst

lemma subset_lower_bounds_upper_bounds (s : set α) : s ⊆ lower_bounds (upper_bounds s) :=
λ x hx y hy, hy hx

lemma subset_upper_bounds_lower_bounds (s : set α) : s ⊆ upper_bounds (lower_bounds s) :=
λ x hx y hy, hy hx

lemma set.nonempty.bdd_above_lower_bounds (hs : s.nonempty) : bdd_above (lower_bounds s) :=
hs.mono (subset_upper_bounds_lower_bounds s)

lemma set.nonempty.bdd_below_upper_bounds (hs : s.nonempty) : bdd_below (upper_bounds s) :=
hs.mono (subset_lower_bounds_upper_bounds s)

/-!
### Conversions
-/

lemma is_least.is_glb (h : is_least s a) : is_glb s a := ⟨h.2, λ b hb, hb h.1⟩

lemma is_greatest.is_lub (h : is_greatest s a) : is_lub s a := ⟨h.2, λ b hb, hb h.1⟩

lemma is_lub.upper_bounds_eq (h : is_lub s a) : upper_bounds s = Ici a :=
set.ext $ λ b, ⟨λ hb, h.2 hb, λ hb, upper_bounds_mono_mem hb h.1⟩

lemma is_glb.lower_bounds_eq (h : is_glb s a) : lower_bounds s = Iic a := h.dual.upper_bounds_eq

lemma is_least.lower_bounds_eq (h : is_least s a) : lower_bounds s = Iic a :=
h.is_glb.lower_bounds_eq

lemma is_greatest.upper_bounds_eq (h : is_greatest s a) : upper_bounds s = Ici a :=
h.is_lub.upper_bounds_eq

lemma is_lub_le_iff (h : is_lub s a) : a ≤ b ↔ b ∈ upper_bounds s :=
by { rw h.upper_bounds_eq, refl }

lemma le_is_glb_iff (h : is_glb s a) : b ≤ a ↔ b ∈ lower_bounds s :=
by { rw h.lower_bounds_eq, refl }

lemma is_lub_iff_le_iff : is_lub s a ↔ ∀ b, a ≤ b ↔ b ∈ upper_bounds s :=
⟨λ h b, is_lub_le_iff h, λ H, ⟨(H _).1 le_rfl, λ b hb, (H b).2 hb⟩⟩

lemma is_glb_iff_le_iff : is_glb s a ↔ ∀ b, b ≤ a ↔ b ∈ lower_bounds s :=
@is_lub_iff_le_iff αᵒᵈ _ _ _

/-- If `s` has a least upper bound, then it is bounded above. -/
lemma is_lub.bdd_above (h : is_lub s a) : bdd_above s := ⟨a, h.1⟩

/-- If `s` has a greatest lower bound, then it is bounded below. -/
lemma is_glb.bdd_below (h : is_glb s a) : bdd_below s := ⟨a, h.1⟩

/-- If `s` has a greatest element, then it is bounded above. -/
lemma is_greatest.bdd_above (h : is_greatest s a) : bdd_above s := ⟨a, h.2⟩

/-- If `s` has a least element, then it is bounded below. -/
lemma is_least.bdd_below (h : is_least s a) : bdd_below s := ⟨a, h.2⟩

lemma is_least.nonempty (h : is_least s a) : s.nonempty := ⟨a, h.1⟩

lemma is_greatest.nonempty (h : is_greatest s a) : s.nonempty := ⟨a, h.1⟩

/-!
### Union and intersection
-/

@[simp] lemma upper_bounds_union : upper_bounds (s ∪ t) = upper_bounds s ∩ upper_bounds t :=
subset.antisymm
  (λ b hb, ⟨λ x hx, hb (or.inl hx), λ x hx, hb (or.inr hx)⟩)
  (λ b hb x hx, hx.elim (λ hs, hb.1 hs) (λ ht, hb.2 ht))

@[simp] lemma lower_bounds_union : lower_bounds (s ∪ t) = lower_bounds s ∩ lower_bounds t :=
@upper_bounds_union αᵒᵈ _ s t

lemma union_upper_bounds_subset_upper_bounds_inter :
  upper_bounds s ∪ upper_bounds t ⊆ upper_bounds (s ∩ t) :=
union_subset
  (upper_bounds_mono_set $ inter_subset_left _ _)
  (upper_bounds_mono_set $ inter_subset_right _ _)

lemma union_lower_bounds_subset_lower_bounds_inter :
  lower_bounds s ∪ lower_bounds t ⊆ lower_bounds (s ∩ t) :=
@union_upper_bounds_subset_upper_bounds_inter αᵒᵈ _ s t

lemma is_least_union_iff {a : α} {s t : set α} :
  is_least (s ∪ t) a ↔ (is_least s a ∧ a ∈ lower_bounds t ∨ a ∈ lower_bounds s ∧ is_least t a) :=
by simp [is_least, lower_bounds_union, or_and_distrib_right, and_comm (a ∈ t), and_assoc]

lemma is_greatest_union_iff :
  is_greatest (s ∪ t) a ↔ (is_greatest s a ∧ a ∈ upper_bounds t ∨
    a ∈ upper_bounds s ∧ is_greatest t a) :=
@is_least_union_iff αᵒᵈ _ a s t

/-- If `s` is bounded, then so is `s ∩ t` -/
lemma bdd_above.inter_of_left (h : bdd_above s) : bdd_above (s ∩ t) :=
h.mono $ inter_subset_left s t

/-- If `t` is bounded, then so is `s ∩ t` -/
lemma bdd_above.inter_of_right (h : bdd_above t) : bdd_above (s ∩ t) :=
h.mono $ inter_subset_right s t

/-- If `s` is bounded, then so is `s ∩ t` -/
lemma bdd_below.inter_of_left (h : bdd_below s) : bdd_below (s ∩ t) :=
h.mono $ inter_subset_left s t

/-- If `t` is bounded, then so is `s ∩ t` -/
lemma bdd_below.inter_of_right (h : bdd_below t) : bdd_below (s ∩ t) :=
h.mono $ inter_subset_right s t

/-- If `s` and `t` are bounded above sets in a `semilattice_sup`, then so is `s ∪ t`. -/
lemma bdd_above.union [semilattice_sup γ] {s t : set γ} :
  bdd_above s → bdd_above t → bdd_above (s ∪ t) :=
begin
  rintros ⟨bs, hs⟩ ⟨bt, ht⟩,
  use bs ⊔ bt,
  rw upper_bounds_union,
  exact ⟨upper_bounds_mono_mem le_sup_left hs,
    upper_bounds_mono_mem le_sup_right ht⟩
end

/-- The union of two sets is bounded above if and only if each of the sets is. -/
lemma bdd_above_union [semilattice_sup γ] {s t : set γ} :
  bdd_above (s ∪ t) ↔ bdd_above s ∧ bdd_above t :=
⟨λ h, ⟨h.mono $ subset_union_left s t, h.mono $ subset_union_right s t⟩,
  λ h, h.1.union h.2⟩

lemma bdd_below.union [semilattice_inf γ] {s t : set γ} :
  bdd_below s → bdd_below t → bdd_below (s ∪ t) :=
@bdd_above.union γᵒᵈ _ s t

/--The union of two sets is bounded above if and only if each of the sets is.-/
lemma bdd_below_union [semilattice_inf γ] {s t : set γ} :
  bdd_below (s ∪ t) ↔ bdd_below s ∧ bdd_below t :=
@bdd_above_union γᵒᵈ _ s t

/-- If `a` is the least upper bound of `s` and `b` is the least upper bound of `t`,
then `a ⊔ b` is the least upper bound of `s ∪ t`. -/
lemma is_lub.union [semilattice_sup γ] {a b : γ} {s t : set γ}
  (hs : is_lub s a) (ht : is_lub t b) :
  is_lub (s ∪ t) (a ⊔ b) :=
⟨λ c h, h.cases_on (λ h, le_sup_of_le_left $ hs.left h) (λ h, le_sup_of_le_right $ ht.left h),
  λ c hc, sup_le (hs.right $ λ d hd, hc $ or.inl hd) (ht.right $ λ d hd, hc $ or.inr hd)⟩

/-- If `a` is the greatest lower bound of `s` and `b` is the greatest lower bound of `t`,
then `a ⊓ b` is the greatest lower bound of `s ∪ t`. -/
lemma is_glb.union [semilattice_inf γ] {a₁ a₂ : γ} {s t : set γ}
  (hs : is_glb s a₁) (ht : is_glb t a₂) :
  is_glb (s ∪ t) (a₁ ⊓ a₂) :=
hs.dual.union ht

/-- If `a` is the least element of `s` and `b` is the least element of `t`,
then `min a b` is the least element of `s ∪ t`. -/
lemma is_least.union [linear_order γ] {a b : γ} {s t : set γ}
  (ha : is_least s a) (hb : is_least t b) : is_least (s ∪ t) (min a b) :=
⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
  (ha.is_glb.union hb.is_glb).1⟩

/-- If `a` is the greatest element of `s` and `b` is the greatest element of `t`,
then `max a b` is the greatest element of `s ∪ t`. -/
lemma is_greatest.union [linear_order γ] {a b : γ} {s t : set γ}
  (ha : is_greatest s a) (hb : is_greatest t b) : is_greatest (s ∪ t) (max a b) :=
⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
  (ha.is_lub.union hb.is_lub).1⟩

lemma is_lub.inter_Ici_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_lub s a)
  (hb : b ∈ s) : is_lub (s ∩ Ici b) a :=
⟨λ x hx, ha.1 hx.1, λ c hc, have hbc : b ≤ c, from hc ⟨hb, le_rfl⟩,
  ha.2 $ λ x hx, (le_total x b).elim (λ hxb, hxb.trans hbc) $ λ hbx, hc ⟨hx, hbx⟩⟩

lemma is_glb.inter_Iic_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_glb s a)
  (hb : b ∈ s) : is_glb (s ∩ Iic b) a :=
ha.dual.inter_Ici_of_mem hb

lemma bdd_above_iff_exists_ge [semilattice_sup γ] {s : set γ} (x₀ : γ) :
  bdd_above s ↔ ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x :=
by { rw [bdd_above_def, exists_ge_and_iff_exists], exact monotone.ball (λ x hx, monotone_le) }

lemma bdd_below_iff_exists_le [semilattice_inf γ] {s : set γ} (x₀ : γ) :
  bdd_below s ↔ ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
bdd_above_iff_exists_ge (to_dual x₀)

lemma bdd_above.exists_ge  [semilattice_sup γ] {s : set γ} (hs : bdd_above s) (x₀ : γ) :
  ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x :=
(bdd_above_iff_exists_ge x₀).mp hs

lemma bdd_below.exists_le  [semilattice_inf γ] {s : set γ} (hs : bdd_below s) (x₀ : γ) :
  ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
(bdd_below_iff_exists_le x₀).mp hs

/-!
### Specific sets

#### Unbounded intervals
-/

lemma is_least_Ici : is_least (Ici a) a := ⟨left_mem_Ici, λ x, id⟩

lemma is_greatest_Iic : is_greatest (Iic a) a := ⟨right_mem_Iic, λ x, id⟩

lemma is_lub_Iic : is_lub (Iic a) a := is_greatest_Iic.is_lub

lemma is_glb_Ici : is_glb (Ici a) a := is_least_Ici.is_glb

lemma upper_bounds_Iic : upper_bounds (Iic a) = Ici a := is_lub_Iic.upper_bounds_eq

lemma lower_bounds_Ici : lower_bounds (Ici a) = Iic a := is_glb_Ici.lower_bounds_eq

lemma bdd_above_Iic : bdd_above (Iic a) := is_lub_Iic.bdd_above

lemma bdd_below_Ici : bdd_below (Ici a) := is_glb_Ici.bdd_below

lemma bdd_above_Iio : bdd_above (Iio a) := ⟨a, λ x hx, le_of_lt hx⟩

lemma bdd_below_Ioi : bdd_below (Ioi a) := ⟨a, λ x hx, le_of_lt hx⟩

lemma lub_Iio_le (a : α) (hb : is_lub (set.Iio a) b) : b ≤ a :=
(is_lub_le_iff hb).mpr $ λ k hk, le_of_lt hk

lemma le_glb_Ioi (a : α) (hb : is_glb (set.Ioi a) b) : a ≤ b := @lub_Iio_le αᵒᵈ _ _ a hb

lemma lub_Iio_eq_self_or_Iio_eq_Iic [partial_order γ] {j : γ} (i : γ) (hj : is_lub (set.Iio i) j) :
  j = i ∨ set.Iio i = set.Iic j :=
begin
  cases eq_or_lt_of_le (lub_Iio_le i hj) with hj_eq_i hj_lt_i,
  { exact or.inl hj_eq_i, },
  { right,
    exact set.ext (λ k, ⟨λ hk_lt, hj.1 hk_lt, λ hk_le_j, lt_of_le_of_lt hk_le_j hj_lt_i⟩), },
end

lemma glb_Ioi_eq_self_or_Ioi_eq_Ici [partial_order γ] {j : γ} (i : γ) (hj : is_glb (set.Ioi i) j) :
  j = i ∨ set.Ioi i = set.Ici j :=
@lub_Iio_eq_self_or_Iio_eq_Iic γᵒᵈ _ j i hj

section

variables [linear_order γ]

lemma exists_lub_Iio (i : γ) : ∃ j, is_lub (set.Iio i) j :=
begin
  by_cases h_exists_lt : ∃ j, j ∈ upper_bounds (set.Iio i) ∧ j < i,
  { obtain ⟨j, hj_ub, hj_lt_i⟩ := h_exists_lt,
    exact ⟨j, hj_ub, λ k hk_ub, hk_ub hj_lt_i⟩, },
  { refine ⟨i, λ j hj, le_of_lt hj, _⟩,
    rw mem_lower_bounds,
    by_contra,
    refine h_exists_lt _,
    push_neg at h,
    exact h, },
end

lemma exists_glb_Ioi (i : γ) : ∃ j, is_glb (set.Ioi i) j := @exists_lub_Iio γᵒᵈ _ i

variables [densely_ordered γ]

lemma is_lub_Iio {a : γ} : is_lub (Iio a) a :=
⟨λ x hx, le_of_lt hx, λ y hy, le_of_forall_ge_of_dense hy⟩

lemma is_glb_Ioi {a : γ} : is_glb (Ioi a) a := @is_lub_Iio γᵒᵈ _ _ a

lemma upper_bounds_Iio {a : γ} : upper_bounds (Iio a) = Ici a := is_lub_Iio.upper_bounds_eq

lemma lower_bounds_Ioi {a : γ} : lower_bounds (Ioi a) = Iic a := is_glb_Ioi.lower_bounds_eq

end

/-!
#### Singleton
-/

lemma is_greatest_singleton : is_greatest {a} a :=
⟨mem_singleton a, λ x hx, le_of_eq $ eq_of_mem_singleton hx⟩

lemma is_least_singleton : is_least {a} a := @is_greatest_singleton αᵒᵈ _ a

lemma is_lub_singleton : is_lub {a} a := is_greatest_singleton.is_lub

lemma is_glb_singleton : is_glb {a} a := is_least_singleton.is_glb

lemma bdd_above_singleton : bdd_above ({a} : set α) := is_lub_singleton.bdd_above

lemma bdd_below_singleton : bdd_below ({a} : set α) := is_glb_singleton.bdd_below

@[simp] lemma upper_bounds_singleton : upper_bounds {a} = Ici a := is_lub_singleton.upper_bounds_eq

@[simp] lemma lower_bounds_singleton : lower_bounds {a} = Iic a := is_glb_singleton.lower_bounds_eq

/-!
#### Bounded intervals
-/

lemma bdd_above_Icc : bdd_above (Icc a b) := ⟨b, λ _, and.right⟩

lemma bdd_below_Icc : bdd_below (Icc a b) := ⟨a, λ _, and.left⟩

lemma bdd_above_Ico : bdd_above (Ico a b) := bdd_above_Icc.mono Ico_subset_Icc_self

lemma bdd_below_Ico : bdd_below (Ico a b) := bdd_below_Icc.mono Ico_subset_Icc_self

lemma bdd_above_Ioc : bdd_above (Ioc a b) := bdd_above_Icc.mono Ioc_subset_Icc_self

lemma bdd_below_Ioc : bdd_below (Ioc a b) := bdd_below_Icc.mono Ioc_subset_Icc_self

lemma bdd_above_Ioo : bdd_above (Ioo a b) := bdd_above_Icc.mono Ioo_subset_Icc_self

lemma bdd_below_Ioo : bdd_below (Ioo a b) := bdd_below_Icc.mono Ioo_subset_Icc_self

lemma is_greatest_Icc (h : a ≤ b) : is_greatest (Icc a b) b :=
⟨right_mem_Icc.2 h, λ x, and.right⟩

lemma is_lub_Icc (h : a ≤ b) : is_lub (Icc a b) b := (is_greatest_Icc h).is_lub

lemma upper_bounds_Icc (h : a ≤ b) : upper_bounds (Icc a b) = Ici b :=
(is_lub_Icc h).upper_bounds_eq

lemma is_least_Icc (h : a ≤ b) : is_least (Icc a b) a :=
⟨left_mem_Icc.2 h, λ x, and.left⟩

lemma is_glb_Icc (h : a ≤ b) : is_glb (Icc a b) a := (is_least_Icc h).is_glb

lemma lower_bounds_Icc (h : a ≤ b) : lower_bounds (Icc a b) = Iic a :=
(is_glb_Icc h).lower_bounds_eq

lemma is_greatest_Ioc (h : a < b) : is_greatest (Ioc a b) b :=
⟨right_mem_Ioc.2 h, λ x, and.right⟩

lemma is_lub_Ioc (h : a < b) : is_lub (Ioc a b) b :=
(is_greatest_Ioc h).is_lub

lemma upper_bounds_Ioc (h : a < b) : upper_bounds (Ioc a b) = Ici b :=
(is_lub_Ioc h).upper_bounds_eq

lemma is_least_Ico (h : a < b) : is_least (Ico a b) a :=
⟨left_mem_Ico.2 h, λ x, and.left⟩

lemma is_glb_Ico (h : a < b) : is_glb (Ico a b) a :=
(is_least_Ico h).is_glb

lemma lower_bounds_Ico (h : a < b) : lower_bounds (Ico a b) = Iic a :=
(is_glb_Ico h).lower_bounds_eq

section

variables [semilattice_sup γ] [densely_ordered γ]

lemma is_glb_Ioo {a b : γ} (h : a < b) :
  is_glb (Ioo a b) a :=
⟨λ x hx, hx.1.le, λ x hx,
begin
  cases eq_or_lt_of_le (le_sup_right : a ≤ x ⊔ a) with h₁ h₂,
  { exact h₁.symm ▸ le_sup_left },
  obtain ⟨y, lty, ylt⟩ := exists_between h₂,
  apply (not_lt_of_le (sup_le (hx ⟨lty, ylt.trans_le (sup_le _ h.le)⟩) lty.le) ylt).elim,
  obtain ⟨u, au, ub⟩ := exists_between h,
  apply (hx ⟨au, ub⟩).trans ub.le,
end⟩

lemma lower_bounds_Ioo {a b : γ} (hab : a < b) : lower_bounds (Ioo a b) = Iic a :=
(is_glb_Ioo hab).lower_bounds_eq

lemma is_glb_Ioc {a b : γ} (hab : a < b) : is_glb (Ioc a b) a :=
(is_glb_Ioo hab).of_subset_of_superset (is_glb_Icc hab.le) Ioo_subset_Ioc_self Ioc_subset_Icc_self

lemma lower_bound_Ioc {a b : γ} (hab : a < b) : lower_bounds (Ioc a b) = Iic a :=
(is_glb_Ioc hab).lower_bounds_eq

end

section

variables [semilattice_inf γ] [densely_ordered γ]

lemma is_lub_Ioo {a b : γ} (hab : a < b) : is_lub (Ioo a b) b :=
by simpa only [dual_Ioo] using is_glb_Ioo hab.dual

lemma upper_bounds_Ioo {a b : γ} (hab : a < b) : upper_bounds (Ioo a b) = Ici b :=
(is_lub_Ioo hab).upper_bounds_eq

lemma is_lub_Ico {a b : γ} (hab : a < b) : is_lub (Ico a b) b :=
by simpa only [dual_Ioc] using is_glb_Ioc hab.dual

lemma upper_bounds_Ico {a b : γ} (hab : a < b) : upper_bounds (Ico a b) = Ici b :=
(is_lub_Ico hab).upper_bounds_eq

end

lemma bdd_below_iff_subset_Ici : bdd_below s ↔ ∃ a, s ⊆ Ici a := iff.rfl

lemma bdd_above_iff_subset_Iic : bdd_above s ↔ ∃ a, s ⊆ Iic a := iff.rfl

lemma bdd_below_bdd_above_iff_subset_Icc : bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ Icc a b :=
by simp only [Ici_inter_Iic.symm, subset_inter_iff, bdd_below_iff_subset_Ici,
  bdd_above_iff_subset_Iic, exists_and_distrib_left, exists_and_distrib_right]

/-!
#### Univ
-/

lemma is_greatest_univ [preorder γ] [order_top γ] : is_greatest (univ : set γ) ⊤ :=
⟨mem_univ _, λ x hx, le_top⟩

@[simp] lemma order_top.upper_bounds_univ [partial_order γ] [order_top γ] :
  upper_bounds (univ : set γ) = {⊤} :=
by rw [is_greatest_univ.upper_bounds_eq, Ici_top]

lemma is_lub_univ [preorder γ] [order_top γ] : is_lub (univ : set γ) ⊤ :=
is_greatest_univ.is_lub

@[simp] lemma order_bot.lower_bounds_univ [partial_order γ] [order_bot γ] :
  lower_bounds (univ : set γ) = {⊥} :=
@order_top.upper_bounds_univ γᵒᵈ _ _

lemma is_least_univ [preorder γ] [order_bot γ] : is_least (univ : set γ) ⊥ :=
@is_greatest_univ γᵒᵈ _ _

lemma is_glb_univ [preorder γ] [order_bot γ] : is_glb (univ : set γ) ⊥ :=
is_least_univ.is_glb

@[simp] lemma no_max_order.upper_bounds_univ [no_max_order α] : upper_bounds (univ : set α) = ∅ :=
eq_empty_of_subset_empty $ λ b hb, let ⟨x, hx⟩ := exists_gt b in
not_le_of_lt hx (hb trivial)

@[simp] lemma no_min_order.lower_bounds_univ [no_min_order α] : lower_bounds (univ : set α) = ∅ :=
@no_max_order.upper_bounds_univ αᵒᵈ _ _

@[simp] lemma not_bdd_above_univ [no_max_order α] : ¬bdd_above (univ : set α) :=
by simp [bdd_above]

@[simp] lemma not_bdd_below_univ [no_min_order α] : ¬bdd_below (univ : set α) :=
@not_bdd_above_univ αᵒᵈ _ _

/-!
#### Empty set
-/

@[simp] lemma upper_bounds_empty : upper_bounds (∅ : set α) = univ :=
by simp only [upper_bounds, eq_univ_iff_forall, mem_set_of_eq, ball_empty_iff, forall_true_iff]

@[simp] lemma lower_bounds_empty : lower_bounds (∅ : set α) = univ := @upper_bounds_empty αᵒᵈ _

@[simp] lemma bdd_above_empty [nonempty α] : bdd_above (∅ : set α) :=
by simp only [bdd_above, upper_bounds_empty, univ_nonempty]

@[simp] lemma bdd_below_empty [nonempty α] : bdd_below (∅ : set α) :=
by simp only [bdd_below, lower_bounds_empty, univ_nonempty]

lemma is_glb_empty [preorder γ] [order_top γ] : is_glb ∅ (⊤:γ) :=
by simp only [is_glb, lower_bounds_empty, is_greatest_univ]

lemma is_lub_empty [preorder γ] [order_bot γ] : is_lub ∅ (⊥:γ) := @is_glb_empty γᵒᵈ _ _

lemma is_lub.nonempty [no_min_order α] (hs : is_lub s a) : s.nonempty :=
let ⟨a', ha'⟩ := exists_lt a in
ne_empty_iff_nonempty.1 $ λ h, not_le_of_lt ha' $ hs.right $ by simp only [h, upper_bounds_empty]

lemma is_glb.nonempty [no_max_order α] (hs : is_glb s a) : s.nonempty := hs.dual.nonempty

lemma nonempty_of_not_bdd_above [ha : nonempty α] (h : ¬bdd_above s) : s.nonempty :=
nonempty.elim ha $ λ x, (not_bdd_above_iff'.1 h x).imp $ λ a ha, ha.fst

lemma nonempty_of_not_bdd_below [ha : nonempty α] (h : ¬bdd_below s) : s.nonempty :=
@nonempty_of_not_bdd_above αᵒᵈ _ _ _ h

/-!
#### insert
-/

/-- Adding a point to a set preserves its boundedness above. -/
@[simp] lemma bdd_above_insert [semilattice_sup γ] (a : γ) {s : set γ} :
  bdd_above (insert a s) ↔ bdd_above s :=
by simp only [insert_eq, bdd_above_union, bdd_above_singleton, true_and]

lemma bdd_above.insert [semilattice_sup γ] (a : γ) {s : set γ} (hs : bdd_above s) :
  bdd_above (insert a s) :=
(bdd_above_insert a).2 hs

/--Adding a point to a set preserves its boundedness below.-/
@[simp] lemma bdd_below_insert [semilattice_inf γ] (a : γ) {s : set γ} :
  bdd_below (insert a s) ↔ bdd_below s :=
by simp only [insert_eq, bdd_below_union, bdd_below_singleton, true_and]

lemma bdd_below.insert [semilattice_inf γ] (a : γ) {s : set γ} (hs : bdd_below s) :
  bdd_below (insert a s) :=
(bdd_below_insert a).2 hs

lemma is_lub.insert [semilattice_sup γ] (a) {b} {s : set γ} (hs : is_lub s b) :
  is_lub (insert a s) (a ⊔ b) :=
by { rw insert_eq, exact is_lub_singleton.union hs }

lemma is_glb.insert [semilattice_inf γ] (a) {b} {s : set γ} (hs : is_glb s b) :
  is_glb (insert a s) (a ⊓ b) :=
by { rw insert_eq, exact is_glb_singleton.union hs }

lemma is_greatest.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_greatest s b) :
  is_greatest (insert a s) (max a b) :=
by { rw insert_eq, exact is_greatest_singleton.union hs }

lemma is_least.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_least s b) :
  is_least (insert a s) (min a b) :=
by { rw insert_eq, exact is_least_singleton.union hs }

@[simp] lemma upper_bounds_insert (a : α) (s : set α) :
  upper_bounds (insert a s) = Ici a ∩ upper_bounds s :=
by rw [insert_eq, upper_bounds_union, upper_bounds_singleton]

@[simp] lemma lower_bounds_insert (a : α) (s : set α) :
  lower_bounds (insert a s) = Iic a ∩ lower_bounds s :=
by rw [insert_eq, lower_bounds_union, lower_bounds_singleton]

/-- When there is a global maximum, every set is bounded above. -/
@[simp] protected lemma order_top.bdd_above [preorder γ] [order_top γ] (s : set γ) : bdd_above s :=
⟨⊤, λ a ha, order_top.le_top a⟩

/-- When there is a global minimum, every set is bounded below. -/
@[simp] protected lemma order_bot.bdd_below [preorder γ] [order_bot γ] (s : set γ) : bdd_below s :=
⟨⊥, λ a ha, order_bot.bot_le a⟩

/-!
#### Pair
-/

lemma is_lub_pair [semilattice_sup γ] {a b : γ} : is_lub {a, b} (a ⊔ b) :=
is_lub_singleton.insert _

lemma is_glb_pair [semilattice_inf γ] {a b : γ} : is_glb {a, b} (a ⊓ b) :=
is_glb_singleton.insert _

lemma is_least_pair [linear_order γ] {a b : γ} : is_least {a, b} (min a b) :=
is_least_singleton.insert _

lemma is_greatest_pair [linear_order γ] {a b : γ} : is_greatest {a, b} (max a b) :=
is_greatest_singleton.insert _

/-!
#### Lower/upper bounds
-/

@[simp] lemma is_lub_lower_bounds : is_lub (lower_bounds s) a ↔ is_glb s a :=
⟨λ H, ⟨λ x hx, H.2 $ subset_upper_bounds_lower_bounds s hx, H.1⟩, is_greatest.is_lub⟩

@[simp] lemma is_glb_upper_bounds : is_glb (upper_bounds s) a ↔ is_lub s a :=
@is_lub_lower_bounds αᵒᵈ _ _ _

end

/-!
### (In)equalities with the least upper bound and the greatest lower bound
-/

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

lemma lower_bounds_le_upper_bounds (ha : a ∈ lower_bounds s) (hb : b ∈ upper_bounds s) :
  s.nonempty → a ≤ b
| ⟨c, hc⟩ := le_trans (ha hc) (hb hc)

lemma is_glb_le_is_lub (ha : is_glb s a) (hb : is_lub s b) (hs : s.nonempty) : a ≤ b :=
lower_bounds_le_upper_bounds ha.1 hb.1 hs

lemma is_lub_lt_iff (ha : is_lub s a) : a < b ↔ ∃ c ∈ upper_bounds s, c < b :=
⟨λ hb, ⟨a, ha.1, hb⟩, λ ⟨c, hcs, hcb⟩, lt_of_le_of_lt (ha.2 hcs) hcb⟩

lemma lt_is_glb_iff (ha : is_glb s a) : b < a ↔ ∃ c ∈ lower_bounds s, b < c := is_lub_lt_iff ha.dual

lemma le_of_is_lub_le_is_glb {x y} (ha : is_glb s a) (hb : is_lub s b) (hab : b ≤ a)
  (hx : x ∈ s) (hy : y ∈ s) : x ≤ y :=
calc x ≤ b : hb.1 hx
   ... ≤ a : hab
   ... ≤ y : ha.1 hy

end preorder

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

lemma is_least.unique (Ha : is_least s a) (Hb : is_least s b) : a = b :=
le_antisymm (Ha.right Hb.left) (Hb.right Ha.left)

lemma is_least.is_least_iff_eq (Ha : is_least s a) : is_least s b ↔ a = b :=
iff.intro Ha.unique (λ h, h ▸ Ha)

lemma is_greatest.unique (Ha : is_greatest s a) (Hb : is_greatest s b) : a = b :=
le_antisymm (Hb.right Ha.left) (Ha.right Hb.left)

lemma is_greatest.is_greatest_iff_eq (Ha : is_greatest s a) : is_greatest s b ↔ a = b :=
iff.intro Ha.unique (λ h, h ▸ Ha)

lemma is_lub.unique (Ha : is_lub s a) (Hb : is_lub s b) : a = b :=
Ha.unique Hb

lemma is_glb.unique (Ha : is_glb s a) (Hb : is_glb s b) : a = b :=
Ha.unique Hb

lemma set.subsingleton_of_is_lub_le_is_glb (Ha : is_glb s a) (Hb : is_lub s b) (hab : b ≤ a) :
  s.subsingleton :=
λ x hx y hy, le_antisymm (le_of_is_lub_le_is_glb Ha Hb hab hx hy)
  (le_of_is_lub_le_is_glb Ha Hb hab hy hx)

lemma is_glb_lt_is_lub_of_ne (Ha : is_glb s a) (Hb : is_lub s b)
  {x y} (Hx : x ∈ s) (Hy : y ∈ s) (Hxy : x ≠ y) :
  a < b :=
lt_iff_le_not_le.2
  ⟨lower_bounds_le_upper_bounds Ha.1 Hb.1 ⟨x, Hx⟩,
    λ hab, Hxy $ set.subsingleton_of_is_lub_le_is_glb Ha Hb hab Hx Hy⟩

end partial_order

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

lemma lt_is_lub_iff (h : is_lub s a) : b < a ↔ ∃ c ∈ s, b < c :=
by simp only [← not_le, is_lub_le_iff h, mem_upper_bounds, not_forall]

lemma is_glb_lt_iff (h : is_glb s a) : a < b ↔ ∃ c ∈ s, c < b := lt_is_lub_iff h.dual

lemma is_lub.exists_between (h : is_lub s a) (hb : b < a) :
  ∃ c ∈ s, b < c ∧ c ≤ a :=
let ⟨c, hcs, hbc⟩ := (lt_is_lub_iff h).1 hb in ⟨c, hcs, hbc, h.1 hcs⟩

lemma is_lub.exists_between' (h : is_lub s a) (h' : a ∉ s) (hb : b < a) :
  ∃ c ∈ s, b < c ∧ c < a :=
let ⟨c, hcs, hbc, hca⟩ := h.exists_between hb
in ⟨c, hcs, hbc, hca.lt_of_ne $ λ hac, h' $ hac ▸ hcs⟩

lemma is_glb.exists_between (h : is_glb s a) (hb : a < b) :
  ∃ c ∈ s, a ≤ c ∧ c < b :=
let ⟨c, hcs, hbc⟩ := (is_glb_lt_iff h).1 hb in ⟨c, hcs, h.1 hcs, hbc⟩

lemma is_glb.exists_between' (h : is_glb s a) (h' : a ∉ s) (hb : a < b) :
  ∃ c ∈ s, a < c ∧ c < b :=
let ⟨c, hcs, hac, hcb⟩ := h.exists_between hb
in ⟨c, hcs, hac.lt_of_ne $ λ hac, h' $ hac.symm ▸ hcs, hcb⟩

end linear_order

/-!
### Least upper bound and the greatest lower bound in linear ordered additive commutative groups
-/

section linear_ordered_add_comm_group

variables [linear_ordered_add_comm_group α] {s : set α} {a ε : α}

lemma is_glb.exists_between_self_add (h : is_glb s a) (hε : 0 < ε) :
  ∃ b ∈ s, a ≤ b ∧ b < a + ε :=
h.exists_between $ lt_add_of_pos_right _ hε

lemma is_glb.exists_between_self_add' (h : is_glb s a) (h₂ : a ∉ s) (hε : 0 < ε) :
  ∃ b ∈ s, a < b ∧ b < a + ε :=
h.exists_between' h₂ $ lt_add_of_pos_right _ hε

lemma is_lub.exists_between_sub_self  (h : is_lub s a) (hε : 0 < ε) : ∃ b ∈ s, a - ε < b ∧ b ≤ a :=
h.exists_between $ sub_lt_self _ hε

lemma is_lub.exists_between_sub_self' (h : is_lub s a) (h₂ : a ∉ s) (hε : 0 < ε) :
  ∃ b ∈ s, a - ε < b ∧ b < a :=
h.exists_between' h₂ $ sub_lt_self _ hε

end linear_ordered_add_comm_group

/-!
### Images of upper/lower bounds under monotone functions
-/

namespace monotone_on

variables [preorder α] [preorder β] {f : α → β} {s t : set α}
  (Hf : monotone_on f t) {a : α} (Hst : s ⊆ t)
include Hf

lemma mem_upper_bounds_image (Has : a ∈ upper_bounds s) (Hat : a ∈ t) :
  f a ∈ upper_bounds (f '' s) :=
ball_image_of_ball (λ x H, Hf (Hst H) Hat (Has H))

lemma mem_upper_bounds_image_self : a ∈ upper_bounds t → a ∈ t → f a ∈ upper_bounds (f '' t) :=
Hf.mem_upper_bounds_image subset_rfl

lemma mem_lower_bounds_image (Has : a ∈ lower_bounds s) (Hat : a ∈ t) :
  f a ∈ lower_bounds (f '' s) :=
ball_image_of_ball (λ x H, Hf Hat (Hst H) (Has H))

lemma mem_lower_bounds_image_self : a ∈ lower_bounds t → a ∈ t → f a ∈ lower_bounds (f '' t) :=
Hf.mem_lower_bounds_image subset_rfl

lemma image_upper_bounds_subset_upper_bounds_image (Hst : s ⊆ t) :
  f '' (upper_bounds s ∩ t) ⊆ upper_bounds (f '' s) :=
by { rintro _ ⟨a, ha, rfl⟩, exact Hf.mem_upper_bounds_image Hst ha.1 ha.2 }

lemma image_lower_bounds_subset_lower_bounds_image :
  f '' (lower_bounds s ∩ t) ⊆ lower_bounds (f '' s) :=
Hf.dual.image_upper_bounds_subset_upper_bounds_image Hst

/-- The image under a monotone function on a set `t` of a subset which has an upper bound in `t`
  is bounded above. -/
lemma map_bdd_above : (upper_bounds s ∩ t).nonempty → bdd_above (f '' s) :=
λ ⟨C, hs, ht⟩, ⟨f C, Hf.mem_upper_bounds_image Hst hs ht⟩

/-- The image under a monotone function on a set `t` of a subset which has a lower bound in `t`
  is bounded below. -/
lemma map_bdd_below : (lower_bounds s ∩ t).nonempty → bdd_below (f '' s) :=
λ ⟨C, hs, ht⟩, ⟨f C, Hf.mem_lower_bounds_image Hst hs ht⟩

/-- A monotone map sends a least element of a set to a least element of its image. -/
lemma map_is_least (Ha : is_least t a) : is_least (f '' t) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image_self Ha.2 Ha.1⟩

/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
lemma map_is_greatest (Ha : is_greatest t a) : is_greatest (f '' t) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image_self Ha.2 Ha.1⟩

end monotone_on

namespace antitone_on

variables [preorder α] [preorder β] {f : α → β} {s t : set α}
  (Hf : antitone_on f t) {a : α} (Hst : s ⊆ t)
include Hf

lemma mem_upper_bounds_image (Has : a ∈ lower_bounds s) : a ∈ t → f a ∈ upper_bounds (f '' s) :=
Hf.dual_right.mem_lower_bounds_image Hst Has

lemma mem_upper_bounds_image_self : a ∈ lower_bounds t → a ∈ t → f a ∈ upper_bounds (f '' t) :=
Hf.dual_right.mem_lower_bounds_image_self

lemma mem_lower_bounds_image : a ∈ upper_bounds s → a ∈ t → f a ∈ lower_bounds (f '' s) :=
Hf.dual_right.mem_upper_bounds_image Hst

lemma mem_lower_bounds_image_self : a ∈ upper_bounds t → a ∈ t → f a ∈ lower_bounds (f '' t) :=
Hf.dual_right.mem_upper_bounds_image_self

lemma image_lower_bounds_subset_upper_bounds_image :
  f '' (lower_bounds s ∩ t) ⊆ upper_bounds (f '' s) :=
Hf.dual_right.image_lower_bounds_subset_lower_bounds_image Hst

lemma image_upper_bounds_subset_lower_bounds_image :
  f '' (upper_bounds s ∩ t) ⊆ lower_bounds (f '' s) :=
Hf.dual_right.image_upper_bounds_subset_upper_bounds_image Hst

/-- The image under an antitone function of a set which is bounded above is bounded below. -/
lemma map_bdd_above : (upper_bounds s ∩ t).nonempty → bdd_below (f '' s) :=
Hf.dual_right.map_bdd_above Hst

/-- The image under an antitone function of a set which is bounded below is bounded above. -/
lemma map_bdd_below : (lower_bounds s ∩ t).nonempty → bdd_above (f '' s) :=
Hf.dual_right.map_bdd_below Hst

/-- An antitone map sends a greatest element of a set to a least element of its image. -/
lemma map_is_greatest : is_greatest t a → is_least (f '' t) (f a) :=
Hf.dual_right.map_is_greatest

/-- An antitone map sends a least element of a set to a greatest element of its image. -/
lemma map_is_least : is_least t a → is_greatest (f '' t) (f a) :=
Hf.dual_right.map_is_least

end antitone_on

namespace monotone

variables [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α}
include Hf

lemma mem_upper_bounds_image (Ha : a ∈ upper_bounds s) : f a ∈ upper_bounds (f '' s) :=
ball_image_of_ball (λ x H, Hf (Ha H))

lemma mem_lower_bounds_image (Ha : a ∈ lower_bounds s) : f a ∈ lower_bounds (f '' s) :=
ball_image_of_ball (λ x H, Hf (Ha H))

lemma image_upper_bounds_subset_upper_bounds_image : f '' upper_bounds s ⊆ upper_bounds (f '' s) :=
by { rintro _ ⟨a, ha, rfl⟩, exact Hf.mem_upper_bounds_image ha }

lemma image_lower_bounds_subset_lower_bounds_image : f '' lower_bounds s ⊆ lower_bounds (f '' s) :=
Hf.dual.image_upper_bounds_subset_upper_bounds_image

/-- The image under a monotone function of a set which is bounded above is bounded above. See also
`bdd_above.image2`. -/
lemma map_bdd_above : bdd_above s → bdd_above (f '' s)
| ⟨C, hC⟩ := ⟨f C, Hf.mem_upper_bounds_image hC⟩

/-- The image under a monotone function of a set which is bounded below is bounded below. See also
`bdd_below.image2`. -/
lemma map_bdd_below : bdd_below s → bdd_below (f '' s)
| ⟨C, hC⟩ := ⟨f C, Hf.mem_lower_bounds_image hC⟩

/-- A monotone map sends a least element of a set to a least element of its image. -/
lemma map_is_least (Ha : is_least s a) : is_least (f '' s) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image Ha.2⟩

/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
lemma map_is_greatest (Ha : is_greatest s a) : is_greatest (f '' s) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image Ha.2⟩

end monotone

namespace antitone
variables [preorder α] [preorder β] {f : α → β} (hf : antitone f) {a : α} {s : set α}

lemma mem_upper_bounds_image : a ∈ lower_bounds s → f a ∈ upper_bounds (f '' s) :=
hf.dual_right.mem_lower_bounds_image

lemma mem_lower_bounds_image : a ∈ upper_bounds s → f a ∈ lower_bounds (f '' s) :=
hf.dual_right.mem_upper_bounds_image

lemma image_lower_bounds_subset_upper_bounds_image : f '' lower_bounds s ⊆ upper_bounds (f '' s) :=
hf.dual_right.image_lower_bounds_subset_lower_bounds_image

lemma image_upper_bounds_subset_lower_bounds_image : f '' upper_bounds s ⊆ lower_bounds (f '' s) :=
hf.dual_right.image_upper_bounds_subset_upper_bounds_image

/-- The image under an antitone function of a set which is bounded above is bounded below. -/
lemma map_bdd_above : bdd_above s → bdd_below (f '' s) :=
hf.dual_right.map_bdd_above

/-- The image under an antitone function of a set which is bounded below is bounded above. -/
lemma map_bdd_below : bdd_below s → bdd_above (f '' s) :=
hf.dual_right.map_bdd_below

/-- An antitone map sends a greatest element of a set to a least element of its image. -/
lemma map_is_greatest : is_greatest s a → is_least (f '' s) (f a) :=
hf.dual_right.map_is_greatest

/-- An antitone map sends a least element of a set to a greatest element of its image. -/
lemma map_is_least : is_least s a → is_greatest (f '' s) (f a) :=
hf.dual_right.map_is_least

end antitone

section image2
variables [preorder α] [preorder β] [preorder γ] {f : α → β → γ} {s : set α} {t : set β} {a : α}
  {b : β}

section monotone_monotone
variables (h₀ : ∀ b, monotone (swap f b)) (h₁ : ∀ a, monotone (f a))
include h₀ h₁

lemma mem_upper_bounds_image2 (ha : a ∈ upper_bounds s) (hb : b ∈ upper_bounds t) :
  f a b ∈ upper_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma mem_lower_bounds_image2 (ha : a ∈ lower_bounds s) (hb : b ∈ lower_bounds t) :
  f a b ∈ lower_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma image2_upper_bounds_upper_bounds_subset :
  image2 f (upper_bounds s) (upper_bounds t) ⊆ upper_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_upper_bounds_image2 h₀ h₁ ha hb }

lemma image2_lower_bounds_lower_bounds_subset :
  image2 f (lower_bounds s) (lower_bounds t) ⊆ lower_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_lower_bounds_image2 h₀ h₁ ha hb }

/-- See also `monotone.map_bdd_above`. -/
lemma bdd_above.image2 : bdd_above s → bdd_above t → bdd_above (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩, exact ⟨f a b, mem_upper_bounds_image2 h₀ h₁ ha hb⟩ }

/-- See also `monotone.map_bdd_below`. -/
lemma bdd_below.image2 : bdd_below s → bdd_below t → bdd_below (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩, exact ⟨f a b, mem_lower_bounds_image2 h₀ h₁ ha hb⟩ }

lemma is_greatest.image2 (ha : is_greatest s a) (hb : is_greatest t b) :
  is_greatest (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1, mem_upper_bounds_image2 h₀ h₁ ha.2 hb.2⟩

lemma is_least.image2 (ha : is_least s a) (hb : is_least t b) : is_least (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1, mem_lower_bounds_image2 h₀ h₁ ha.2 hb.2⟩

end monotone_monotone

section monotone_antitone
variables (h₀ : ∀ b, monotone (swap f b)) (h₁ : ∀ a, antitone (f a))
include h₀ h₁

lemma mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds (ha : a ∈ upper_bounds s)
  (hb : b ∈ lower_bounds t) : f a b ∈ upper_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds (ha : a ∈ lower_bounds s)
  (hb : b ∈ upper_bounds t) : f a b ∈ lower_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma image2_upper_bounds_lower_bounds_subset_upper_bounds_image2 :
  image2 f (upper_bounds s) (lower_bounds t) ⊆ upper_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩,
  exact mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds h₀ h₁ ha hb }

lemma image2_lower_bounds_upper_bounds_subset_lower_bounds_image2 :
  image2 f (lower_bounds s) (upper_bounds t) ⊆ lower_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩,
  exact mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds h₀ h₁ ha hb }

lemma bdd_above.bdd_above_image2_of_bdd_below :
  bdd_above s → bdd_below t → bdd_above (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
  exact ⟨f a b, mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds h₀ h₁ ha hb⟩ }

lemma bdd_below.bdd_below_image2_of_bdd_above :
  bdd_below s → bdd_above t → bdd_below (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
  exact ⟨f a b, mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds h₀ h₁ ha hb⟩ }

lemma is_greatest.is_greatest_image2_of_is_least (ha : is_greatest s a) (hb : is_least t b) :
  is_greatest (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1,
  mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds h₀ h₁ ha.2 hb.2⟩

lemma is_least.is_least_image2_of_is_greatest (ha : is_least s a) (hb : is_greatest t b) :
  is_least (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1,
  mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds h₀ h₁ ha.2 hb.2⟩

end monotone_antitone

section antitone_antitone
variables (h₀ : ∀ b, antitone (swap f b)) (h₁ : ∀ a, antitone (f a))
include h₀ h₁

lemma mem_upper_bounds_image2_of_mem_lower_bounds (ha : a ∈ lower_bounds s)
  (hb : b ∈ lower_bounds t) :
  f a b ∈ upper_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma mem_lower_bounds_image2_of_mem_upper_bounds (ha : a ∈ upper_bounds s)
  (hb : b ∈ upper_bounds t) :
  f a b ∈ lower_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma image2_upper_bounds_upper_bounds_subset_upper_bounds_image2 :
  image2 f (lower_bounds s) (lower_bounds t) ⊆ upper_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_upper_bounds_image2_of_mem_lower_bounds h₀ h₁ ha hb }

lemma image2_lower_bounds_lower_bounds_subset_lower_bounds_image2 :
  image2 f (upper_bounds s) (upper_bounds t) ⊆ lower_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_lower_bounds_image2_of_mem_upper_bounds h₀ h₁ ha hb }

lemma bdd_below.image2_bdd_above : bdd_below s → bdd_below t → bdd_above (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
  exact ⟨f a b, mem_upper_bounds_image2_of_mem_lower_bounds h₀ h₁ ha hb⟩ }

lemma bdd_above.image2_bdd_below : bdd_above s → bdd_above t → bdd_below (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
  exact ⟨f a b, mem_lower_bounds_image2_of_mem_upper_bounds h₀ h₁ ha hb⟩ }

lemma is_least.is_greatest_image2 (ha : is_least s a) (hb : is_least t b) :
  is_greatest (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1, mem_upper_bounds_image2_of_mem_lower_bounds h₀ h₁ ha.2 hb.2⟩

lemma is_greatest.is_least_image2 (ha : is_greatest s a) (hb : is_greatest t b) :
  is_least (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1, mem_lower_bounds_image2_of_mem_upper_bounds h₀ h₁ ha.2 hb.2⟩

end antitone_antitone

section antitone_monotone
variables (h₀ : ∀ b, antitone (swap f b)) (h₁ : ∀ a, monotone (f a))
include h₀ h₁

lemma mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds (ha : a ∈ lower_bounds s)
  (hb : b ∈ upper_bounds t) : f a b ∈ upper_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds (ha : a ∈ upper_bounds s)
  (hb : b ∈ lower_bounds t) : f a b ∈ lower_bounds (image2 f s t) :=
forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy

lemma image2_lower_bounds_upper_bounds_subset_upper_bounds_image2 :
  image2 f (lower_bounds s) (upper_bounds t) ⊆ upper_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩,
  exact mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds h₀ h₁ ha hb }

lemma image2_upper_bounds_lower_bounds_subset_lower_bounds_image2 :
  image2 f (upper_bounds s) (lower_bounds t) ⊆ lower_bounds (image2 f s t) :=
by { rintro _ ⟨a, b, ha, hb, rfl⟩,
  exact mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds h₀ h₁ ha hb }

lemma bdd_below.bdd_above_image2_of_bdd_above :
  bdd_below s → bdd_above t → bdd_above (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
  exact ⟨f a b, mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds h₀ h₁ ha hb⟩ }

lemma bdd_above.bdd_below_image2_of_bdd_above :
  bdd_above s → bdd_below t → bdd_below (image2 f s t) :=
by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
  exact ⟨f a b, mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds h₀ h₁ ha hb⟩ }

lemma is_least.is_greatest_image2_of_is_greatest (ha : is_least s a) (hb : is_greatest t b) :
  is_greatest (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1,
  mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds h₀ h₁ ha.2 hb.2⟩

lemma is_greatest.is_least_image2_of_is_least (ha : is_greatest s a) (hb : is_least t b) :
  is_least (image2 f s t) (f a b) :=
⟨mem_image2_of_mem ha.1 hb.1,
  mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds h₀ h₁ ha.2 hb.2⟩

end antitone_monotone
end image2

lemma is_glb.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
  {s : set α} {x : α} (hx : is_glb (f '' s) (f x)) :
  is_glb s x :=
⟨λ y hy, hf.1 $ hx.1 $ mem_image_of_mem _ hy,
  λ y hy, hf.1 $ hx.2 $ monotone.mem_lower_bounds_image (λ x y, hf.2) hy⟩

lemma is_lub.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
  {s : set α} {x : α} (hx : is_lub (f '' s) (f x)) :
  is_lub s x :=
@is_glb.of_image αᵒᵈ βᵒᵈ _ _ f (λ x y, hf) _ _ hx

lemma is_lub_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
  is_lub s f ↔ ∀ a, is_lub (function.eval a '' s) (f a) :=
begin
  classical,
  refine ⟨λ H a, ⟨(function.monotone_eval a).mem_upper_bounds_image H.1, λ b hb, _⟩, λ H, ⟨_, _⟩⟩,
  { suffices : function.update f a b ∈ upper_bounds s,
      from function.update_same a b f ▸ H.2 this a,
    refine λ g hg, le_update_iff.2 ⟨hb $ mem_image_of_mem _ hg, λ i hi, H.1 hg i⟩ },
  { exact λ g hg a, (H a).1 (mem_image_of_mem _ hg) },
  { exact λ g hg a, (H a).2 ((function.monotone_eval a).mem_upper_bounds_image hg) }
end

lemma is_glb_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
  is_glb s f ↔ ∀ a, is_glb (function.eval a '' s) (f a) :=
@is_lub_pi α (λ a, (π a)ᵒᵈ) _ s f

lemma is_lub_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
  is_lub s p ↔ is_lub (prod.fst '' s) p.1 ∧ is_lub (prod.snd '' s) p.2 :=
begin
  refine ⟨λ H, ⟨⟨monotone_fst.mem_upper_bounds_image H.1, λ a ha, _⟩,
    ⟨monotone_snd.mem_upper_bounds_image H.1, λ a ha, _⟩⟩, λ H, ⟨_, _⟩⟩,
  { suffices : (a, p.2) ∈ upper_bounds s, from (H.2 this).1,
    exact λ q hq, ⟨ha $ mem_image_of_mem _ hq, (H.1 hq).2⟩ },
  { suffices : (p.1, a) ∈ upper_bounds s, from (H.2 this).2,
    exact λ q hq, ⟨(H.1 hq).1, ha $ mem_image_of_mem _ hq⟩ },
  { exact λ q hq, ⟨H.1.1 $ mem_image_of_mem _ hq, H.2.1 $ mem_image_of_mem _ hq⟩ },
  { exact λ q hq, ⟨H.1.2 $ monotone_fst.mem_upper_bounds_image hq,
      H.2.2 $ monotone_snd.mem_upper_bounds_image hq⟩ }
end

lemma is_glb_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
  is_glb s p ↔ is_glb (prod.fst '' s) p.1 ∧ is_glb (prod.snd '' s) p.2 :=
@is_lub_prod αᵒᵈ βᵒᵈ _ _ _ _

namespace order_iso

variables [preorder α] [preorder β] (f : α ≃o β)

lemma upper_bounds_image {s : set α} :
  upper_bounds (f '' s) = f '' upper_bounds s :=
subset.antisymm
  (λ x hx, ⟨f.symm x, λ y hy, f.le_symm_apply.2 (hx $ mem_image_of_mem _ hy), f.apply_symm_apply x⟩)
  f.monotone.image_upper_bounds_subset_upper_bounds_image

lemma lower_bounds_image {s : set α} : lower_bounds (f '' s) = f '' lower_bounds s :=
@upper_bounds_image αᵒᵈ βᵒᵈ _ _ f.dual _

@[simp] lemma is_lub_image {s : set α} {x : β} :
  is_lub (f '' s) x ↔ is_lub s (f.symm x) :=
⟨λ h, is_lub.of_image (λ _ _, f.le_iff_le) ((f.apply_symm_apply x).symm ▸ h),
  λ h, is_lub.of_image (λ _ _, f.symm.le_iff_le) $ (f.symm_image_image s).symm ▸ h⟩

lemma is_lub_image' {s : set α} {x : α} :
  is_lub (f '' s) (f x) ↔ is_lub s x :=
by rw [is_lub_image, f.symm_apply_apply]

@[simp] lemma is_glb_image {s : set α} {x : β} :
  is_glb (f '' s) x ↔ is_glb s (f.symm x) :=
f.dual.is_lub_image

lemma is_glb_image' {s : set α} {x : α} :
  is_glb (f '' s) (f x) ↔ is_glb s x :=
f.dual.is_lub_image'

@[simp] lemma is_lub_preimage {s : set β} {x : α} :
  is_lub (f ⁻¹' s) x ↔ is_lub s (f x) :=
by rw [← f.symm_symm, ← image_eq_preimage, is_lub_image]

lemma is_lub_preimage' {s : set β} {x : β} :
  is_lub (f ⁻¹' s) (f.symm x) ↔ is_lub s x :=
by rw [is_lub_preimage, f.apply_symm_apply]

@[simp] lemma is_glb_preimage {s : set β} {x : α} :
  is_glb (f ⁻¹' s) x ↔ is_glb s (f x) :=
f.dual.is_lub_preimage

lemma is_glb_preimage' {s : set β} {x : β} :
  is_glb (f ⁻¹' s) (f.symm x) ↔ is_glb s x :=
f.dual.is_lub_preimage'

end order_iso