/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import order.bounds
import data.set.intervals.basic
import data.set.finite
import data.set.lattice

/-!
# Theory of conditionally complete lattices.

A conditionally complete lattice is a lattice in which every non-empty bounded subset s
has a least upper bound and a greatest lower bound, denoted below by Sup s and Inf s.
Typical examples are real, nat, int with their usual orders.

The theory is very comparable to the theory of complete lattices, except that suitable
boundedness and nonemptiness assumptions have to be added to most statements.
We introduce two predicates bdd_above and bdd_below to express this boundedness, prove
their basic properties, and then go on to prove most useful properties of Sup and Inf
in conditionally complete lattices.

To differentiate the statements between complete lattices and conditionally complete
lattices, we prefix Inf and Sup in the statements by c, giving cInf and cSup. For instance,
Inf_le is a statement in complete lattices ensuring Inf s ≤ x, while cInf_le is the same
statement in conditionally complete lattices with an additional assumption that s is
bounded below.
-/

set_option old_structure_cmd true

open set

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

section

/-!
Extension of Sup and Inf from a preorder `α` to `with_top α` and `with_bot α`
-/

open_locale classical

noncomputable instance {α : Type*} [preorder α] [has_Sup α] : has_Sup (with_top α) :=
⟨λ S, if ⊤ ∈ S then ⊤ else
  if bdd_above (coe ⁻¹' S : set α) then ↑(Sup (coe ⁻¹' S : set α)) else ⊤⟩

noncomputable instance {α : Type*} [has_Inf α] : has_Inf (with_top α) :=
⟨λ S, if S ⊆ {⊤} then ⊤ else ↑(Inf (coe ⁻¹' S : set α))⟩

noncomputable instance {α : Type*} [has_Sup α] : has_Sup (with_bot α) :=
⟨(@with_top.has_Inf (order_dual α) _).Inf⟩

noncomputable instance {α : Type*} [preorder α] [has_Inf α] : has_Inf (with_bot α) :=
⟨(@with_top.has_Sup (order_dual α) _ _).Sup⟩

@[simp]
theorem with_top.cInf_empty {α : Type*} [has_Inf α] : Inf (∅ : set (with_top α)) = ⊤ :=
if_pos $ set.empty_subset _

@[simp]
theorem with_bot.cSup_empty {α : Type*} [has_Sup α] : Sup (∅ : set (with_bot α)) = ⊥ :=
if_pos $ set.empty_subset _

end -- section

/-- A conditionally complete lattice is a lattice in which
every nonempty subset which is bounded above has a supremum, and
every nonempty subset which is bounded below has an infimum.
Typical examples are real numbers or natural numbers.

To differentiate the statements from the corresponding statements in (unconditional)
complete lattices, we prefix Inf and Sup by a c everywhere. The same statements should
hold in both worlds, sometimes with additional assumptions of nonemptiness or
boundedness.-/
class conditionally_complete_lattice (α : Type*) extends lattice α, has_Sup α, has_Inf α :=
(le_cSup : ∀s a, bdd_above s → a ∈ s → a ≤ Sup s)
(cSup_le : ∀ s a, set.nonempty s → a ∈ upper_bounds s → Sup s ≤ a)
(cInf_le : ∀s a, bdd_below s → a ∈ s → Inf s ≤ a)
(le_cInf : ∀s a, set.nonempty s → a ∈ lower_bounds s → a ≤ Inf s)

/-- A conditionally complete linear order is a linear order in which
every nonempty subset which is bounded above has a supremum, and
every nonempty subset which is bounded below has an infimum.
Typical examples are real numbers or natural numbers.

To differentiate the statements from the corresponding statements in (unconditional)
complete linear orders, we prefix Inf and Sup by a c everywhere. The same statements should
hold in both worlds, sometimes with additional assumptions of nonemptiness or
boundedness.-/
class conditionally_complete_linear_order (α : Type*)
  extends conditionally_complete_lattice α, linear_order α renaming max → sup min → inf

/-- A conditionally complete linear order with `bot` is a linear order with least element, in which
every nonempty subset which is bounded above has a supremum, and every nonempty subset (necessarily
bounded below) has an infimum.  A typical example is the natural numbers.

To differentiate the statements from the corresponding statements in (unconditional)
complete linear orders, we prefix Inf and Sup by a c everywhere. The same statements should
hold in both worlds, sometimes with additional assumptions of nonemptiness or
boundedness.-/
@[ancestor conditionally_complete_linear_order has_bot]
class conditionally_complete_linear_order_bot (α : Type*)
  extends conditionally_complete_linear_order α, has_bot α :=
(bot_le : ∀ x : α, ⊥ ≤ x)
(cSup_empty : Sup ∅ = ⊥)

@[priority 100]  -- see Note [lower instance priority]
instance conditionally_complete_linear_order_bot.to_order_bot
  [h : conditionally_complete_linear_order_bot α] : order_bot α :=
{ ..h }

/-- A complete lattice is a conditionally complete lattice, as there are no restrictions
on the properties of Inf and Sup in a complete lattice.-/
@[priority 100] -- see Note [lower instance priority]
instance complete_lattice.to_conditionally_complete_lattice [complete_lattice α] :
  conditionally_complete_lattice α :=
{ le_cSup := by intros; apply le_Sup; assumption,
  cSup_le := by intros; apply Sup_le; assumption,
  cInf_le := by intros; apply Inf_le; assumption,
  le_cInf := by intros; apply le_Inf; assumption,
  ..‹complete_lattice α› }

@[priority 100] -- see Note [lower instance priority]
instance complete_linear_order.to_conditionally_complete_linear_order_bot {α : Type*}
  [complete_linear_order α] :
  conditionally_complete_linear_order_bot α :=
{ cSup_empty := Sup_empty,
  ..complete_lattice.to_conditionally_complete_lattice, .. ‹complete_linear_order α› }

section
open_locale classical

/-- A well founded linear order is conditionally complete, with a bottom element. -/
@[reducible] noncomputable def well_founded.conditionally_complete_linear_order_with_bot
  {α : Type*} [i : linear_order α] (h : well_founded ((<) : α → α → Prop))
  (c : α) (hc : c = h.min set.univ ⟨c, mem_univ c⟩) :
  conditionally_complete_linear_order_bot α :=
{ sup := max,
  le_sup_left := le_max_left,
  le_sup_right := le_max_right,
  sup_le := λ a b c, max_le,
  inf := min,
  inf_le_left := min_le_left,
  inf_le_right := min_le_right,
  le_inf := λ a b c, le_min,
  Inf := λ s, if hs : s.nonempty then h.min s hs else c,
  cInf_le := begin
    assume s a hs has,
    have s_ne : s.nonempty := ⟨a, has⟩,
    simpa [s_ne] using not_lt.1 (h.not_lt_min s s_ne has),
  end,
  le_cInf := begin
    assume s a hs has,
    simp only [hs, dif_pos],
    exact has (h.min_mem s hs),
  end,
  Sup := λ s, if hs : (upper_bounds s).nonempty then h.min _ hs else c,
  le_cSup := begin
    assume s a hs has,
    have h's : (upper_bounds s).nonempty := hs,
    simp only [h's, dif_pos],
    exact h.min_mem _ h's has,
  end,
  cSup_le := begin
    assume s a hs has,
    have h's : (upper_bounds s).nonempty := ⟨a, has⟩,
    simp only [h's, dif_pos],
    simpa using h.not_lt_min _ h's has,
  end,
  bot := c,
  bot_le := λ x, by convert not_lt.1 (h.not_lt_min set.univ ⟨c, mem_univ c⟩ (mem_univ x)),
  cSup_empty := begin
    have : (set.univ : set α).nonempty := ⟨c, mem_univ c⟩,
    simp only [this, dif_pos, upper_bounds_empty],
    exact hc.symm
  end,
  .. i }

end

section order_dual

instance (α : Type*) [conditionally_complete_lattice α] :
  conditionally_complete_lattice (order_dual α) :=
{ le_cSup := @conditionally_complete_lattice.cInf_le α _,
  cSup_le := @conditionally_complete_lattice.le_cInf α _,
  le_cInf := @conditionally_complete_lattice.cSup_le α _,
  cInf_le := @conditionally_complete_lattice.le_cSup α _,
  ..order_dual.has_Inf α,
  ..order_dual.has_Sup α,
  ..order_dual.lattice α }

instance (α : Type*) [conditionally_complete_linear_order α] :
  conditionally_complete_linear_order (order_dual α) :=
{ ..order_dual.conditionally_complete_lattice α,
  ..order_dual.linear_order α }

end order_dual

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

theorem le_cSup (h₁ : bdd_above s) (h₂ : a ∈ s) : a ≤ Sup s :=
conditionally_complete_lattice.le_cSup s a h₁ h₂

theorem cSup_le (h₁ : s.nonempty) (h₂ : ∀b∈s, b ≤ a) : Sup s ≤ a :=
conditionally_complete_lattice.cSup_le s a h₁ h₂

theorem cInf_le (h₁ : bdd_below s) (h₂ : a ∈ s) : Inf s ≤ a :=
conditionally_complete_lattice.cInf_le s a h₁ h₂

theorem le_cInf (h₁ : s.nonempty) (h₂ : ∀b∈s, a ≤ b) : a ≤ Inf s :=
conditionally_complete_lattice.le_cInf s a h₁ h₂

theorem le_cSup_of_le (_ : bdd_above s) (hb : b ∈ s) (h : a ≤ b) : a ≤ Sup s :=
le_trans h (le_cSup ‹bdd_above s› hb)

theorem cInf_le_of_le (_ : bdd_below s) (hb : b ∈ s) (h : b ≤ a) : Inf s ≤ a :=
le_trans (cInf_le ‹bdd_below s› hb) h

theorem cSup_le_cSup (_ : bdd_above t) (_ : s.nonempty) (h : s ⊆ t) : Sup s ≤ Sup t :=
cSup_le ‹_› (assume (a) (ha : a ∈ s), le_cSup ‹bdd_above t› (h ha))

theorem cInf_le_cInf (_ : bdd_below t) (_ : s.nonempty) (h : s ⊆ t) : Inf t ≤ Inf s :=
le_cInf ‹_› (assume (a) (ha : a ∈ s), cInf_le ‹bdd_below t› (h ha))

lemma is_lub_cSup (ne : s.nonempty) (H : bdd_above s) : is_lub s (Sup s) :=
⟨assume x, le_cSup H, assume x, cSup_le ne⟩

lemma is_lub_csupr [nonempty ι] {f : ι → α} (H : bdd_above (range f)) :
  is_lub (range f) (⨆ i, f i) :=
is_lub_cSup (range_nonempty f) H

lemma is_lub_csupr_set {f : β → α} {s : set β} (H : bdd_above (f '' s)) (Hne : s.nonempty) :
  is_lub (f '' s) (⨆ i : s, f i) :=
by { rw ← Sup_image', exact is_lub_cSup (Hne.image _) H }

lemma is_glb_cInf (ne : s.nonempty) (H : bdd_below s) : is_glb s (Inf s) :=
⟨assume x, cInf_le H, assume x, le_cInf ne⟩

lemma is_glb_cinfi [nonempty ι] {f : ι → α} (H : bdd_below (range f)) :
  is_glb (range f) (⨅ i, f i) :=
is_glb_cInf (range_nonempty f) H

lemma is_glb_cinfi_set {f : β → α} {s : set β} (H : bdd_below (f '' s)) (Hne : s.nonempty) :
  is_glb (f '' s) (⨅ i : s, f i) :=
@is_lub_csupr_set (order_dual α) _ _ _ _ H Hne

lemma is_lub.cSup_eq (H : is_lub s a) (ne : s.nonempty) : Sup s = a :=
(is_lub_cSup ne ⟨a, H.1⟩).unique H

lemma is_lub.csupr_eq [nonempty ι] {f : ι → α} (H : is_lub (range f) a) : (⨆ i, f i) = a :=
H.cSup_eq (range_nonempty f)

lemma is_lub.csupr_set_eq {s : set β} {f : β → α} (H : is_lub (f '' s) a) (Hne : s.nonempty) :
  (⨆ i : s, f i) = a :=
is_lub.cSup_eq (image_eq_range f s ▸ H) (image_eq_range f s ▸ Hne.image f)

/-- A greatest element of a set is the supremum of this set. -/
lemma is_greatest.cSup_eq (H : is_greatest s a) : Sup s = a :=
H.is_lub.cSup_eq H.nonempty

lemma is_greatest.Sup_mem (H : is_greatest s a) : Sup s ∈ s :=
H.cSup_eq.symm ▸ H.1

lemma is_glb.cInf_eq (H : is_glb s a) (ne : s.nonempty) : Inf s = a :=
(is_glb_cInf ne ⟨a, H.1⟩).unique H

lemma is_glb.cinfi_eq [nonempty ι] {f : ι → α} (H : is_glb (range f) a) : (⨅ i, f i) = a :=
H.cInf_eq (range_nonempty f)

lemma is_glb.cinfi_set_eq {s : set β} {f : β → α} (H : is_glb (f '' s) a) (Hne : s.nonempty) :
  (⨅ i : s, f i) = a :=
is_glb.cInf_eq (image_eq_range f s ▸ H) (image_eq_range f s ▸ Hne.image f)

/-- A least element of a set is the infimum of this set. -/
lemma is_least.cInf_eq (H : is_least s a) : Inf s = a :=
H.is_glb.cInf_eq H.nonempty

lemma is_least.Inf_mem (H : is_least s a) : Inf s ∈ s :=
H.cInf_eq.symm ▸ H.1

lemma subset_Icc_cInf_cSup (hb : bdd_below s) (ha : bdd_above s) :
  s ⊆ Icc (Inf s) (Sup s) :=
λ x hx, ⟨cInf_le hb hx, le_cSup ha hx⟩

theorem cSup_le_iff (hb : bdd_above s) (ne : s.nonempty) : Sup s ≤ a ↔ (∀b ∈ s, b ≤ a) :=
is_lub_le_iff (is_lub_cSup ne hb)

theorem le_cInf_iff (hb : bdd_below s) (ne : s.nonempty) : a ≤ Inf s ↔ (∀b ∈ s, a ≤ b) :=
le_is_glb_iff (is_glb_cInf ne hb)

lemma cSup_lower_bounds_eq_cInf {s : set α} (h : bdd_below s) (hs : s.nonempty) :
  Sup (lower_bounds s) = Inf s :=
(is_lub_cSup h $ hs.mono $ λ x hx y hy, hy hx).unique (is_glb_cInf hs h).is_lub

lemma cInf_upper_bounds_eq_cSup {s : set α} (h : bdd_above s) (hs : s.nonempty) :
  Inf (upper_bounds s) = Sup s :=
(is_glb_cInf h $ hs.mono $ λ x hx y hy, hy hx).unique (is_lub_cSup hs h).is_glb

lemma not_mem_of_lt_cInf {x : α} {s : set α} (h : x < Inf s) (hs : bdd_below s) : x ∉ s :=
λ hx, lt_irrefl _ (h.trans_le (cInf_le hs hx))

lemma not_mem_of_cSup_lt {x : α} {s : set α} (h : Sup s < x) (hs : bdd_above s) : x ∉ s :=
@not_mem_of_lt_cInf (order_dual α) _ x s h hs

/--Introduction rule to prove that `b` is the supremum of `s`: it suffices to check that `b`
is larger than all elements of `s`, and that this is not the case of any `w<b`.
See `Sup_eq_of_forall_le_of_forall_lt_exists_gt` for a version in complete lattices. -/
theorem cSup_eq_of_forall_le_of_forall_lt_exists_gt (_ : s.nonempty)
  (_ : ∀a∈s, a ≤ b) (H : ∀w, w < b → (∃a∈s, w < a)) : Sup s = b :=
have bdd_above s := ⟨b, by assumption⟩,
have (Sup s < b) ∨ (Sup s = b) := lt_or_eq_of_le (cSup_le ‹_› ‹∀a∈s, a ≤ b›),
have h : ¬(Sup s < b) :=
  assume: Sup s < b,
  let ⟨a, _, _⟩ := (H (Sup s) ‹Sup s < b›) in  /- a ∈ s, Sup s < a-/
  have Sup s < Sup s := lt_of_lt_of_le ‹Sup s < a› (le_cSup ‹bdd_above s› ‹a ∈ s›),
  show false, by { exact lt_irrefl (Sup s) this },
show Sup s = b, by { cases this with h1, { cases h h1 }, { assumption } }

/--Introduction rule to prove that `b` is the infimum of `s`: it suffices to check that `b`
is smaller than all elements of `s`, and that this is not the case of any `w>b`.
See `Inf_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in complete lattices. -/
theorem cInf_eq_of_forall_ge_of_forall_gt_exists_lt (_ : s.nonempty) (_ : ∀a∈s, b ≤ a)
  (H : ∀w, b < w → (∃a∈s, a < w)) : Inf s = b :=
@cSup_eq_of_forall_le_of_forall_lt_exists_gt (order_dual α) _ _ _ ‹_› ‹_› ‹_›

/--b < Sup s when there is an element a in s with b < a, when s is bounded above.
This is essentially an iff, except that the assumptions for the two implications are
slightly different (one needs boundedness above for one direction, nonemptiness and linear
order for the other one), so we formulate separately the two implications, contrary to
the complete_lattice case.-/
lemma lt_cSup_of_lt (_ : bdd_above s) (_ : a ∈ s) (_ : b < a) : b < Sup s :=
lt_of_lt_of_le ‹b < a› (le_cSup ‹bdd_above s› ‹a ∈ s›)

/--Inf s < b when there is an element a in s with a < b, when s is bounded below.
This is essentially an iff, except that the assumptions for the two implications are
slightly different (one needs boundedness below for one direction, nonemptiness and linear
order for the other one), so we formulate separately the two implications, contrary to
the complete_lattice case.-/
lemma cInf_lt_of_lt (_ : bdd_below s) (_ : a ∈ s) (_ : a < b) : Inf s < b :=
@lt_cSup_of_lt (order_dual α) _ _ _ _ ‹_› ‹_› ‹_›

/-- If all elements of a nonempty set `s` are less than or equal to all elements
of a nonempty set `t`, then there exists an element between these sets. -/
lemma exists_between_of_forall_le (sne : s.nonempty) (tne : t.nonempty)
  (hst : ∀ (x ∈ s) (y ∈ t), x ≤ y) :
  (upper_bounds s ∩ lower_bounds t).nonempty :=
⟨Inf t, λ x hx, le_cInf tne $ hst x hx, λ y hy, cInf_le (sne.mono hst) hy⟩

/--The supremum of a singleton is the element of the singleton-/
@[simp] theorem cSup_singleton (a : α) : Sup {a} = a :=
is_greatest_singleton.cSup_eq

/--The infimum of a singleton is the element of the singleton-/
@[simp] theorem cInf_singleton (a : α) : Inf {a} = a :=
is_least_singleton.cInf_eq

@[simp] theorem cSup_pair (a b : α) : Sup {a, b} = a ⊔ b :=
(@is_lub_pair _ _ a b).cSup_eq (nonempty_insert _ _)

@[simp] theorem cInf_pair (a b : α) : Inf {a, b} = a ⊓ b :=
(@is_glb_pair _ _ a b).cInf_eq (nonempty_insert _ _)

/--If a set is bounded below and above, and nonempty, its infimum is less than or equal to
its supremum.-/
theorem cInf_le_cSup (hb : bdd_below s) (ha : bdd_above s) (ne : s.nonempty) : Inf s ≤ Sup s :=
is_glb_le_is_lub (is_glb_cInf ne hb) (is_lub_cSup ne ha) ne

/--The sup of a union of two sets is the max of the suprema of each subset, under the assumptions
that all sets are bounded above and nonempty.-/
theorem cSup_union (hs : bdd_above s) (sne : s.nonempty) (ht : bdd_above t) (tne : t.nonempty) :
  Sup (s ∪ t) = Sup s ⊔ Sup t :=
((is_lub_cSup sne hs).union (is_lub_cSup tne ht)).cSup_eq sne.inl

/--The inf of a union of two sets is the min of the infima of each subset, under the assumptions
that all sets are bounded below and nonempty.-/
theorem cInf_union (hs : bdd_below s) (sne : s.nonempty) (ht : bdd_below t) (tne : t.nonempty) :
  Inf (s ∪ t) = Inf s ⊓ Inf t :=
@cSup_union (order_dual α) _ _ _ hs sne ht tne

/--The supremum of an intersection of two sets is bounded by the minimum of the suprema of each
set, if all sets are bounded above and nonempty.-/
theorem cSup_inter_le (_ : bdd_above s) (_ : bdd_above t) (hst : (s ∩ t).nonempty) :
  Sup (s ∩ t) ≤ Sup s ⊓ Sup t :=
begin
  apply cSup_le hst, simp only [le_inf_iff, and_imp, set.mem_inter_eq], intros b _ _, split,
  apply le_cSup ‹bdd_above s› ‹b ∈ s›,
  apply le_cSup ‹bdd_above t› ‹b ∈ t›
end

/--The infimum of an intersection of two sets is bounded below by the maximum of the
infima of each set, if all sets are bounded below and nonempty.-/
theorem le_cInf_inter (_ : bdd_below s) (_ : bdd_below t) (hst : (s ∩ t).nonempty) :
  Inf s ⊔ Inf t ≤ Inf (s ∩ t) :=
@cSup_inter_le (order_dual α) _ _ _ ‹_› ‹_› hst

/-- The supremum of insert a s is the maximum of a and the supremum of s, if s is
nonempty and bounded above.-/
theorem cSup_insert (hs : bdd_above s) (sne : s.nonempty) : Sup (insert a s) = a ⊔ Sup s :=
((is_lub_cSup sne hs).insert a).cSup_eq (insert_nonempty a s)

/-- The infimum of insert a s is the minimum of a and the infimum of s, if s is
nonempty and bounded below.-/
theorem cInf_insert (hs : bdd_below s) (sne : s.nonempty) : Inf (insert a s) = a ⊓ Inf s :=
@cSup_insert (order_dual α) _ _ _ hs sne

@[simp] lemma cInf_Icc (h : a ≤ b) : Inf (Icc a b) = a :=
(is_glb_Icc h).cInf_eq (nonempty_Icc.2 h)

@[simp] lemma cInf_Ici : Inf (Ici a) = a := is_least_Ici.cInf_eq

@[simp] lemma cInf_Ico (h : a < b) : Inf (Ico a b) = a :=
(is_glb_Ico h).cInf_eq (nonempty_Ico.2 h)

@[simp] lemma cInf_Ioc [densely_ordered α] (h : a < b) : Inf (Ioc a b) = a :=
(is_glb_Ioc h).cInf_eq (nonempty_Ioc.2 h)

@[simp] lemma cInf_Ioi [no_max_order α] [densely_ordered α] : Inf (Ioi a) = a :=
cInf_eq_of_forall_ge_of_forall_gt_exists_lt nonempty_Ioi (λ _, le_of_lt)
  (λ w hw, by simpa using exists_between hw)

@[simp] lemma cInf_Ioo [densely_ordered α] (h : a < b) : Inf (Ioo a b) = a :=
(is_glb_Ioo h).cInf_eq (nonempty_Ioo.2 h)

@[simp] lemma cSup_Icc (h : a ≤ b) : Sup (Icc a b) = b :=
(is_lub_Icc h).cSup_eq (nonempty_Icc.2 h)

@[simp] lemma cSup_Ico [densely_ordered α] (h : a < b) : Sup (Ico a b) = b :=
(is_lub_Ico h).cSup_eq (nonempty_Ico.2 h)

@[simp] lemma cSup_Iic : Sup (Iic a) = a := is_greatest_Iic.cSup_eq

@[simp] lemma cSup_Iio [no_min_order α] [densely_ordered α] : Sup (Iio a) = a :=
cSup_eq_of_forall_le_of_forall_lt_exists_gt nonempty_Iio (λ _, le_of_lt)
  (λ w hw, by simpa [and_comm] using exists_between hw)

@[simp] lemma cSup_Ioc (h : a < b) : Sup (Ioc a b) = b :=
(is_lub_Ioc h).cSup_eq (nonempty_Ioc.2 h)

@[simp] lemma cSup_Ioo [densely_ordered α] (h : a < b) : Sup (Ioo a b) = b :=
(is_lub_Ioo h).cSup_eq (nonempty_Ioo.2 h)

/--The indexed supremum of a function is bounded above by a uniform bound-/
lemma csupr_le [nonempty ι] {f : ι → α} {c : α} (H : ∀x, f x ≤ c) : supr f ≤ c :=
cSup_le (range_nonempty f) (by rwa forall_range_iff)

/--The indexed supremum of a function is bounded below by the value taken at one point-/
lemma le_csupr {f : ι → α} (H : bdd_above (range f)) (c : ι) : f c ≤ supr f :=
le_cSup H (mem_range_self _)

lemma le_csupr_of_le {f : ι → α} (H : bdd_above (range f)) (c : ι) (h : a ≤ f c) : a ≤ supr f :=
le_trans h (le_csupr H c)

/--The indexed supremum of two functions are comparable if the functions are pointwise comparable-/
lemma csupr_le_csupr {f g : ι → α} (B : bdd_above (range g)) (H : ∀x, f x ≤ g x) :
  supr f ≤ supr g :=
begin
  casesI is_empty_or_nonempty ι,
  { rw [supr_of_empty', supr_of_empty'] },
  { exact csupr_le (λ x, le_csupr_of_le B x (H x)) },
end

/--The indexed infimum of two functions are comparable if the functions are pointwise comparable-/
lemma cinfi_le_cinfi {f g : ι → α} (B : bdd_below (range f)) (H : ∀x, f x ≤ g x) :
  infi f ≤ infi g :=
@csupr_le_csupr (order_dual α) _ _ _ _ B H

/--The indexed minimum of a function is bounded below by a uniform lower bound-/
lemma le_cinfi [nonempty ι] {f : ι → α} {c : α} (H : ∀x, c ≤ f x) : c ≤ infi f :=
@csupr_le (order_dual α) _ _ _ _ _ H

/--The indexed infimum of a function is bounded above by the value taken at one point-/
lemma cinfi_le {f : ι → α} (H : bdd_below (range f)) (c : ι) : infi f ≤ f c :=
@le_csupr (order_dual α) _ _ _ H c

lemma cinfi_le_of_le {f : ι → α} (H : bdd_below (range f)) (c : ι) (h : f c ≤ a) : infi f ≤ a :=
@le_csupr_of_le (order_dual α) _ _ _ _ H c h

@[simp] theorem csupr_const [hι : nonempty ι] {a : α} : (⨆ b:ι, a) = a :=
by rw [supr, range_const, cSup_singleton]

@[simp] theorem cinfi_const [hι : nonempty ι] {a : α} : (⨅ b:ι, a) = a :=
@csupr_const (order_dual α) _ _ _ _

theorem supr_unique [unique ι] {s : ι → α} : (⨆ i, s i) = s default :=
have ∀ i, s i = s default := λ i, congr_arg s (unique.eq_default i),
by simp only [this, csupr_const]

theorem infi_unique [unique ι] {s : ι → α} : (⨅ i, s i) = s default :=
@supr_unique (order_dual α) _ _ _ _

@[simp] theorem supr_unit {f : unit → α} : (⨆ x, f x) = f () :=
by { convert supr_unique, apply_instance }

@[simp] theorem infi_unit {f : unit → α} : (⨅ x, f x) = f () :=
@supr_unit (order_dual α) _ _

@[simp] lemma csupr_pos {p : Prop} {f : p → α} (hp : p) : (⨆ h : p, f h) = f hp :=
by haveI := unique_prop hp; exact supr_unique

@[simp] lemma cinfi_pos {p : Prop} {f : p → α} (hp : p) : (⨅ h : p, f h) = f hp :=
@csupr_pos (order_dual α) _ _ _ hp

lemma csupr_set {s : set β} {f : β → α} : (⨆ x : s, f x) = Sup (f '' s) :=
begin
  rw supr,
  congr,
  ext,
  rw [mem_image, mem_range, set_coe.exists],
  simp_rw [subtype.coe_mk, exists_prop],
end

lemma cinfi_set {s : set β} {f : β → α} : (⨅ x : s, f x) = Inf (f '' s) :=
@csupr_set (order_dual α) _ _ _ _

/--Introduction rule to prove that `b` is the supremum of `f`: it suffices to check that `b`
is larger than `f i` for all `i`, and that this is not the case of any `w<b`.
See `supr_eq_of_forall_le_of_forall_lt_exists_gt` for a version in complete lattices. -/
theorem csupr_eq_of_forall_le_of_forall_lt_exists_gt [nonempty ι] {f : ι → α} (h₁ : ∀ i, f i ≤ b)
  (h₂ : ∀ w, w < b → (∃ i, w < f i)) : (⨆ (i : ι), f i) = b :=
cSup_eq_of_forall_le_of_forall_lt_exists_gt (range_nonempty f) (forall_range_iff.mpr h₁)
  (λ w hw, exists_range_iff.mpr $ h₂ w hw)

/--Introduction rule to prove that `b` is the infimum of `f`: it suffices to check that `b`
is smaller than `f i` for all `i`, and that this is not the case of any `w>b`.
See `infi_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in complete lattices. -/
theorem cinfi_eq_of_forall_ge_of_forall_gt_exists_lt [nonempty ι] {f : ι → α} (h₁ : ∀ i, b ≤ f i)
  (h₂ : ∀ w, b < w → (∃ i, f i < w)) : (⨅ (i : ι), f i) = b :=
@csupr_eq_of_forall_le_of_forall_lt_exists_gt (order_dual α) _ _ _ _ ‹_› ‹_› ‹_›

/-- Nested intervals lemma: if `f` is a monotone sequence, `g` is an antitone sequence, and
`f n ≤ g n` for all `n`, then `⨆ n, f n` belongs to all the intervals `[f n, g n]`. -/
lemma monotone.csupr_mem_Inter_Icc_of_antitone [semilattice_sup β]
  {f g : β → α} (hf : monotone f) (hg : antitone g) (h : f ≤ g) :
  (⨆ n, f n) ∈ ⋂ n, Icc (f n) (g n) :=
begin
  refine mem_Inter.2 (λ n, _),
  haveI : nonempty β := ⟨n⟩,
  have : ∀ m, f m ≤ g n := λ m, hf.forall_le_of_antitone hg h m n,
  exact ⟨le_csupr ⟨g $ n, forall_range_iff.2 this⟩ _, csupr_le this⟩
end

/-- Nested intervals lemma: if `[f n, g n]` is an antitone sequence of nonempty
closed intervals, then `⨆ n, f n` belongs to all the intervals `[f n, g n]`. -/
lemma csupr_mem_Inter_Icc_of_antitone_Icc [semilattice_sup β]
  {f g : β → α} (h : antitone (λ n, Icc (f n) (g n))) (h' : ∀ n, f n ≤ g n) :
  (⨆ n, f n) ∈ ⋂ n, Icc (f n) (g n) :=
monotone.csupr_mem_Inter_Icc_of_antitone (λ m n hmn, ((Icc_subset_Icc_iff (h' n)).1 (h hmn)).1)
  (λ m n hmn, ((Icc_subset_Icc_iff (h' n)).1 (h hmn)).2) h'

lemma finset.nonempty.sup'_eq_cSup_image {s : finset β} (hs : s.nonempty) (f : β → α) :
  s.sup' hs f = Sup (f '' s) :=
eq_of_forall_ge_iff $ λ a,
  by simp [cSup_le_iff (s.finite_to_set.image f).bdd_above (hs.to_set.image f)]

lemma finset.nonempty.sup'_id_eq_cSup {s : finset α} (hs : s.nonempty) :
  s.sup' hs id = Sup s :=
by rw [hs.sup'_eq_cSup_image, image_id]

end conditionally_complete_lattice

instance pi.conditionally_complete_lattice {ι : Type*} {α : Π i : ι, Type*}
  [Π i, conditionally_complete_lattice (α i)] :
  conditionally_complete_lattice (Π i, α i) :=
{ le_cSup := λ s f ⟨g, hg⟩ hf i, le_cSup ⟨g i, set.forall_range_iff.2 $ λ ⟨f', hf'⟩, hg hf' i⟩
    ⟨⟨f, hf⟩, rfl⟩,
  cSup_le := λ s f hs hf i, cSup_le (by haveI := hs.to_subtype; apply range_nonempty) $
    λ b ⟨⟨g, hg⟩, hb⟩, hb ▸ hf hg i,
  cInf_le := λ s f ⟨g, hg⟩ hf i, cInf_le ⟨g i, set.forall_range_iff.2 $ λ ⟨f', hf'⟩, hg hf' i⟩
    ⟨⟨f, hf⟩, rfl⟩,
  le_cInf := λ s f hs hf i, le_cInf (by haveI := hs.to_subtype; apply range_nonempty) $
    λ b ⟨⟨g, hg⟩, hb⟩, hb ▸ hf hg i,
  .. pi.lattice, .. pi.has_Sup, .. pi.has_Inf }

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

lemma finset.nonempty.cSup_eq_max' {s : finset α} (h : s.nonempty) : Sup ↑s = s.max' h :=
eq_of_forall_ge_iff $ λ a, (cSup_le_iff s.bdd_above h.to_set).trans (s.max'_le_iff h).symm

lemma finset.nonempty.cInf_eq_min' {s : finset α} (h : s.nonempty) : Inf ↑s = s.min' h :=
@finset.nonempty.cSup_eq_max' (order_dual α) _ s h

lemma finset.nonempty.cSup_mem {s : finset α} (h : s.nonempty) : Sup (s : set α) ∈ s :=
by { rw h.cSup_eq_max', exact s.max'_mem _ }

lemma finset.nonempty.cInf_mem {s : finset α} (h : s.nonempty) : Inf (s : set α) ∈ s :=
@finset.nonempty.cSup_mem (order_dual α) _ _ h

lemma set.nonempty.cSup_mem (h : s.nonempty) (hs : finite s) : Sup s ∈ s :=
by { lift s to finset α using hs, exact finset.nonempty.cSup_mem h }

lemma set.nonempty.cInf_mem (h : s.nonempty) (hs : finite s) : Inf s ∈ s :=
@set.nonempty.cSup_mem (order_dual α) _ _ h hs

lemma set.finite.cSup_lt_iff (hs : finite s) (h : s.nonempty) : Sup s < a ↔ ∀ x ∈ s, x < a :=
⟨λ h x hx, (le_cSup hs.bdd_above hx).trans_lt h, λ H, H _ $ h.cSup_mem hs⟩

lemma set.finite.lt_cInf_iff (hs : finite s) (h : s.nonempty) : a < Inf s ↔ ∀ x ∈ s, a < x :=
@set.finite.cSup_lt_iff (order_dual α) _ _ _ hs h

/-- When b < Sup s, there is an element a in s with b < a, if s is nonempty and the order is
a linear order. -/
lemma exists_lt_of_lt_cSup (hs : s.nonempty) (hb : b < Sup s) : ∃a∈s, b < a :=
begin
  classical, contrapose! hb,
  exact cSup_le hs hb
end

/--
Indexed version of the above lemma `exists_lt_of_lt_cSup`.
When `b < supr f`, there is an element `i` such that `b < f i`.
-/
lemma exists_lt_of_lt_csupr [nonempty ι] {f : ι → α} (h : b < supr f) :
  ∃i, b < f i :=
let ⟨_, ⟨i, rfl⟩, h⟩ := exists_lt_of_lt_cSup (range_nonempty f) h in ⟨i, h⟩

/--When Inf s < b, there is an element a in s with a < b, if s is nonempty and the order is
a linear order.-/
lemma exists_lt_of_cInf_lt (hs : s.nonempty) (hb : Inf s < b) : ∃a∈s, a < b :=
@exists_lt_of_lt_cSup (order_dual α) _ _ _ hs hb

/--
Indexed version of the above lemma `exists_lt_of_cInf_lt`
When `infi f < a`, there is an element `i` such that `f i < a`.
-/
lemma exists_lt_of_cinfi_lt [nonempty ι] {f : ι → α} (h : infi f < a) :
  (∃i, f i < a) :=
@exists_lt_of_lt_csupr (order_dual α) _ _ _ _ _ h

/--Introduction rule to prove that b is the supremum of s: it suffices to check that
1) b is an upper bound
2) every other upper bound b' satisfies b ≤ b'.-/
theorem cSup_eq_of_is_forall_le_of_forall_le_imp_ge (_ : s.nonempty)
  (h_is_ub : ∀ a ∈ s, a ≤ b) (h_b_le_ub : ∀ub, (∀ a ∈ s, a ≤ ub) → (b ≤ ub)) : Sup s = b :=
le_antisymm
  (show Sup s ≤ b, from cSup_le ‹s.nonempty› h_is_ub)
  (show b ≤ Sup s, from h_b_le_ub _ $ assume a, le_cSup ⟨b, h_is_ub⟩)

open function
variables [is_well_order α (<)]

lemma Inf_eq_argmin_on (hs : s.nonempty) : Inf s = argmin_on id (@is_well_order.wf α (<) _) s hs :=
is_least.cInf_eq ⟨argmin_on_mem _ _ _ _, λ a ha, argmin_on_le id _ _ ha⟩

lemma is_least_Inf (hs : s.nonempty) : is_least s (Inf s) :=
by { rw Inf_eq_argmin_on hs, exact ⟨argmin_on_mem _ _ _ _, λ a ha, argmin_on_le id _ _ ha⟩ }

lemma le_cInf_iff' (hs : s.nonempty) : b ≤ Inf s ↔ b ∈ lower_bounds s :=
le_is_glb_iff (is_least_Inf hs).is_glb

lemma Inf_mem (hs : s.nonempty) : Inf s ∈ s := (is_least_Inf hs).1

end conditionally_complete_linear_order

/-!
### Lemmas about a conditionally complete linear order with bottom element

In this case we have `Sup ∅ = ⊥`, so we can drop some `nonempty`/`set.nonempty` assumptions.
-/

section conditionally_complete_linear_order_bot

variables [conditionally_complete_linear_order_bot α]

lemma cSup_empty : (Sup ∅ : α) = ⊥ :=
conditionally_complete_linear_order_bot.cSup_empty

lemma csupr_of_empty [is_empty ι] (f : ι → α) : (⨆ i, f i) = ⊥ :=
by rw [supr_of_empty', cSup_empty]

@[simp] lemma csupr_false (f : false → α) : (⨆ i, f i) = ⊥ := csupr_of_empty f

lemma is_lub_cSup' {s : set α} (hs : bdd_above s) : is_lub s (Sup s) :=
begin
  rcases eq_empty_or_nonempty s with (rfl|hne),
  { simp only [cSup_empty, is_lub_empty] },
  { exact is_lub_cSup hne hs }
end

lemma cSup_le_iff' {s : set α} (hs : bdd_above s) {a : α} : Sup s ≤ a ↔ ∀ x ∈ s, x ≤ a :=
is_lub_le_iff (is_lub_cSup' hs)

lemma cSup_le' {s : set α} {a : α} (h : a ∈ upper_bounds s) : Sup s ≤ a :=
(cSup_le_iff' ⟨a, h⟩).2 h

lemma exists_lt_of_lt_cSup' {s : set α} {a : α} (h : a < Sup s) : ∃ b ∈ s, a < b :=
by { contrapose! h, exact cSup_le' h }

lemma csupr_le_iff' {f : ι → α} (h : bdd_above (range f)) {a : α} :
  (⨆ i, f i) ≤ a ↔ ∀ i, f i ≤ a :=
(cSup_le_iff' h).trans forall_range_iff

lemma csupr_le' {f : ι → α} {a : α} (h : ∀ i, f i ≤ a) : (⨆ i, f i) ≤ a :=
cSup_le' $ forall_range_iff.2 h

lemma exists_lt_of_lt_csupr' {f : ι → α} {a : α} (h : a < ⨆ i, f i) : ∃ i, a < f i :=
by { contrapose! h, exact csupr_le' h }

end conditionally_complete_linear_order_bot

namespace with_top
open_locale classical

variables [conditionally_complete_linear_order_bot α]

/-- The Sup of a non-empty set is its least upper bound for a conditionally
complete lattice with a top. -/
lemma is_lub_Sup' {β : Type*} [conditionally_complete_lattice β]
  {s : set (with_top β)} (hs : s.nonempty) : is_lub s (Sup s) :=
begin
  split,
  { show ite _ _ _ ∈ _,
    split_ifs,
    { intros _ _, exact le_top },
    { rintro (⟨⟩|a) ha,
      { contradiction },
      apply some_le_some.2,
      exact le_cSup h_1 ha },
    { intros _ _, exact le_top } },
  { show ite _ _ _ ∈ _,
    split_ifs,
    { rintro (⟨⟩|a) ha,
      { exact _root_.le_rfl },
      { exact false.elim (not_top_le_coe a (ha h)) } },
    { rintro (⟨⟩|b) hb,
      { exact le_top },
      refine some_le_some.2 (cSup_le _ _),
      { rcases hs with ⟨⟨⟩|b, hb⟩,
        { exact absurd hb h },
        { exact ⟨b, hb⟩ } },
      { intros a ha, exact some_le_some.1 (hb ha) } },
    { rintro (⟨⟩|b) hb,
      { exact _root_.le_rfl },
      { exfalso, apply h_1, use b, intros a ha, exact some_le_some.1 (hb ha) } } }
end

lemma is_lub_Sup (s : set (with_top α)) : is_lub s (Sup s) :=
begin
  cases s.eq_empty_or_nonempty with hs hs,
  { rw hs,
    show is_lub ∅ (ite _ _ _),
    split_ifs,
    { cases h },
    { rw [preimage_empty, cSup_empty], exact is_lub_empty },
    { exfalso, apply h_1, use ⊥, rintro a ⟨⟩ } },
  exact is_lub_Sup' hs,
end

/-- The Inf of a bounded-below set is its greatest lower bound for a conditionally
complete lattice with a top. -/
lemma is_glb_Inf' {β : Type*} [conditionally_complete_lattice β]
  {s : set (with_top β)} (hs : bdd_below s) : is_glb s (Inf s) :=
begin
  split,
  { show ite _ _ _ ∈ _,
    split_ifs,
    { intros a ha, exact top_le_iff.2 (set.mem_singleton_iff.1 (h ha)) },
    { rintro (⟨⟩|a) ha,
      { exact le_top },
      refine some_le_some.2 (cInf_le _ ha),
      rcases hs with ⟨⟨⟩|b, hb⟩,
      { exfalso,
        apply h,
        intros c hc,
        rw [mem_singleton_iff, ←top_le_iff],
        exact hb hc },
      use b,
      intros c hc,
      exact some_le_some.1 (hb hc) } },
  { show ite _ _ _ ∈ _,
    split_ifs,
    { intros _ _, exact le_top },
    { rintro (⟨⟩|a) ha,
      { exfalso, apply h, intros b hb, exact set.mem_singleton_iff.2 (top_le_iff.1 (ha hb)) },
      { refine some_le_some.2 (le_cInf _ _),
        { classical, contrapose! h,
          rintros (⟨⟩|a) ha,
          { exact mem_singleton ⊤ },
          { exact (h ⟨a, ha⟩).elim }},
        { intros b hb,
          rw ←some_le_some,
          exact ha hb } } } }
end

lemma is_glb_Inf (s : set (with_top α)) : is_glb s (Inf s) :=
begin
  by_cases hs : bdd_below s,
  { exact is_glb_Inf' hs },
  { exfalso, apply hs, use ⊥, intros _ _, exact bot_le },
end

noncomputable instance : complete_linear_order (with_top α) :=
{ Sup := Sup, le_Sup := assume s, (is_lub_Sup s).1, Sup_le := assume s, (is_lub_Sup s).2,
  Inf := Inf, le_Inf := assume s, (is_glb_Inf s).2, Inf_le := assume s, (is_glb_Inf s).1,
  .. with_top.linear_order, ..with_top.lattice, ..with_top.order_top, ..with_top.order_bot }

lemma coe_Sup {s : set α} (hb : bdd_above s) : (↑(Sup s) : with_top α) = (⨆a∈s, ↑a) :=
begin
  cases s.eq_empty_or_nonempty with hs hs,
  { rw [hs, cSup_empty], simp only [set.mem_empty_eq, supr_bot, supr_false], refl },
  apply le_antisymm,
  { refine (coe_le_iff.2 $ assume b hb, cSup_le hs $ assume a has, coe_le_coe.1 $ hb ▸ _),
    exact (le_supr_of_le a $ le_supr_of_le has $ _root_.le_rfl) },
  { exact (supr_le $ assume a, supr_le $ assume ha, coe_le_coe.2 $ le_cSup hb ha) }
end

lemma coe_Inf {s : set α} (hs : s.nonempty) : (↑(Inf s) : with_top α) = (⨅a∈s, ↑a) :=
let ⟨x, hx⟩ := hs in
have (⨅a∈s, ↑a : with_top α) ≤ x, from infi_le_of_le x $ infi_le_of_le hx $ _root_.le_rfl,
let ⟨r, r_eq, hr⟩ := le_coe_iff.1 this in
le_antisymm
  (le_infi $ assume a, le_infi $ assume ha, coe_le_coe.2 $ cInf_le (order_bot.bdd_below s) ha)
  begin
    refine (r_eq.symm ▸ coe_le_coe.2 $ le_cInf hs $ assume a has, coe_le_coe.1 $ _),
    refine (r_eq ▸ infi_le_of_le a _),
    exact (infi_le_of_le has $ _root_.le_rfl),
  end

end with_top

namespace monotone
variables [preorder α] [conditionally_complete_lattice β] {f : α → β} (h_mono : monotone f)

/-! A monotone function into a conditionally complete lattice preserves the ordering properties of
`Sup` and `Inf`. -/

lemma le_cSup_image {s : set α} {c : α} (hcs : c ∈ s) (h_bdd : bdd_above s) :
  f c ≤ Sup (f '' s) :=
le_cSup (map_bdd_above h_mono h_bdd) (mem_image_of_mem f hcs)

lemma cSup_image_le {s : set α} (hs : s.nonempty) {B : α} (hB: B ∈ upper_bounds s) :
  Sup (f '' s) ≤ f B :=
cSup_le (nonempty.image f hs) (h_mono.mem_upper_bounds_image hB)

lemma cInf_image_le {s : set α} {c : α} (hcs : c ∈ s) (h_bdd : bdd_below s) :
  Inf (f '' s) ≤ f c :=
@le_cSup_image (order_dual α) (order_dual β) _ _ _ (λ x y hxy, h_mono hxy) _ _ hcs h_bdd

lemma le_cInf_image {s : set α} (hs : s.nonempty) {B : α} (hB: B ∈ lower_bounds s) :
  f B ≤ Inf (f '' s) :=
@cSup_image_le (order_dual α) (order_dual β) _ _ _ (λ x y hxy, h_mono hxy) _ hs _ hB

end monotone

namespace galois_connection

variables {γ : Type*} [conditionally_complete_lattice α] [conditionally_complete_lattice β]
  [nonempty ι] {l : α → β} {u : β → α}

lemma l_cSup (gc : galois_connection l u) {s : set α} (hne : s.nonempty)
  (hbdd : bdd_above s) :
  l (Sup s) = ⨆ x : s, l x :=
eq.symm $ is_lub.csupr_set_eq (gc.is_lub_l_image $ is_lub_cSup hne hbdd) hne

lemma l_cSup' (gc : galois_connection l u) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
  l (Sup s) = Sup (l '' s) :=
by rw [gc.l_cSup hne hbdd, csupr_set]

lemma l_csupr (gc : galois_connection l u) {f : ι → α}
  (hf : bdd_above (range f)) :
  l (⨆ i, f i) = ⨆ i, l (f i) :=
by rw [supr, gc.l_cSup (range_nonempty _) hf, supr_range']

lemma l_csupr_set (gc : galois_connection l u) {s : set γ} {f : γ → α}
  (hf : bdd_above (f '' s)) (hne : s.nonempty) :
  l (⨆ i : s, f i) = ⨆ i : s, l (f i) :=
by { haveI := hne.to_subtype, rw image_eq_range at hf, exact gc.l_csupr hf }

lemma u_cInf (gc : galois_connection l u) {s : set β} (hne : s.nonempty)
  (hbdd : bdd_below s) :
  u (Inf s) = ⨅ x : s, u x :=
gc.dual.l_cSup hne hbdd

lemma u_cInf' (gc : galois_connection l u) {s : set β} (hne : s.nonempty) (hbdd : bdd_below s) :
  u (Inf s) = Inf (u '' s) :=
gc.dual.l_cSup' hne hbdd

lemma u_cinfi (gc : galois_connection l u) {f : ι → β}
  (hf : bdd_below (range f)) :
  u (⨅ i, f i) = ⨅ i, u (f i) :=
gc.dual.l_csupr hf

lemma u_cinfi_set (gc : galois_connection l u) {s : set γ} {f : γ → β}
  (hf : bdd_below (f '' s)) (hne : s.nonempty) :
  u (⨅ i : s, f i) = ⨅ i : s, u (f i) :=
gc.dual.l_csupr_set hf hne

end galois_connection

namespace order_iso

variables {γ : Type*} [conditionally_complete_lattice α] [conditionally_complete_lattice β]
  [nonempty ι]

lemma map_cSup (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
  e (Sup s) = ⨆ x : s, e x :=
e.to_galois_connection.l_cSup hne hbdd

lemma map_cSup' (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
  e (Sup s) = Sup (e '' s) :=
e.to_galois_connection.l_cSup' hne hbdd

lemma map_csupr (e : α ≃o β) {f : ι → α} (hf : bdd_above (range f)) :
  e (⨆ i, f i) = ⨆ i, e (f i) :=
e.to_galois_connection.l_csupr hf

lemma map_csupr_set (e : α ≃o β) {s : set γ} {f : γ → α}
  (hf : bdd_above (f '' s)) (hne : s.nonempty) :
  e (⨆ i : s, f i) = ⨆ i : s, e (f i) :=
e.to_galois_connection.l_csupr_set hf hne

lemma map_cInf (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_below s) :
  e (Inf s) = ⨅ x : s, e x :=
e.dual.map_cSup hne hbdd

lemma map_cInf' (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_below s) :
  e (Inf s) = Inf (e '' s) :=
e.dual.map_cSup' hne hbdd

lemma map_cinfi (e : α ≃o β) {f : ι → α} (hf : bdd_below (range f)) :
  e (⨅ i, f i) = ⨅ i, e (f i) :=
e.dual.map_csupr hf

lemma map_cinfi_set (e : α ≃o β) {s : set γ} {f : γ → α}
  (hf : bdd_below (f '' s)) (hne : s.nonempty) :
  e (⨅ i : s, f i) = ⨅ i : s, e (f i) :=
e.dual.map_csupr_set hf hne

end order_iso

/-!
### Relation between `Sup` / `Inf` and `finset.sup'` / `finset.inf'`

Like the `Sup` of a `conditionally_complete_lattice`, `finset.sup'` also requires the set to be
non-empty. As a result, we can translate between the two.
-/

namespace finset

lemma sup'_eq_cSup_image [conditionally_complete_lattice β] (s : finset α) (H) (f : α → β) :
  s.sup' H f = Sup (f '' s) :=
begin
  apply le_antisymm,
  { refine (finset.sup'_le _ _ $ λ a ha, _),
    refine le_cSup ⟨s.sup' H f, _⟩ ⟨a, ha, rfl⟩,
    rintros i ⟨j, hj, rfl⟩,
    exact finset.le_sup' _ hj },
  { apply cSup_le ((coe_nonempty.mpr H).image _),
    rintros _ ⟨a, ha, rfl⟩,
    exact finset.le_sup' _ ha, }
end

lemma inf'_eq_cInf_image [conditionally_complete_lattice β] (s : finset α) (H) (f : α → β) :
  s.inf' H f = Inf (f '' s) :=
@sup'_eq_cSup_image _ (order_dual β) _ _ _ _

lemma sup'_id_eq_cSup [conditionally_complete_lattice α] (s : finset α) (H) :
  s.sup' H id = Sup s :=
by rw [sup'_eq_cSup_image s H, set.image_id]

lemma inf'_id_eq_cInf [conditionally_complete_lattice α] (s : finset α) (H) :
  s.inf' H id = Inf s :=
@sup'_id_eq_cSup (order_dual α) _ _ _

end finset

section with_top_bot

/-!
### Complete lattice structure on `with_top (with_bot α)`

If `α` is a `conditionally_complete_lattice`, then we show that `with_top α` and `with_bot α`
also inherit the structure of conditionally complete lattices. Furthermore, we show
that `with_top (with_bot α)` naturally inherits the structure of a complete lattice. Note that
for α a conditionally complete lattice, `Sup` and `Inf` both return junk values
for sets which are empty or unbounded. The extension of `Sup` to `with_top α` fixes
the unboundedness problem and the extension to `with_bot α` fixes the problem with
the empty set.

This result can be used to show that the extended reals [-∞, ∞] are a complete lattice.
-/

open_locale classical

/-- Adding a top element to a conditionally complete lattice
gives a conditionally complete lattice -/
noncomputable instance with_top.conditionally_complete_lattice
  {α : Type*} [conditionally_complete_lattice α] :
  conditionally_complete_lattice (with_top α) :=
{ le_cSup := λ S a hS haS, (with_top.is_lub_Sup' ⟨a, haS⟩).1 haS,
  cSup_le := λ S a hS haS, (with_top.is_lub_Sup' hS).2 haS,
  cInf_le := λ S a hS haS, (with_top.is_glb_Inf' hS).1 haS,
  le_cInf := λ S a hS haS, (with_top.is_glb_Inf' ⟨a, haS⟩).2 haS,
  ..with_top.lattice,
  ..with_top.has_Sup,
  ..with_top.has_Inf }

/-- Adding a bottom element to a conditionally complete lattice
gives a conditionally complete lattice -/
noncomputable instance with_bot.conditionally_complete_lattice
  {α : Type*} [conditionally_complete_lattice α] :
  conditionally_complete_lattice (with_bot α) :=
{ le_cSup := (@with_top.conditionally_complete_lattice (order_dual α) _).cInf_le,
  cSup_le := (@with_top.conditionally_complete_lattice (order_dual α) _).le_cInf,
  cInf_le := (@with_top.conditionally_complete_lattice (order_dual α) _).le_cSup,
  le_cInf := (@with_top.conditionally_complete_lattice (order_dual α) _).cSup_le,
  ..with_bot.lattice,
  ..with_bot.has_Sup,
  ..with_bot.has_Inf }

noncomputable instance with_top.with_bot.complete_lattice {α : Type*}
  [conditionally_complete_lattice α] : complete_lattice (with_top (with_bot α)) :=
{ le_Sup := λ S a haS, (with_top.is_lub_Sup' ⟨a, haS⟩).1 haS,
  Sup_le := λ S a ha,
    begin
      cases S.eq_empty_or_nonempty with h,
      { show ite _ _ _ ≤ a,
        split_ifs,
        { rw h at h_1, cases h_1 },
        { convert bot_le, convert with_bot.cSup_empty, rw h, refl },
        { exfalso, apply h_2, use ⊥, rw h, rintro b ⟨⟩ } },
      { refine (with_top.is_lub_Sup' h).2 ha }
    end,
  Inf_le := λ S a haS,
    show ite _ _ _ ≤ a,
    begin
      split_ifs,
      { cases a with a, exact _root_.le_rfl,
        cases (h haS); tauto },
      { cases a,
        { exact le_top },
        { apply with_top.some_le_some.2, refine cInf_le _ haS, use ⊥, intros b hb, exact bot_le } }
    end,
  le_Inf := λ S a haS, (with_top.is_glb_Inf' ⟨a, haS⟩).2 haS,
  ..with_top.has_Inf,
  ..with_top.has_Sup,
  ..with_top.bounded_order,
  ..with_top.lattice }

noncomputable instance with_top.with_bot.complete_linear_order {α : Type*}
  [conditionally_complete_linear_order α] : complete_linear_order (with_top (with_bot α)) :=
{ .. with_top.with_bot.complete_lattice,
  .. with_top.linear_order }

end with_top_bot


import .missing

open_locale big_operators

noncomputable theory

/-!
# Darboux Integrals in Lean

In this file, we formalise the theory of Darboux integrals in Lean. Although more general integrals,
that is, the Lebesgue and Bochner Integrals have been formalised already, the Darboux Integral has
not been formalised yet.
-/

/-!
## Dissections

We start off with the definition of a dissection (or partition) of a closed interval [a, b]. Note
that to make definitions simpler, we only assume strict monotonicity, and that x₀ = a, xₙ = b. This
means that the behaviour outside of [0, n] is undefined.
-/

/--
A dissection (or partition) of [a, b] is the sequence a = x₀ < x₁ < ... < xₙ = b
(Note in this case, we allow xₖ where k > n, and this is simply undefined)
-/
@[ext]
structure dissection (a b : ℝ) :=
(x : ℕ → ℝ)
(n : ℕ)
(mono : strict_mono x)
(hx0 : x 0 = a)
(hxn : x n = b)

namespace dissection

variables {a b : ℝ}

lemma eq_of_x_eq {D D' : dissection a b} (h : D.x = D'.x) : D = D' :=
begin
  ext,
  { rw h },
  have h₁ := D.hxn,
  have h₂ := D'.hxn,
  simp_rw [←h₂, h] at h₁,
  exact D'.mono.injective h₁,
end

/-!
## Darboux Sums

With Dissections defined, we can use them to define Darboux Sums. In this instance, we do not
require the functions to be bounded. This means that the Sup and Inf are not guaranteed to exist,
however, it makes more sense to take in the assumption that the function is bounded later on,
instead of passing it into the definition where it is never used.
-/

/--
The lower Darboux sum
-/
def lower_sum (D : dissection a b) (f : ℝ → ℝ) : ℝ :=
∑ i in finset.range D.n, (D.x (i+1) - D.x i) * Inf (f '' set.Icc (D.x i) (D.x (i + 1)))

/--
The upper Darboux Sum
-/
def upper_sum (D : dissection a b) (f : ℝ → ℝ) : ℝ :=
∑ i in finset.range D.n, (D.x (i+1) - D.x i) * Sup (f '' set.Icc (D.x i) (D.x (i + 1)))

lemma a_le_x (D : dissection a b) (n : ℕ) : a ≤ D.x n :=
begin
  simp_rw [←D.hx0, D.mono.le_iff_le],
  exact nat.zero_le _,
end

lemma x_le_b (D : dissection a b) (i : ℕ) (hi : i ≤ D.n) : D.x i ≤ b :=
begin
  simp_rw [←D.hxn, D.mono.le_iff_le],
  exact hi
end

/--
We can show that for any bounded function f, the lower Darboux sum is less than or equal to the
upper Darboux sum
-/
lemma lower_sum_le_upper_sum (D : dissection a b) {f : ℝ → ℝ} {k : ℝ} (hf : bounded_within f a b) :
  D.lower_sum f ≤ D.upper_sum f :=
begin
  unfold lower_sum upper_sum,
  apply finset.sum_le_sum,
  rcases hf with ⟨k, hf⟩,
  intros i hi,
  rw finset.mem_range at hi,
  rw mul_le_mul_left,
  { apply real.Inf_le_Sup,
    { use [f (D.x i), D.x i],
      exact ⟨⟨le_refl _, (D.mono i.lt_succ_self).le⟩, rfl⟩ },
    { use k,
      rintros y ⟨x, hx, rfl⟩,
      have xab : x ∈ set.Icc a b := set.Icc_subset_Icc (a_le_x _ _) (x_le_b _ _ hi) hx,
      specialize hf x xab,
      rw abs_lt at hf,
      exact hf.2.le },
    { use -k,
      rintros y ⟨x, hx, rfl⟩,
      have xab : x ∈ set.Icc a b := set.Icc_subset_Icc (a_le_x _ _) (x_le_b _ _ hi) hx,
      specialize hf x xab,
      rw abs_lt at hf,
      exact hf.1.le } },
  { rw sub_pos,
    apply D.mono,
    exact i.lt_succ_self }
end

/--
As we did not define a dissection as a set, the definition of a dissection being a refinement of
another is slightly different.

We can say D ≤ D' to mean D ⊆ D', which in this case means that D' is a refinement of D, In
particular, every point in D is in D'.
-/
instance : partial_order (dissection a b) :=
{ le := λ D D', ∀ i, ∃ j, D.x i = D'.x j,
  le_refl :=
  begin
    intros D i,
    use i,
  end,
  le_trans :=
  begin
    intros D D' D'' h₁ h₂ i,
    cases h₁ i with j hj,
    cases h₂ j with k hk,
    use k,
    rw [hj, hk]
  end,
  le_antisymm :=
  begin
    intros D D' h₁ h₂,
    have h₃ : set.range D.x = set.range D'.x,
    { apply set.subset.antisymm,
      { rintros y ⟨t, ht⟩,
        cases h₁ t,
        use w,
        rw [←ht, h] },
      { rintros y ⟨t, ht⟩,
        cases h₂ t,
        use w,
        rw [←ht, h] } },
    have h₄ := eq_of_strict_mono_of_range_eq D.mono D'.mono h₃,
    exact eq_of_x_eq h₄,
  end }

/-!
Now, we can show that if D' is a refinement of D, then

D.lower_sum ≤ D'.lower_sum ≤ D'.upper_sum ≤ D.upper_sum

With this, we can take the Inf of all of the upper sums, as the set of all upper sums is bounded
below. In addition, we can take the Sup of the lower sums.
-/
lemma upper_sum_mono {f : ℝ → ℝ} (hf : bounded_within f a b) (D D' : dissection a b)
  (h : D ≤ D') : D'.upper_sum ≤ D.upper_sum :=
begin
  sorry
end

lemma lower_sum_mono {f : ℝ → ℝ} (hf : bounded_within f a b) (D D' : dissection a b)
  (h : D ≤ D') : D.lower_sum ≤ D'.lower_sum :=
begin
  sorry
end

-- Todo: flesh out ≤ API
-- Todo: define the dissection D ∪ D', as it's useful for a few proofs
end dissection

section integrals

variables (f : ℝ → ℝ) (a b : ℝ)

/-!
# Lower and Upper Integrals

We can now define the Lower and Upper Integrals, by taking the Sup/Inf as appropriate. Note here
that we do not require f to be bounded in the definition, instead we take the approach of totalising
these, and allowing for junk output for unbounded functions
-/
def lower_integral : ℝ := Sup { x | ∃ D : dissection a b, D.lower_sum f = x }
def upper_integral : ℝ := Inf { x | ∃ D : dissection a b, D.upper_sum f = x }

-- Todo: show Inf/Sup exists (ie bounded, nonempty)

/-!
# Integrable

Finally, we can define what it means for a function to be integrable. We say that a function f is
Darboux Integrable if the lower and upper integrals are the same.
-/
def integrable : Prop := lower_integral f a b = upper_integral f a b

end integrals

section integrable

variables {a b : ℝ}

/--
Any monotone function is integrable. Note here `monotone` means monotonically increasing.
-/
lemma integrable_of_monotone_of_bounded {f : ℝ → ℝ} (hfm : monotone f)
  (hfb : bounded_within f a b) : integrable f a b := sorry

/--
Any continouous function is integrable.
-/
lemma integrable_of_continuous_of_bounded {f : ℝ → ℝ} (hfm : monotone f)
  (hfb : bounded_within f a b) : integrable f a b := sorry

lemma integrable.const (c : ℝ) : integrable (λ x, c) a b := sorry

lemma integrable.add {f g : ℝ → ℝ} (hf : integrable f a b) (hg : integrable g a b) :
  integrable (f + g) a b := sorry

lemma integrable.abs {f g : ℝ → ℝ} (hf : integrable f a b) : integrable (abs ∘ f) a b := sorry

lemma integrable.mul {f g : ℝ → ℝ} (hf : integrable f a b) (hg : integrable g a b) :
  integrable (f * g) a b := sorry

end integrable


/-
Copyright (c) 2022 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.W.cardinal
import ring_theory.algebraic_independent
import field_theory.is_alg_closed.basic
import field_theory.intermediate_field
import data.polynomial.cardinal
import data.mv_polynomial.cardinal
import data.zmod.algebra
/-!
# Classification of Algebraically closed fields

This file contains results related to classifying algebraically closed fields.

## Main statements

* `is_alg_closed.equiv_of_transcendence_basis` Two fields with the same characteristic and the same
  cardinality of transcendence basis are isomorphic.
* `is_alg_closed.ring_equiv_of_cardinal_eq_of_char_eq` Two uncountable algebraically closed fields
  are isomorphic if they have the same characteristic and the same cardinality.
-/
universe u

open_locale cardinal polynomial
open cardinal

section algebraic_closure

namespace algebra.is_algebraic

variables (R L : Type u) [comm_ring R] [comm_ring L] [is_domain L] [algebra R L]
variables [no_zero_smul_divisors R L] (halg : algebra.is_algebraic R L)

lemma cardinal_mk_le_sigma_polynomial :
  #L ≤ #(Σ p : R[X], { x : L // x ∈ (p.map (algebra_map R L)).roots }) :=
@mk_le_of_injective L (Σ p : R[X], { x : L | x ∈ (p.map (algebra_map R L)).roots })
  (λ x : L, let p := classical.indefinite_description _ (halg x) in
    ⟨p.1, x,
      begin
      dsimp,
      have h : p.1.map (algebra_map R L) ≠ 0,
      { rw [ne.def, ← polynomial.degree_eq_bot, polynomial.degree_map_eq_of_injective
          (no_zero_smul_divisors.algebra_map_injective R L), polynomial.degree_eq_bot],
        exact p.2.1 },
      erw [polynomial.mem_roots h, polynomial.is_root, polynomial.eval_map,
        ← polynomial.aeval_def, p.2.2],
      end⟩) (λ x y, begin
    intro h,
    simp only at h,
    refine (subtype.heq_iff_coe_eq _).1 h.2,
    simp only [h.1, iff_self, forall_true_iff]
  end)

/--The cardinality of an algebraic extension is at most the maximum of the cardinality
of the base ring or `ω` -/
lemma cardinal_mk_le_max : #L ≤ max (#R) ω :=
calc #L ≤ #(Σ p : R[X], { x : L // x ∈ (p.map (algebra_map R L)).roots }) :
  cardinal_mk_le_sigma_polynomial R L halg
... = cardinal.sum (λ p : R[X], #{ x : L | x ∈ (p.map (algebra_map R L)).roots }) :
  by rw ← mk_sigma; refl
... ≤ cardinal.sum.{u u} (λ p : R[X], ω) : sum_le_sum _ _
  (λ p, le_of_lt begin
    rw [lt_omega_iff_finite],
    classical,
    simp only [← @multiset.mem_to_finset _ _ _ (p.map (algebra_map R L)).roots],
    exact set.finite_mem_finset _,
  end)
... = #R[X] * ω : sum_const' _ _
... ≤ max (max (#R[X]) ω) ω : mul_le_max _ _
... ≤ max (max (max (#R) ω) ω) ω :
  max_le_max (max_le_max polynomial.cardinal_mk_le_max le_rfl) le_rfl
... = max (#R) ω : by simp only [max_assoc, max_comm omega.{u}, max_left_comm omega.{u}, max_self]

end algebra.is_algebraic

end algebraic_closure

namespace is_alg_closed

section classification

noncomputable theory

variables {R L K : Type*} [comm_ring R]
variables [field K] [algebra R K]
variables [field L] [algebra R L]
variables {ι : Type*} (v : ι → K)
variables {κ : Type*} (w : κ → L)

variables (hv : algebraic_independent R v)

lemma is_alg_closure_of_transcendence_basis [is_alg_closed K] (hv : is_transcendence_basis R v) :
  is_alg_closure (algebra.adjoin R (set.range v)) K :=
by letI := ring_hom.domain_nontrivial (algebra_map R K); exact
{ alg_closed := by apply_instance,
  algebraic := hv.is_algebraic }

variables (hw : algebraic_independent R w)

/-- setting `R` to be `zmod (ring_char R)` this result shows that if two algebraically
closed fields have equipotent transcendence bases and the same characteristic then they are
isomorphic. -/
def equiv_of_transcendence_basis [is_alg_closed K] [is_alg_closed L] (e : ι ≃ κ)
  (hv : is_transcendence_basis R v) (hw : is_transcendence_basis R w) : K ≃+* L :=
begin
  letI := is_alg_closure_of_transcendence_basis v hv;
  letI := is_alg_closure_of_transcendence_basis w hw;
  have e : algebra.adjoin R (set.range v) ≃+* algebra.adjoin R (set.range w),
  { refine hv.1.aeval_equiv.symm.to_ring_equiv.trans _,
    refine (alg_equiv.of_alg_hom
      (mv_polynomial.rename e)
      (mv_polynomial.rename e.symm)
      _ _).to_ring_equiv.trans _,
    { ext, simp },
    { ext, simp },
    exact hw.1.aeval_equiv.to_ring_equiv },
  exact is_alg_closure.equiv_of_equiv K L e
end

end classification

section cardinal

variables {R L K : Type u} [comm_ring R]
variables [field K] [algebra R K] [is_alg_closed K]
variables {ι : Type u} (v : ι → K)
variable (hv : is_transcendence_basis R v)

lemma cardinal_le_max_transcendence_basis (hv : is_transcendence_basis R v) :
  #K ≤ max (max (#R) (#ι)) ω :=
calc #K ≤ max (#(algebra.adjoin R (set.range v))) ω :
  by letI := is_alg_closure_of_transcendence_basis v hv;
   exact algebra.is_algebraic.cardinal_mk_le_max _ _ is_alg_closure.algebraic
... = max (#(mv_polynomial ι R)) ω : by rw [cardinal.eq.2 ⟨(hv.1.aeval_equiv).to_equiv⟩]
... ≤ max (max (max (#R) (#ι)) ω) ω : max_le_max mv_polynomial.cardinal_mk_le_max le_rfl
... = _ : by simp [max_assoc]

/-- If `K` is an uncountable algebraically closed field, then its
cardinality is the same as that of a transcendence basis. -/
lemma cardinal_eq_cardinal_transcendence_basis_of_omega_lt [nontrivial R]
  (hv : is_transcendence_basis R v) (hR : #R ≤ ω) (hK : ω < #K) : #K = #ι :=
have ω ≤ #ι,
  from le_of_not_lt (λ h,
    not_le_of_gt hK $ calc
      #K ≤ max (max (#R) (#ι)) ω : cardinal_le_max_transcendence_basis v hv
     ... ≤ _ : max_le (max_le hR (le_of_lt h)) le_rfl),
le_antisymm
  (calc #K ≤ max (max (#R) (#ι)) ω : cardinal_le_max_transcendence_basis v hv
       ... = #ι : begin
         rw [max_eq_left, max_eq_right],
         { exact le_trans hR this },
         { exact le_max_of_le_right this }
       end)
  (mk_le_of_injective (show function.injective v, from hv.1.injective))

end cardinal

variables {K L : Type} [field K] [field L] [is_alg_closed K] [is_alg_closed L]

/-- Two uncountable algebraically closed fields of characteristic zero are isomorphic
if they have the same cardinality. -/
@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_zero [char_zero K] [char_zero L]
  (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  cases exists_is_transcendence_basis ℤ
    (show function.injective (algebra_map ℤ K),
      from int.cast_injective) with s hs,
  cases exists_is_transcendence_basis ℤ
    (show function.injective (algebra_map ℤ L),
      from int.cast_injective) with t ht,
  have : #s = #t,
  { rw [← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ hs (le_of_eq mk_int) hK,
        ← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ ht (le_of_eq mk_int), hKL],
    rwa ← hKL },
  cases cardinal.eq.1 this with e,
  exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
end

private lemma ring_equiv_of_cardinal_eq_of_char_p (p : ℕ) [fact p.prime]
  [char_p K p] [char_p L p] (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  cases exists_is_transcendence_basis (zmod p)
    (show function.injective (algebra_map (zmod p) K),
      from ring_hom.injective _) with s hs,
  cases exists_is_transcendence_basis (zmod p)
    (show function.injective (algebra_map (zmod p) L),
      from ring_hom.injective _) with t ht,
  have : #s = #t,
  { rw [← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ hs
      (le_of_lt $ lt_omega_iff_fintype.2 ⟨infer_instance⟩) hK,
        ← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ ht
      (le_of_lt $ lt_omega_iff_fintype.2 ⟨infer_instance⟩), hKL],
    rwa ← hKL },
  cases cardinal.eq.1 this with e,
  exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
end

/-- Two uncountable algebraically closed fields are isomorphic
if they have the same cardinality and the same characteristic. -/
@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_eq (p : ℕ) [char_p K p] [char_p L p]
  (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  rcases char_p.char_is_prime_or_zero K p with hp | hp,
  { haveI : fact p.prime := ⟨hp⟩,
    exact ⟨ring_equiv_of_cardinal_eq_of_char_p p hK hKL⟩ },
  { rw [hp] at *,
    resetI,
    letI : char_zero K := char_p.char_p_to_char_zero K,
    letI : char_zero L := char_p.char_p_to_char_zero L,
    exact ⟨ring_equiv_of_cardinal_eq_of_char_zero hK hKL⟩ }
end

end is_alg_closed


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Morenikeji Neri
-/
import ring_theory.noetherian
import ring_theory.unique_factorization_domain
/-!
# Principal ideal rings and principal ideal domains

A principal ideal ring (PIR) is a commutative ring in which all ideals are principal. A
principal ideal domain (PID) is an integral domain which is a principal ideal ring.

# Main definitions

Note that for principal ideal domains, one should use
`[integral domain R] [is_principal_ideal_ring R]`. There is no explicit definition of a PID.
Theorems about PID's are in the `principal_ideal_ring` namespace.

- `is_principal_ideal_ring`: a predicate on commutative rings, saying that every
  ideal is principal.
- `generator`: a generator of a principal ideal (or more generally submodule)
- `to_unique_factorization_monoid`: a PID is a unique factorization domain

# Main results

- `to_maximal_ideal`: a non-zero prime ideal in a PID is maximal.
- `euclidean_domain.to_principal_ideal_domain` : a Euclidean domain is a PID.

-/
universes u v
variables {R : Type u} {M : Type v}

open set function
open submodule
open_locale classical

/-- An `R`-submodule of `M` is principal if it is generated by one element. -/
class submodule.is_principal [ring R] [add_comm_group M] [module R M] (S : submodule R M) : Prop :=
(principal [] : ∃ a, S = span R {a})

/-- A commutative ring is a principal ideal ring if all ideals are principal. -/
class is_principal_ideal_ring (R : Type u) [comm_ring R] : Prop :=
(principal : ∀ (S : ideal R), S.is_principal)

attribute [instance] is_principal_ideal_ring.principal

namespace submodule.is_principal

variables [comm_ring R] [add_comm_group M] [module R M]

/-- `generator I`, if `I` is a principal submodule, is an `x ∈ M` such that `span R {x} = I` -/
noncomputable def generator (S : submodule R M) [S.is_principal] : M :=
classical.some (principal S)

lemma span_singleton_generator (S : submodule R M) [S.is_principal] : span R {generator S} = S :=
eq.symm (classical.some_spec (principal S))

@[simp] lemma generator_mem (S : submodule R M) [S.is_principal] : generator S ∈ S :=
by { conv_rhs { rw ← span_singleton_generator S }, exact subset_span (mem_singleton _) }

lemma mem_iff_eq_smul_generator (S : submodule R M) [S.is_principal] {x : M} :
  x ∈ S ↔ ∃ s : R, x = s • generator S :=
by simp_rw [@eq_comm _ x, ← mem_span_singleton, span_singleton_generator]

lemma mem_iff_generator_dvd (S : ideal R) [S.is_principal] {x : R} : x ∈ S ↔ generator S ∣ x :=
(mem_iff_eq_smul_generator S).trans (exists_congr (λ a, by simp only [mul_comm, smul_eq_mul]))

lemma eq_bot_iff_generator_eq_zero (S : submodule R M) [S.is_principal] :
  S = ⊥ ↔ generator S = 0 :=
by rw [← @span_singleton_eq_bot R M, span_singleton_generator]

lemma prime_generator_of_is_prime (S : ideal R) [submodule.is_principal S] [is_prime : S.is_prime]
  (ne_bot : S ≠ ⊥) :
  prime (generator S) :=
⟨λ h, ne_bot ((eq_bot_iff_generator_eq_zero S).2 h),
 λ h, is_prime.ne_top (S.eq_top_of_is_unit_mem (generator_mem S) h),
 by simpa only [← mem_iff_generator_dvd S] using is_prime.2⟩

end submodule.is_principal

namespace is_prime
open submodule.is_principal ideal

-- TODO -- for a non-ID one could perhaps prove that if p < q are prime then q maximal;
-- 0 isn't prime in a non-ID PIR but the Krull dimension is still <= 1.
-- The below result follows from this, but we could also use the below result to
-- prove this (quotient out by p).
lemma to_maximal_ideal [integral_domain R] [is_principal_ideal_ring R] {S : ideal R}
  [hpi : is_prime S] (hS : S ≠ ⊥) : is_maximal S :=
is_maximal_iff.2 ⟨(ne_top_iff_one S).1 hpi.1, begin
  assume T x hST hxS hxT,
  cases (mem_iff_generator_dvd _).1 (hST $ generator_mem S) with z hz,
  cases hpi.mem_or_mem (show generator T * z ∈ S, from hz ▸ generator_mem S),
  { have hTS : T ≤ S, rwa [← span_singleton_generator T, submodule.span_le, singleton_subset_iff],
    exact (hxS $ hTS hxT).elim },
  cases (mem_iff_generator_dvd _).1 h with y hy,
  have : generator S ≠ 0 := mt (eq_bot_iff_generator_eq_zero _).2 hS,
  rw [← mul_one (generator S), hy, mul_left_comm, mul_right_inj' this] at hz,
  exact hz.symm ▸ T.mul_mem_right _ (generator_mem T)
end⟩

end is_prime

section
open euclidean_domain
variable [euclidean_domain R]

lemma mod_mem_iff {S : ideal R} {x y : R} (hy : y ∈ S) : x % y ∈ S ↔ x ∈ S :=
⟨λ hxy, div_add_mod x y ▸ S.add_mem (S.mul_mem_right _ hy) hxy,
  λ hx, (mod_eq_sub_mul_div x y).symm ▸ S.sub_mem hx (S.mul_mem_right _ hy)⟩

@[priority 100] -- see Note [lower instance priority]
instance euclidean_domain.to_principal_ideal_domain : is_principal_ideal_ring R :=
{ principal := λ S, by exactI
    ⟨if h : {x : R | x ∈ S ∧ x ≠ 0}.nonempty
    then
    have wf : well_founded (euclidean_domain.r : R → R → Prop) := euclidean_domain.r_well_founded,
    have hmin : well_founded.min wf {x : R | x ∈ S ∧ x ≠ 0} h ∈ S ∧
        well_founded.min wf {x : R | x ∈ S ∧ x ≠ 0} h ≠ 0,
      from well_founded.min_mem wf {x : R | x ∈ S ∧ x ≠ 0} h,
    ⟨well_founded.min wf {x : R | x ∈ S ∧ x ≠ 0} h,
      submodule.ext $ λ x,
      ⟨λ hx, div_add_mod x (well_founded.min wf {x : R | x ∈ S ∧ x ≠ 0} h) ▸
        (ideal.mem_span_singleton.2 $ dvd_add (dvd_mul_right _ _) $
        have (x % (well_founded.min wf {x : R | x ∈ S ∧ x ≠ 0} h) ∉ {x : R | x ∈ S ∧ x ≠ 0}),
          from λ h₁, well_founded.not_lt_min wf _ h h₁ (mod_lt x hmin.2),
        have x % well_founded.min wf {x : R | x ∈ S ∧ x ≠ 0} h = 0,
          by finish [(mod_mem_iff hmin.1).2 hx],
        by simp *),
      λ hx, let ⟨y, hy⟩ := ideal.mem_span_singleton.1 hx in hy.symm ▸ S.mul_mem_right _ hmin.1⟩⟩
    else ⟨0, submodule.ext $ λ a,
           by rw [← @submodule.bot_coe R R _ _ _, span_eq, submodule.mem_bot];
      exact ⟨λ haS, by_contradiction $ λ ha0, h ⟨a, ⟨haS, ha0⟩⟩, λ h₁, h₁.symm ▸ S.zero_mem⟩⟩⟩ }
end

namespace principal_ideal_ring
open is_principal_ideal_ring

variables [integral_domain R] [is_principal_ideal_ring R]

@[priority 100] -- see Note [lower instance priority]
instance is_noetherian_ring : is_noetherian_ring R :=
is_noetherian_ring_iff.2 ⟨assume s : ideal R,
begin
  rcases (is_principal_ideal_ring.principal s).principal with ⟨a, rfl⟩,
  rw [← finset.coe_singleton],
  exact ⟨{a}, set_like.coe_injective rfl⟩
end⟩

lemma is_maximal_of_irreducible {p : R} (hp : irreducible p) :
  ideal.is_maximal (span R ({p} : set R)) :=
⟨⟨mt ideal.span_singleton_eq_top.1 hp.1, λ I hI, begin
  rcases principal I with ⟨a, rfl⟩,
  erw ideal.span_singleton_eq_top,
  unfreezingI { rcases ideal.span_singleton_le_span_singleton.1 (le_of_lt hI) with ⟨b, rfl⟩ },
  refine (of_irreducible_mul hp).resolve_right (mt (λ hb, _) (not_le_of_lt hI)),
  erw [ideal.span_singleton_le_span_singleton, is_unit.mul_right_dvd hb]
end⟩⟩

lemma irreducible_iff_prime {p : R} : irreducible p ↔ prime p :=
⟨λ hp, (ideal.span_singleton_prime hp.ne_zero).1 $
    (is_maximal_of_irreducible hp).is_prime,
  irreducible_of_prime⟩

lemma associates_irreducible_iff_prime : ∀{p : associates R}, irreducible p ↔ prime p :=
associates.irreducible_iff_prime_iff.1 (λ _, irreducible_iff_prime)

section
open_locale classical

/-- `factors a` is a multiset of irreducible elements whose product is `a`, up to units -/
noncomputable def factors (a : R) : multiset R :=
if h : a = 0 then ∅ else classical.some (wf_dvd_monoid.exists_factors a h)

lemma factors_spec (a : R) (h : a ≠ 0) :
  (∀b∈factors a, irreducible b) ∧ associated (factors a).prod a :=
begin
  unfold factors, rw [dif_neg h],
  exact classical.some_spec (wf_dvd_monoid.exists_factors a h)
end

lemma ne_zero_of_mem_factors {R : Type v} [integral_domain R] [is_principal_ideal_ring R] {a b : R}
  (ha : a ≠ 0) (hb : b ∈ factors a) : b ≠ 0 := irreducible.ne_zero ((factors_spec a ha).1 b hb)

lemma mem_submonoid_of_factors_subset_of_units_subset (s : submonoid R)
  {a : R} (ha : a ≠ 0) (hfac : ∀ b ∈ factors a, b ∈ s) (hunit : ∀ c : units R, (c : R) ∈ s) :
  a ∈ s :=
begin
  rcases ((factors_spec a ha).2) with ⟨c, hc⟩,
  rw [← hc],
  exact submonoid.mul_mem _ (submonoid.multiset_prod_mem _ _ hfac) (hunit _),
end

/-- If a `ring_hom` maps all units and all factors of an element `a` into a submonoid `s`, then it
also maps `a` into that submonoid. -/
lemma ring_hom_mem_submonoid_of_factors_subset_of_units_subset {R S : Type*}
  [integral_domain R] [is_principal_ideal_ring R] [semiring S]
  (f : R →+* S) (s : submonoid S) (a : R) (ha : a ≠ 0)
  (h : ∀ b ∈ factors a, f b ∈ s) (hf: ∀ c : units R, f c ∈ s) :
  f a ∈ s :=
mem_submonoid_of_factors_subset_of_units_subset (s.comap f.to_monoid_hom) ha h hf

/-- A principal ideal domain has unique factorization -/
@[priority 100] -- see Note [lower instance priority]
instance to_unique_factorization_monoid : unique_factorization_monoid R :=
{ irreducible_iff_prime := λ _, principal_ideal_ring.irreducible_iff_prime
  .. (is_noetherian_ring.wf_dvd_monoid : wf_dvd_monoid R) }

end

end principal_ideal_ring


/-
Copyright (c) 2021 Alena Gusakov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov
-/
import combinatorics.simple_graph.basic
import data.set.finite
/-!
# Strongly regular graphs

## Main definitions

* `G.is_SRG_of n k l m` (see `is_simple_graph.is_SRG_of`) is a structure for a `simple_graph`
  satisfying the following conditions:
  * The cardinality of the vertex set is `n`
  * `G` is a regular graph with degree `k`
  * The number of common neighbors between any two adjacent vertices in `G` is `l`
  * The number of common neighbors between any two nonadjacent vertices in `G` is `m`

## TODO
- Prove that the complement of a strongly regular graph is strongly regular with parameters
  `is_SRG_of n (n - k - 1) (n - 2 - 2k + m) (v - 2k + l)`
- Prove that the parameters of a strongly regular graph
  obey the relation `(n - k - 1) * m = k * (k - l - 1)`
- Prove that if `I` is the identity matrix and `J` is the all-one matrix,
  then the adj matrix `A` of SRG obeys relation `A^2 = kI + lA + m(J - I - A)`
-/

universes u

namespace simple_graph
variables {V : Type u}
variables (G : simple_graph V) [decidable_rel G.adj]

variables [fintype V] [decidable_eq V]

/--
A graph is strongly regular with parameters `n k l m` if
 * its vertex set has cardinality `n`
 * it is regular with degree `k`
 * every pair of adjacent vertices has `l` common neighbors
 * every pair of nonadjacent vertices has `m` common neighbors
-/
structure is_SRG_of (n k l m : ℕ) : Prop :=
(card : fintype.card V = n)
(regular : G.is_regular_of_degree k)
(adj_common : ∀ (v w : V), G.adj v w → fintype.card (G.common_neighbors v w) = l)
(nadj_common : ∀ (v w : V), ¬ G.adj v w ∧ v ≠ w → fintype.card (G.common_neighbors v w) = m)

open finset

/-- Complete graphs are strongly regular. Note that the parameter `m` can take any value
  for complete graphs, since there are no distinct pairs of nonadjacent vertices. -/
lemma complete_strongly_regular (m : ℕ) :
  (⊤ : simple_graph V).is_SRG_of (fintype.card V) (fintype.card V - 1) (fintype.card V - 2) m :=
{ card := rfl,
  regular := complete_graph_degree,
  adj_common := λ v w (h : v ≠ w),
    begin
      simp only [fintype.card_of_finset, mem_common_neighbors, filter_not, ←not_or_distrib,
                 filter_eq, filter_or, card_univ_diff, mem_univ, if_pos, ←insert_eq, top_adj],
      rw [card_insert_of_not_mem, card_singleton],
      simp [h]
    end,
  nadj_common := λ v w (h : ¬(v ≠ w) ∧ _), (h.1 h.2).elim }

end simple_graph


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

! This file was ported from Lean 3 source module ring_theory.free_ring
! leanprover-community/mathlib commit d6814c584384ddf2825ff038e868451a7c956f31
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.FreeAbelianGroup

/-!
# Free rings

The theory of the free ring over a type.

## Main definitions

* `FreeRing α` : the free (not commutative in general) ring over a type.
* `lift (f : α → R)` : the ring hom `FreeRing α →+* R` induced by `f`.
* `map (f : α → β)` : the ring hom `FreeRing α →+* FreeRing β` induced by `f`.

## Implementation details

`FreeRing α` is implemented as the free abelian group over the free monoid on `α`.

## Tags

free ring

-/

universe u v

/-- The free ring over a type `α`. -/
def FreeRing (α : Type u) : Type u :=
  FreeAbelianGroup <| FreeMonoid α
#align free_ring FreeRing

instance (α : Type u) : Ring (FreeRing α) :=
  FreeAbelianGroup.ring _

instance (α : Type u) : Inhabited (FreeRing α) := by
  dsimp only [FreeRing]
  infer_instance

namespace FreeRing

variable {α : Type u}

/-- The canonical map from α to `FreeRring α`. -/
def of (x : α) : FreeRing α :=
  FreeAbelianGroup.of (FreeMonoid.of x)
#align free_ring.of FreeRing.of

theorem of_injective : Function.Injective (of : α → FreeRing α) :=
  FreeAbelianGroup.of_injective.comp FreeMonoid.of_injective
#align free_ring.of_injective FreeRing.of_injective

@[elab_as_elim]
protected theorem induction_on {C : FreeRing α → Prop} (z : FreeRing α) (hn1 : C (-1))
    (hb : ∀ b, C (of b)) (ha : ∀ x y, C x → C y → C (x + y)) (hm : ∀ x y, C x → C y → C (x * y)) :
    C z :=
  have hn : ∀ x, C x → C (-x) := fun x ih => neg_one_mul x ▸ hm _ _ hn1 ih
  have h1 : C 1 := neg_neg (1 : FreeRing α) ▸ hn _ hn1
  FreeAbelianGroup.induction_on z (add_left_neg (1 : FreeRing α) ▸ ha _ _ hn1 h1)
    (fun m => List.recOn m h1 fun a m ih => by
      -- porting note: in mathlib, convert was not necessary, `exact hm _ _ (hb a) ih` worked fine
      convert hm _ _ (hb a) ih
      rw [of, ← FreeAbelianGroup.of_mul]
      rfl)
    (fun m ih => hn _ ih) ha
#align free_ring.induction_on FreeRing.induction_on

section lift

variable {R : Type v} [Ring R] (f : α → R)

/-- The ring homomorphism `FreeRing α →+* R` induced from a map `α → R`. -/
def lift : (α → R) ≃ (FreeRing α →+* R) :=
  FreeMonoid.lift.trans FreeAbelianGroup.liftMonoid
#align free_ring.lift FreeRing.lift

@[simp]
theorem lift_of (x : α) : lift f (of x) = f x :=
  congr_fun (lift.left_inv f) x
#align free_ring.lift_of FreeRing.lift_of

@[simp]
theorem lift_comp_of (f : FreeRing α →+* R) : lift (f ∘ of) = f :=
  lift.right_inv f
#align free_ring.lift_comp_of FreeRing.lift_comp_of

@[ext]
theorem hom_ext ⦃f g : FreeRing α →+* R⦄ (h : ∀ x, f (of x) = g (of x)) : f = g :=
  lift.symm.injective (funext h)
#align free_ring.hom_ext FreeRing.hom_ext

end lift

variable {β : Type v} (f : α → β)

/-- The canonical ring homomorphism `FreeRing α →+* FreeRing β` generated by a map `α → β`. -/
def map : FreeRing α →+* FreeRing β :=
  lift <| of ∘ f
#align free_ring.map FreeRing.map

@[simp]
theorem map_of (x : α) : map f (of x) = of (f x) :=
  lift_of _ _
#align free_ring.map_of FreeRing.map_of

end FreeRing


/-
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_484 :
  real.log 27 / real.log 3 = 3 :=
begin
  rw real.log_div_log,
  have three_to_three : (27 : ℝ) = (3 : ℝ)^(3 : ℝ), by norm_num,
  rw three_to_three,
  have trivial_ineq: (0 : ℝ) < (3 : ℝ), by norm_num,
  have trivial_neq: (3: ℝ) ≠ (1 : ℝ), by norm_num,
  exact real.logb_rpow trivial_ineq trivial_neq,
end


section
  variables x y : ℕ

  def double := x + x

  #check double y
  #check double (2 * x)

  theorem t1 : double (x + y) = double x + double y :=
    by simp [double, add_left_comm]

  #check t1 y
  #check t1 (2 * x)

  theorem t2 : double (x * y) = double x * y :=
    by simp [double, add_mul]
end