/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import order.filter.basic
import data.set.countable

/-!
# Filters with countable intersection property

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

In this file we define `countable_Inter_filter` to be the class of filters with the following
property: for any countable collection of sets `s ∈ l` their intersection belongs to `l` as well.

Two main examples are the `residual` filter defined in `topology.metric_space.baire` and
the `measure.ae` filter defined in `measure_theory.measure_space`.

We reformulate the definition in terms of indexed intersection and in terms of `filter.eventually`
and provide instances for some basic constructions (`⊥`, `⊤`, `filter.principal`, `filter.map`,
`filter.comap`, `has_inf.inf`). We also provide a custom constructor `filter.of_countable_Inter`
that deduces two axioms of a `filter` from the countable intersection property.

## Tags
filter, countable
-/

open set filter
open_locale filter

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

/-- A filter `l` has the countable intersection property if for any countable collection
of sets `s ∈ l` their intersection belongs to `l` as well. -/
class countable_Inter_filter (l : filter α) : Prop :=
(countable_sInter_mem' :
  ∀ {S : set (set α)} (hSc : S.countable) (hS : ∀ s ∈ S, s ∈ l), ⋂₀ S ∈ l)

variables {l : filter α} [countable_Inter_filter l]

lemma countable_sInter_mem {S : set (set α)} (hSc : S.countable) :
  ⋂₀ S ∈ l ↔ ∀ s ∈ S, s ∈ l :=
⟨λ hS s hs, mem_of_superset hS (sInter_subset_of_mem hs),
  countable_Inter_filter.countable_sInter_mem' hSc⟩

lemma countable_Inter_mem [countable ι] {s : ι → set α} : (⋂ i, s i) ∈ l ↔ ∀ i, s i ∈ l :=
sInter_range s ▸ (countable_sInter_mem (countable_range _)).trans forall_range_iff

lemma countable_bInter_mem {ι : Type*} {S : set ι} (hS : S.countable) {s : Π i ∈ S, set α} :
  (⋂ i ∈ S, s i ‹_›) ∈ l ↔  ∀ i ∈ S, s i ‹_› ∈ l :=
begin
  rw [bInter_eq_Inter],
  haveI := hS.to_encodable,
  exact countable_Inter_mem.trans subtype.forall
end

lemma eventually_countable_forall [countable ι] {p : α → ι → Prop} :
  (∀ᶠ x in l, ∀ i, p x i) ↔ ∀ i, ∀ᶠ x in l, p x i :=
by simpa only [filter.eventually, set_of_forall]
  using @countable_Inter_mem _ _ l _ _ (λ i, {x | p x i})

lemma eventually_countable_ball {ι : Type*} {S : set ι} (hS : S.countable)
  {p : Π (x : α) (i ∈ S), Prop} :
  (∀ᶠ x in l, ∀ i ∈ S, p x i ‹_›) ↔ ∀ i ∈ S, ∀ᶠ x in l, p x i ‹_› :=
by simpa only [filter.eventually, set_of_forall]
  using @countable_bInter_mem _ l _ _ _ hS (λ i hi, {x | p x i hi})

lemma eventually_le.countable_Union [countable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
  (⋃ i, s i) ≤ᶠ[l] ⋃ i, t i :=
(eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Union.2 $
  (mem_Union.1 hs).imp hst

lemma eventually_eq.countable_Union [countable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
  (⋃ i, s i) =ᶠ[l] ⋃ i, t i :=
(eventually_le.countable_Union (λ i, (h i).le)).antisymm
  (eventually_le.countable_Union (λ i, (h i).symm.le))

lemma eventually_le.countable_bUnion {ι : Type*} {S : set ι} (hS : S.countable)
  {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) :
  (⋃ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
begin
  simp only [bUnion_eq_Union],
  haveI := hS.to_encodable,
  exact eventually_le.countable_Union (λ i, h i i.2)
end

lemma eventually_eq.countable_bUnion {ι : Type*} {S : set ι} (hS : S.countable)
  {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) :
  (⋃ i ∈ S, s i ‹_›) =ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
(eventually_le.countable_bUnion hS (λ i hi, (h i hi).le)).antisymm
  (eventually_le.countable_bUnion hS (λ i hi, (h i hi).symm.le))

lemma eventually_le.countable_Inter [countable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
  (⋂ i, s i) ≤ᶠ[l] ⋂ i, t i :=
(eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Inter.2 $ λ i, hst _ (mem_Inter.1 hs i)

lemma eventually_eq.countable_Inter [countable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
  (⋂ i, s i) =ᶠ[l] ⋂ i, t i :=
(eventually_le.countable_Inter (λ i, (h i).le)).antisymm
  (eventually_le.countable_Inter (λ i, (h i).symm.le))

lemma eventually_le.countable_bInter {ι : Type*} {S : set ι} (hS : S.countable)
  {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) :
  (⋂ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
begin
  simp only [bInter_eq_Inter],
  haveI := hS.to_encodable,
  exact eventually_le.countable_Inter (λ i, h i i.2)
end

lemma eventually_eq.countable_bInter {ι : Type*} {S : set ι} (hS : S.countable)
 {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) :
 (⋂ i ∈ S, s i ‹_›) =ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
(eventually_le.countable_bInter hS (λ i hi, (h i hi).le)).antisymm
  (eventually_le.countable_bInter hS (λ i hi, (h i hi).symm.le))

/-- Construct a filter with countable intersection property. This constructor deduces
`filter.univ_sets` and `filter.inter_sets` from the countable intersection property. -/
def filter.of_countable_Inter (l : set (set α))
  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
  (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
  filter α :=
{ sets := l,
  univ_sets := @sInter_empty α ▸ hp _ countable_empty (empty_subset _),
  sets_of_superset := h_mono,
  inter_sets := λ s t hs ht, sInter_pair s t ▸
    hp _ ((countable_singleton _).insert _) (insert_subset.2 ⟨hs, singleton_subset_iff.2 ht⟩) }

instance filter.countable_Inter_of_countable_Inter (l : set (set α))
  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
  (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
  countable_Inter_filter (filter.of_countable_Inter l hp h_mono) := ⟨hp⟩

@[simp] lemma filter.mem_of_countable_Inter {l : set (set α)}
  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
  (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) {s : set α} :
  s ∈ filter.of_countable_Inter l hp h_mono ↔ s ∈ l :=
iff.rfl

instance countable_Inter_filter_principal (s : set α) : countable_Inter_filter (𝓟 s) :=
⟨λ S hSc hS, subset_sInter hS⟩

instance countable_Inter_filter_bot : countable_Inter_filter (⊥ : filter α) :=
by { rw ← principal_empty, apply countable_Inter_filter_principal }

instance countable_Inter_filter_top : countable_Inter_filter (⊤ : filter α) :=
by { rw ← principal_univ, apply countable_Inter_filter_principal }

instance (l : filter β) [countable_Inter_filter l] (f : α → β) :
  countable_Inter_filter (comap f l) :=
begin
  refine ⟨λ S hSc hS, _⟩,
  choose! t htl ht using hS,
  have : (⋂ s ∈ S, t s) ∈ l, from (countable_bInter_mem hSc).2 htl,
  refine ⟨_, this, _⟩,
  simpa [preimage_Inter] using (Inter₂_mono ht)
end

instance (l : filter α) [countable_Inter_filter l] (f : α → β) :
  countable_Inter_filter (map f l) :=
begin
  constructor, intros S hSc hS,
  simp only [mem_map, sInter_eq_bInter, preimage_Inter₂] at hS ⊢,
  exact (countable_bInter_mem hSc).2 hS
end

/-- Infimum of two `countable_Inter_filter`s is a `countable_Inter_filter`. This is useful, e.g.,
to automatically get an instance for `residual α ⊓ 𝓟 s`. -/
instance countable_Inter_filter_inf (l₁ l₂ : filter α) [countable_Inter_filter l₁]
  [countable_Inter_filter l₂] :
  countable_Inter_filter (l₁ ⊓ l₂) :=
begin
  refine ⟨λ S hSc hS, _⟩,
  choose s hs t ht hst using hS,
  replace hs : (⋂ i ∈ S, s i ‹_›) ∈ l₁ := (countable_bInter_mem hSc).2 hs,
  replace ht : (⋂ i ∈ S, t i ‹_›) ∈ l₂ := (countable_bInter_mem hSc).2 ht,
  refine mem_of_superset (inter_mem_inf hs ht) (subset_sInter $ λ i hi, _),
  rw hst i hi,
  apply inter_subset_inter ; exact Inter_subset_of_subset i (Inter_subset _ _)
end

/-- Supremum of two `countable_Inter_filter`s is a `countable_Inter_filter`. -/
instance countable_Inter_filter_sup (l₁ l₂ : filter α) [countable_Inter_filter l₁]
  [countable_Inter_filter l₂] :
  countable_Inter_filter (l₁ ⊔ l₂) :=
begin
  refine ⟨λ S hSc hS, ⟨_, _⟩⟩; refine (countable_sInter_mem hSc).2 (λ s hs, _),
  exacts [(hS s hs).1, (hS s hs).2]
end


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Yaël Dillies
-/
import topology.sets.closeds

/-!
# Compact sets

We define a few types of compact sets in a topological space.

## Main Definitions

For a topological space `α`,
* `compacts α`: The type of compact sets.
* `nonempty_compacts α`: The type of non-empty compact sets.
* `positive_compacts α`: The type of compact sets with non-empty interior.
* `compact_opens α`: The type of compact open sets. This is a central object in the study of
  spectral spaces.
-/

open set

variables {α β : Type*} [topological_space α] [topological_space β]

namespace topological_space

/-! ### Compact sets -/

/-- The type of compact sets of a topological space. -/
structure compacts (α : Type*) [topological_space α] :=
(carrier : set α)
(compact' : is_compact carrier)

namespace compacts
variables {α}

instance : set_like (compacts α) α :=
{ coe := compacts.carrier,
  coe_injective' := λ s t h, by { cases s, cases t, congr' } }

lemma compact (s : compacts α) : is_compact (s : set α) := s.compact'

instance (K : compacts α) : compact_space K := is_compact_iff_compact_space.1 K.compact

instance : can_lift (set α) (compacts α) :=
{ coe := coe,
  cond := is_compact,
  prf := λ K hK, ⟨⟨K, hK⟩, rfl⟩ }

@[ext] protected lemma ext {s t : compacts α} (h : (s : set α) = t) : s = t := set_like.ext' h

@[simp] lemma coe_mk (s : set α) (h) : (mk s h : set α) = s := rfl

instance : has_sup (compacts α) := ⟨λ s t, ⟨s ∪ t, s.compact.union t.compact⟩⟩
instance [t2_space α] : has_inf (compacts α) := ⟨λ s t, ⟨s ∩ t, s.compact.inter t.compact⟩⟩
instance [compact_space α] : has_top (compacts α) := ⟨⟨univ, compact_univ⟩⟩
instance : has_bot (compacts α) := ⟨⟨∅, is_compact_empty⟩⟩

instance : semilattice_sup (compacts α) := set_like.coe_injective.semilattice_sup _ (λ _ _, rfl)

instance [t2_space α] : distrib_lattice (compacts α) :=
set_like.coe_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl)

instance : order_bot (compacts α) := order_bot.lift (coe : _ → set α) (λ _ _, id) rfl

instance [compact_space α] : bounded_order (compacts α) :=
bounded_order.lift (coe : _ → set α) (λ _ _, id) rfl rfl

/-- The type of compact sets is inhabited, with default element the empty set. -/
instance : inhabited (compacts α) := ⟨⊥⟩

@[simp] lemma coe_sup (s t : compacts α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
@[simp] lemma coe_inf [t2_space α] (s t : compacts α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
@[simp] lemma coe_top [compact_space α] : (↑(⊤ : compacts α) : set α) = univ := rfl
@[simp] lemma coe_bot : (↑(⊥ : compacts α) : set α) = ∅ := rfl

@[simp] lemma coe_finset_sup {ι : Type*} {s : finset ι} {f : ι → compacts α} :
  (↑(s.sup f) : set α) = s.sup (λ i, f i) :=
begin
  classical,
  refine finset.induction_on s rfl (λ a s _ h, _),
  simp_rw [finset.sup_insert, coe_sup, sup_eq_union],
  congr',
end

/-- The image of a compact set under a continuous function. -/
protected def map (f : α → β) (hf : continuous f) (K : compacts α) : compacts β :=
⟨f '' K.1, K.2.image hf⟩

@[simp] lemma coe_map {f : α → β} (hf : continuous f) (s : compacts α) :
  (s.map f hf : set β) = f '' s := rfl

/-- A homeomorphism induces an equivalence on compact sets, by taking the image. -/
@[simp] protected def equiv (f : α ≃ₜ β) : compacts α ≃ compacts β :=
{ to_fun := compacts.map f f.continuous,
  inv_fun := compacts.map _ f.symm.continuous,
  left_inv := λ s, by { ext1, simp only [coe_map, ← image_comp, f.symm_comp_self, image_id] },
  right_inv := λ s, by { ext1, simp only [coe_map, ← image_comp, f.self_comp_symm, image_id] } }

/-- The image of a compact set under a homeomorphism can also be expressed as a preimage. -/
lemma equiv_to_fun_val (f : α ≃ₜ β) (K : compacts α) :
  (compacts.equiv f K).1 = f.symm ⁻¹' K.1 :=
congr_fun (image_eq_preimage_of_inverse f.left_inv f.right_inv) K.1

end compacts

/-! ### Nonempty compact sets -/

/-- The type of nonempty compact sets of a topological space. -/
structure nonempty_compacts (α : Type*) [topological_space α] extends compacts α :=
(nonempty' : carrier.nonempty)

namespace nonempty_compacts

instance : set_like (nonempty_compacts α) α :=
{ coe := λ s, s.carrier,
  coe_injective' := λ s t h, by { obtain ⟨⟨_, _⟩, _⟩ := s, obtain ⟨⟨_, _⟩, _⟩ := t, congr' } }

lemma compact (s : nonempty_compacts α) : is_compact (s : set α) := s.compact'
protected lemma nonempty (s : nonempty_compacts α) : (s : set α).nonempty := s.nonempty'

/-- Reinterpret a nonempty compact as a closed set. -/
def to_closeds [t2_space α] (s : nonempty_compacts α) : closeds α := ⟨s, s.compact.is_closed⟩

@[ext] protected lemma ext {s t : nonempty_compacts α} (h : (s : set α) = t) : s = t :=
set_like.ext' h

@[simp] lemma coe_mk (s : compacts α) (h) : (mk s h : set α) = s := rfl

instance : has_sup (nonempty_compacts α) :=
⟨λ s t, ⟨s.to_compacts ⊔ t.to_compacts, s.nonempty.mono $ subset_union_left _ _⟩⟩
instance [compact_space α] [nonempty α] : has_top (nonempty_compacts α) := ⟨⟨⊤, univ_nonempty⟩⟩

instance : semilattice_sup (nonempty_compacts α) :=
set_like.coe_injective.semilattice_sup _ (λ _ _, rfl)

instance [compact_space α] [nonempty α] : order_top (nonempty_compacts α) :=
order_top.lift (coe : _ → set α) (λ _ _, id) rfl

@[simp] lemma coe_sup (s t : nonempty_compacts α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
@[simp] lemma coe_top [compact_space α] [nonempty α] :
  (↑(⊤ : nonempty_compacts α) : set α) = univ := rfl

/-- In an inhabited space, the type of nonempty compact subsets is also inhabited, with
default element the singleton set containing the default element. -/
instance [inhabited α] : inhabited (nonempty_compacts α) :=
⟨{ carrier := {default}, compact' := is_compact_singleton, nonempty' := singleton_nonempty _ }⟩

instance to_compact_space {s : nonempty_compacts α} : compact_space s :=
is_compact_iff_compact_space.1 s.compact

instance to_nonempty {s : nonempty_compacts α} : nonempty s := s.nonempty.to_subtype

end nonempty_compacts

/-! ### Positive compact sets -/

/-- The type of compact sets nonempty interior of a topological space. See also `compacts` and
`nonempty_compacts` -/
structure positive_compacts (α : Type*) [topological_space α] extends compacts α :=
(interior_nonempty' : (interior carrier).nonempty)

namespace positive_compacts

instance : set_like (positive_compacts α) α :=
{ coe := λ s, s.carrier,
  coe_injective' := λ s t h, by { obtain ⟨⟨_, _⟩, _⟩ := s, obtain ⟨⟨_, _⟩, _⟩ := t, congr' } }

lemma compact (s : positive_compacts α) : is_compact (s : set α) := s.compact'
lemma interior_nonempty (s : positive_compacts α) : (interior (s : set α)).nonempty :=
s.interior_nonempty'

/-- Reinterpret a positive compact as a nonempty compact. -/
def to_nonempty_compacts (s : positive_compacts α) : nonempty_compacts α :=
⟨s.to_compacts, s.interior_nonempty.mono interior_subset⟩

@[ext] protected lemma ext {s t : positive_compacts α} (h : (s : set α) = t) : s = t :=
set_like.ext' h

@[simp] lemma coe_mk (s : compacts α) (h) : (mk s h : set α) = s := rfl

instance : has_sup (positive_compacts α) :=
⟨λ s t, ⟨s.to_compacts ⊔ t.to_compacts,
  s.interior_nonempty.mono $ interior_mono $ subset_union_left _ _⟩⟩
instance [compact_space α] [nonempty α] : has_top (positive_compacts α) :=
⟨⟨⊤, interior_univ.symm.subst univ_nonempty⟩⟩

instance : semilattice_sup (positive_compacts α) :=
set_like.coe_injective.semilattice_sup _ (λ _ _, rfl)

instance [compact_space α] [nonempty α] : order_top (positive_compacts α) :=
order_top.lift (coe : _ → set α) (λ _ _, id) rfl

@[simp] lemma coe_sup (s t : positive_compacts α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
@[simp] lemma coe_top [compact_space α] [nonempty α] :
  (↑(⊤ : positive_compacts α) : set α) = univ := rfl

instance [compact_space α] [nonempty α] : inhabited (positive_compacts α) := ⟨⊤⟩

/-- In a nonempty locally compact space, there exists a compact set with nonempty interior. -/
instance [locally_compact_space α] [nonempty α] : nonempty (positive_compacts α) :=
let ⟨s, hs⟩ := exists_compact_subset is_open_univ $ mem_univ (classical.arbitrary α) in
  ⟨{ carrier := s, compact' := hs.1, interior_nonempty' := ⟨_, hs.2.1⟩ }⟩

end positive_compacts

/-! ### Compact open sets -/

/-- The type of compact open sets of a topological space. This is useful in non Hausdorff contexts,
in particular spectral spaces. -/
structure compact_opens (α : Type*) [topological_space α] extends compacts α :=
(open' : is_open carrier)

namespace compact_opens

instance : set_like (compact_opens α) α :=
{ coe := λ s, s.carrier,
  coe_injective' := λ s t h, by { obtain ⟨⟨_, _⟩, _⟩ := s, obtain ⟨⟨_, _⟩, _⟩ := t, congr' } }

lemma compact (s : compact_opens α) : is_compact (s : set α) := s.compact'
lemma «open» (s : compact_opens α) : is_open (s : set α) := s.open'

/-- Reinterpret a compact open as an open. -/
@[simps] def to_opens (s : compact_opens α) : opens α := ⟨s, s.open⟩

/-- Reinterpret a compact open as a clopen. -/
@[simps] def to_clopens [t2_space α] (s : compact_opens α) : clopens α :=
⟨s, s.open, s.compact.is_closed⟩

@[ext] protected lemma ext {s t : compact_opens α} (h : (s : set α) = t) : s = t := set_like.ext' h

@[simp] lemma coe_mk (s : compacts α) (h) : (mk s h : set α) = s := rfl

instance : has_sup (compact_opens α) :=
⟨λ s t, ⟨s.to_compacts ⊔ t.to_compacts, s.open.union t.open⟩⟩
instance [t2_space α] : has_inf (compact_opens α) :=
⟨λ s t, ⟨s.to_compacts ⊓ t.to_compacts, s.open.inter t.open⟩⟩
instance [compact_space α] : has_top (compact_opens α) := ⟨⟨⊤, is_open_univ⟩⟩
instance : has_bot (compact_opens α) := ⟨⟨⊥, is_open_empty⟩⟩
instance [t2_space α] : has_sdiff (compact_opens α) :=
⟨λ s t, ⟨⟨s \ t, s.compact.diff t.open⟩, s.open.sdiff t.compact.is_closed⟩⟩
instance [t2_space α] [compact_space α] : has_compl (compact_opens α) :=
⟨λ s, ⟨⟨sᶜ, s.open.is_closed_compl.is_compact⟩, s.compact.is_closed.is_open_compl⟩⟩

instance : semilattice_sup (compact_opens α) :=
set_like.coe_injective.semilattice_sup _ (λ _ _, rfl)

instance : order_bot (compact_opens α) := order_bot.lift (coe : _ → set α) (λ _ _, id) rfl

instance [t2_space α] : generalized_boolean_algebra (compact_opens α) :=
set_like.coe_injective.generalized_boolean_algebra _ (λ _ _, rfl) (λ _ _, rfl) rfl (λ _ _, rfl)

instance [compact_space α] : bounded_order (compact_opens α) :=
bounded_order.lift (coe : _ → set α) (λ _ _, id) rfl rfl

instance [t2_space α] [compact_space α] : boolean_algebra (compact_opens α) :=
set_like.coe_injective.boolean_algebra _ (λ _ _, rfl) (λ _ _, rfl) rfl rfl (λ _, rfl) (λ _ _, rfl)

@[simp] lemma coe_sup (s t : compact_opens α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
@[simp] lemma coe_inf [t2_space α] (s t : compact_opens α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
@[simp] lemma coe_top [compact_space α] : (↑(⊤ : compact_opens α) : set α) = univ := rfl
@[simp] lemma coe_bot : (↑(⊥ : compact_opens α) : set α) = ∅ := rfl
@[simp]

instance : inhabited (compact_opens α) := ⟨⊥⟩

/-- The image of a compact open under a continuous open map. -/
@[simps] def map (f : α → β) (hf : continuous f) (hf' : is_open_map f) (s : compact_opens α) :
  compact_opens β :=
⟨s.to_compacts.map f hf, hf' _ s.open⟩

@[simp] lemma coe_map {f : α → β} (hf : continuous f) (hf' : is_open_map f) (s : compact_opens α) :
  (s.map f hf hf' : set β) = f '' s := rfl

end compact_opens
end topological_space


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.quaternion_basis
import data.complex.module
import linear_algebra.clifford_algebra.conjugation

/-!
# Other constructions isomorphic to Clifford Algebras

This file contains isomorphisms showing that other types are equivalent to some `clifford_algebra`.

## Rings

* `clifford_algebra_ring.equiv`: any ring is equivalent to a `clifford_algebra` over a
  zero-dimensional vector space.

## Complex numbers

* `clifford_algebra_complex.equiv`: the `complex` numbers are equivalent as an `ℝ`-algebra to a
  `clifford_algebra` over a one-dimensional vector space with a quadratic form that satisfies
  `Q (ι Q 1) = -1`.
* `clifford_algebra_complex.to_complex`: the forward direction of this equiv
* `clifford_algebra_complex.of_complex`: the reverse direction of this equiv

We show additionally that this equivalence sends `complex.conj` to `clifford_algebra.involute` and
vice-versa:

* `clifford_algebra_complex.to_complex_involute`
* `clifford_algebra_complex.of_complex_conj`

Note that in this algebra `clifford_algebra.reverse` is the identity and so the clifford conjugate
is the same as `clifford_algebra.involute`.

## Quaternion algebras

* `clifford_algebra_quaternion.equiv`: a `quaternion_algebra` over `R` is equivalent as an
  `R`-algebra to a clifford algebra over `R × R`, sending `i` to `(0, 1)` and `j` to `(1, 0)`.
* `clifford_algebra_quaternion.to_quaternion`: the forward direction of this equiv
* `clifford_algebra_quaternion.of_quaternion`: the reverse direction of this equiv

We show additionally that this equivalence sends `quaternion_algebra.conj` to the clifford conjugate
and vice-versa:

* `clifford_algebra_quaternion.to_quaternion_involute_reverse`
* `clifford_algebra_quaternion.of_quaternion_conj`

-/

open clifford_algebra

/-! ### The clifford algebra isomorphic to a ring -/
namespace clifford_algebra_ring
open_locale complex_conjugate

variables {R : Type*} [comm_ring R]

@[simp]
lemma ι_eq_zero : ι (0 : quadratic_form R unit) = 0 :=
subsingleton.elim _ _

/-- Since the vector space is empty the ring is commutative. -/
instance : comm_ring (clifford_algebra (0 : quadratic_form R unit)) :=
{ mul_comm := λ x y, begin
    induction x using clifford_algebra.induction,
    case h_grade0 : r { apply algebra.commutes, },
    case h_grade1 : x { simp, },
    case h_add : x₁ x₂ hx₁ hx₂ { rw [mul_add, add_mul, hx₁, hx₂], },
    case h_mul : x₁ x₂ hx₁ hx₂ { rw [mul_assoc, hx₂, ←mul_assoc, hx₁, ←mul_assoc], },
  end,
  ..clifford_algebra.ring _ }

lemma reverse_apply (x : clifford_algebra (0 : quadratic_form R unit)) : x.reverse = x :=
begin
  induction x using clifford_algebra.induction,
  case h_grade0 : r { exact reverse.commutes _},
  case h_grade1 : x { rw [ι_eq_zero, linear_map.zero_apply, reverse.map_zero] },
  case h_mul : x₁ x₂ hx₁ hx₂ { rw [reverse.map_mul, mul_comm, hx₁, hx₂] },
  case h_add : x₁ x₂ hx₁ hx₂ { rw [reverse.map_add, hx₁, hx₂] },
end

@[simp] lemma reverse_eq_id :
  (reverse : clifford_algebra (0 : quadratic_form R unit) →ₗ[R] _) = linear_map.id :=
linear_map.ext reverse_apply

@[simp] lemma involute_eq_id :
  (involute : clifford_algebra (0 : quadratic_form R unit) →ₐ[R] _) = alg_hom.id R _ :=
by { ext, simp }

/-- The clifford algebra over a 0-dimensional vector space is isomorphic to its scalars. -/
protected def equiv : clifford_algebra (0 : quadratic_form R unit) ≃ₐ[R] R :=
alg_equiv.of_alg_hom
  (clifford_algebra.lift (0 : quadratic_form R unit) $
    ⟨0, λ m : unit, (zero_mul (0 : R)).trans (algebra_map R _).map_zero.symm⟩)
  (algebra.of_id R _)
  (by { ext x, exact (alg_hom.commutes _ x), })
  (by { ext : 1, rw [ι_eq_zero, linear_map.comp_zero, linear_map.comp_zero], })

end clifford_algebra_ring

/-! ### The clifford algebra isomorphic to the complex numbers -/
namespace clifford_algebra_complex
open_locale complex_conjugate

/-- The quadratic form sending elements to the negation of their square. -/
def Q : quadratic_form ℝ ℝ := -quadratic_form.lin_mul_lin linear_map.id linear_map.id

@[simp]
lemma Q_apply (r : ℝ) : Q r = - (r * r) := rfl

/-- Intermediate result for `clifford_algebra_complex.equiv`: clifford algebras over
`clifford_algebra_complex.Q` above can be converted to `ℂ`. -/
def to_complex : clifford_algebra Q →ₐ[ℝ] ℂ :=
clifford_algebra.lift Q ⟨linear_map.to_span_singleton _ _ complex.I, λ r, begin
  dsimp [linear_map.to_span_singleton, linear_map.id],
  rw mul_mul_mul_comm,
  simp,
end⟩

@[simp]
lemma to_complex_ι (r : ℝ) : to_complex (ι Q r) = r • complex.I :=
clifford_algebra.lift_ι_apply _ _ r

/-- `clifford_algebra.involute` is analogous to `complex.conj`. -/
@[simp] lemma to_complex_involute (c : clifford_algebra Q) :
  to_complex (c.involute) = conj (to_complex c) :=
begin
  have : to_complex (involute (ι Q 1)) = conj (to_complex (ι Q 1)),
  { simp only [involute_ι, to_complex_ι, alg_hom.map_neg, one_smul, complex.conj_I] },
  suffices : to_complex.comp involute = complex.conj_ae.to_alg_hom.comp to_complex,
  { exact alg_hom.congr_fun this c },
  ext : 2,
  exact this
end

/-- Intermediate result for `clifford_algebra_complex.equiv`: `ℂ` can be converted to
`clifford_algebra_complex.Q` above can be converted to. -/
def of_complex : ℂ →ₐ[ℝ] clifford_algebra Q :=
complex.lift ⟨
  clifford_algebra.ι Q 1,
  by rw [clifford_algebra.ι_sq_scalar, Q_apply, one_mul, ring_hom.map_neg, ring_hom.map_one]⟩

@[simp]
lemma of_complex_I : of_complex complex.I = ι Q 1 :=
complex.lift_aux_apply_I _ _

@[simp] lemma to_complex_comp_of_complex : to_complex.comp of_complex = alg_hom.id ℝ ℂ :=
begin
  ext1,
  dsimp only [alg_hom.comp_apply, subtype.coe_mk, alg_hom.id_apply],
  rw [of_complex_I, to_complex_ι, one_smul],
end

@[simp] lemma to_complex_of_complex (c : ℂ) : to_complex (of_complex c) = c :=
alg_hom.congr_fun to_complex_comp_of_complex c

@[simp] lemma of_complex_comp_to_complex :
  of_complex.comp to_complex = alg_hom.id ℝ (clifford_algebra Q) :=
begin
  ext,
  dsimp only [linear_map.comp_apply, subtype.coe_mk, alg_hom.id_apply,
    alg_hom.to_linear_map_apply, alg_hom.comp_apply],
  rw [to_complex_ι, one_smul, of_complex_I],
end

@[simp] lemma of_complex_to_complex (c : clifford_algebra Q) : of_complex (to_complex c) = c :=
alg_hom.congr_fun of_complex_comp_to_complex c

/-- The clifford algebras over `clifford_algebra_complex.Q` is isomorphic as an `ℝ`-algebra to
`ℂ`. -/
@[simps]
protected def equiv : clifford_algebra Q ≃ₐ[ℝ] ℂ :=
alg_equiv.of_alg_hom to_complex of_complex to_complex_comp_of_complex of_complex_comp_to_complex

/-- The clifford algebra is commutative since it is isomorphic to the complex numbers.

TODO: prove this is true for all `clifford_algebra`s over a 1-dimensional vector space. -/
instance : comm_ring (clifford_algebra Q) :=
{ mul_comm := λ x y, clifford_algebra_complex.equiv.injective $
    by rw [alg_equiv.map_mul, mul_comm, alg_equiv.map_mul],
  .. clifford_algebra.ring _ }

/-- `reverse` is a no-op over `clifford_algebra_complex.Q`. -/
lemma reverse_apply (x : clifford_algebra Q) : x.reverse = x :=
begin
  induction x using clifford_algebra.induction,
  case h_grade0 : r { exact reverse.commutes _},
  case h_grade1 : x { rw [reverse_ι] },
  case h_mul : x₁ x₂ hx₁ hx₂ { rw [reverse.map_mul, mul_comm, hx₁, hx₂] },
  case h_add : x₁ x₂ hx₁ hx₂ { rw [reverse.map_add, hx₁, hx₂] },
end

@[simp]
lemma reverse_eq_id : (reverse : clifford_algebra Q →ₗ[ℝ] _) = linear_map.id :=
linear_map.ext reverse_apply

/-- `complex.conj` is analogous to `clifford_algebra.involute`. -/
@[simp] lemma of_complex_conj (c : ℂ) : of_complex (conj c) = (of_complex c).involute :=
clifford_algebra_complex.equiv.injective $
  by rw [equiv_apply, equiv_apply, to_complex_involute, to_complex_of_complex,
    to_complex_of_complex]

-- this name is too short for us to want it visible after `open clifford_algebra_complex`
attribute [protected] Q

end clifford_algebra_complex

/-! ### The clifford algebra isomorphic to the quaternions -/
namespace clifford_algebra_quaternion

open_locale quaternion
open quaternion_algebra

variables {R : Type*} [comm_ring R] (c₁ c₂ : R)

/-- `Q c₁ c₂` is a quadratic form over `R × R` such that `clifford_algebra (Q c₁ c₂)` is isomorphic
as an `R`-algebra to `ℍ[R,c₁,c₂]`. -/
def Q : quadratic_form R (R × R) :=
c₁ • quadratic_form.lin_mul_lin (linear_map.fst _ _ _) (linear_map.fst _ _ _) +
c₂ • quadratic_form.lin_mul_lin (linear_map.snd _ _ _) (linear_map.snd _ _ _)

@[simp]
lemma Q_apply (v : R × R) : Q c₁ c₂ v = c₁ * (v.1 * v.1) + c₂ * (v.2 * v.2) := rfl

/-- The quaternion basis vectors within the algebra. -/
@[simps i j k]
def quaternion_basis : quaternion_algebra.basis (clifford_algebra (Q c₁ c₂)) c₁ c₂ :=
{ i := ι (Q c₁ c₂) (1, 0),
  j := ι (Q c₁ c₂) (0, 1),
  k := ι (Q c₁ c₂) (1, 0) * ι (Q c₁ c₂) (0, 1),
  i_mul_i := begin
    rw [ι_sq_scalar, Q_apply, ←algebra.algebra_map_eq_smul_one],
    simp,
  end,
  j_mul_j := begin
    rw [ι_sq_scalar, Q_apply, ←algebra.algebra_map_eq_smul_one],
    simp,
  end,
  i_mul_j := rfl,
  j_mul_i := begin
    rw [eq_neg_iff_add_eq_zero, ι_mul_ι_add_swap, quadratic_form.polar],
    simp,
  end }

variables {c₁ c₂}

/-- Intermediate result of `clifford_algebra_quaternion.equiv`: clifford algebras over
`clifford_algebra_quaternion.Q` can be converted to `ℍ[R,c₁,c₂]`. -/
def to_quaternion : clifford_algebra (Q c₁ c₂) →ₐ[R] ℍ[R,c₁,c₂] :=
clifford_algebra.lift (Q c₁ c₂) ⟨
  { to_fun := λ v, (⟨0, v.1, v.2, 0⟩ : ℍ[R,c₁,c₂]),
    map_add' := λ v₁ v₂, by simp,
    map_smul' := λ r v, by ext; simp },
  λ v, begin
    dsimp,
    ext,
    all_goals {dsimp, ring},
  end⟩

@[simp]
lemma to_quaternion_ι (v : R × R) :
  to_quaternion (ι (Q c₁ c₂) v) = (⟨0, v.1, v.2, 0⟩ : ℍ[R,c₁,c₂]) :=
clifford_algebra.lift_ι_apply _ _ v

/-- The "clifford conjugate" (aka `involute ∘ reverse = reverse ∘ involute`) maps to the quaternion
conjugate. -/
lemma to_quaternion_involute_reverse (c : clifford_algebra (Q c₁ c₂)) :
  to_quaternion (involute (reverse c)) = quaternion_algebra.conj (to_quaternion c) :=
begin
  induction c using clifford_algebra.induction,
  case h_grade0 : r
  { simp only [reverse.commutes, alg_hom.commutes, quaternion_algebra.coe_algebra_map,
      quaternion_algebra.conj_coe], },
  case h_grade1 : x
  { rw [reverse_ι, involute_ι, to_quaternion_ι, alg_hom.map_neg, to_quaternion_ι,
      quaternion_algebra.neg_mk, conj_mk, neg_zero], },
  case h_mul : x₁ x₂ hx₁ hx₂
  { simp only [reverse.map_mul, alg_hom.map_mul, hx₁, hx₂, quaternion_algebra.conj_mul] },
  case h_add : x₁ x₂ hx₁ hx₂
  { simp only [reverse.map_add, alg_hom.map_add, hx₁, hx₂, quaternion_algebra.conj_add] },
end

/-- Map a quaternion into the clifford algebra. -/
def of_quaternion : ℍ[R,c₁,c₂] →ₐ[R] clifford_algebra (Q c₁ c₂) :=
(quaternion_basis c₁ c₂).lift_hom

@[simp] lemma of_quaternion_mk (a₁ a₂ a₃ a₄ : R) :
  of_quaternion (⟨a₁, a₂, a₃, a₄⟩ : ℍ[R,c₁,c₂])
    = algebra_map R _ a₁
    + a₂ • ι (Q c₁ c₂) (1, 0)
    + a₃ • ι (Q c₁ c₂) (0, 1)
    + a₄ • (ι (Q c₁ c₂) (1, 0) * ι (Q c₁ c₂) (0, 1)) := rfl

@[simp]
lemma of_quaternion_comp_to_quaternion :
  of_quaternion.comp to_quaternion = alg_hom.id R (clifford_algebra (Q c₁ c₂)) :=
begin
  ext : 1,
  dsimp, -- before we end up with two goals and have to do this twice
  ext,
  all_goals
  { dsimp,
    rw to_quaternion_ι,
    dsimp,
    simp only [to_quaternion_ι, zero_smul, one_smul, zero_add, add_zero, ring_hom.map_zero], },
end

@[simp] lemma of_quaternion_to_quaternion (c : clifford_algebra (Q c₁ c₂)) :
  of_quaternion (to_quaternion c) = c :=
alg_hom.congr_fun
  (of_quaternion_comp_to_quaternion : _ = alg_hom.id R (clifford_algebra (Q c₁ c₂))) c

@[simp]
lemma to_quaternion_comp_of_quaternion :
  to_quaternion.comp of_quaternion = alg_hom.id R ℍ[R,c₁,c₂] :=
begin
  apply quaternion_algebra.lift.symm.injective,
  ext1; dsimp [quaternion_algebra.basis.lift]; simp,
end

@[simp] lemma to_quaternion_of_quaternion (q : ℍ[R,c₁,c₂]) : to_quaternion (of_quaternion q) = q :=
alg_hom.congr_fun (to_quaternion_comp_of_quaternion : _ = alg_hom.id R ℍ[R,c₁,c₂]) q

/-- The clifford algebra over `clifford_algebra_quaternion.Q c₁ c₂` is isomorphic as an `R`-algebra
to `ℍ[R,c₁,c₂]`. -/
@[simps]
protected def equiv : clifford_algebra (Q c₁ c₂) ≃ₐ[R] ℍ[R,c₁,c₂] :=
alg_equiv.of_alg_hom to_quaternion of_quaternion
  to_quaternion_comp_of_quaternion
  of_quaternion_comp_to_quaternion

/-- The quaternion conjugate maps to the "clifford conjugate" (aka
`involute ∘ reverse = reverse ∘ involute`). -/
@[simp] lemma of_quaternion_conj (q : ℍ[R,c₁,c₂]) :
  of_quaternion (q.conj) = (of_quaternion q).reverse.involute :=
clifford_algebra_quaternion.equiv.injective $
  by rw [equiv_apply, equiv_apply, to_quaternion_involute_reverse, to_quaternion_of_quaternion,
    to_quaternion_of_quaternion]

-- this name is too short for us to want it visible after `open clifford_algebra_quaternion`
attribute [protected] Q

end clifford_algebra_quaternion


/-
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.set.finite group_theory.coset

universes u v
variables {α : Type u} {β : Type v}

class is_monoid_action [monoid α] (f : α → β → β) : Prop :=
(one : ∀ a : β, f (1 : α) a = a)
(mul : ∀ (x y : α) (a : β), f (x * y) a = f x (f y a))

namespace is_monoid_action

variables [monoid α] (f : α → β → β) [is_monoid_action f]

def orbit (a : β) := set.range (λ x : α, f x a)

@[simp] lemma mem_orbit_iff {f : α → β → β} [is_monoid_action f] {a b : β} :
  b ∈ orbit f a ↔ ∃ x : α, f x a = b :=
iff.rfl

@[simp] lemma mem_orbit (a : β) (x : α) :
  f x a ∈ orbit f a :=
⟨x, rfl⟩

@[simp] lemma mem_orbit_self (a : β) :
  a ∈ orbit f a :=
⟨1, show f 1 a = a, by simp [is_monoid_action.one f]⟩

instance orbit_fintype (a : β) [fintype α] [decidable_eq β] :
  fintype (orbit f a) := set.fintype_range _

def stabilizer (a : β) : set α :=
{x : α | f x a = a}

@[simp] lemma mem_stabilizer_iff {f : α → β → β} [is_monoid_action f] {a : β} {x : α} :
  x ∈ stabilizer f a ↔ f x a = a :=
iff.rfl

def fixed_points : set β := {a : β | ∀ x, x ∈ stabilizer f a}

@[simp] lemma mem_fixed_points {f : α → β → β} [is_monoid_action f] {a : β} :
  a ∈ fixed_points f ↔ ∀ x : α, f x a = a := iff.rfl

lemma mem_fixed_points' {f : α → β → β} [is_monoid_action f] {a : β} : a ∈ fixed_points f ↔
  (∀ b, b ∈ orbit f a → b = a) :=
⟨λ h b h₁, let ⟨x, hx⟩ := mem_orbit_iff.1 h₁ in hx ▸ h x,
λ h b, mem_stabilizer_iff.2 (h _ (mem_orbit _ _ _))⟩

end is_monoid_action

class is_group_action [group α] (f : α → β → β) extends is_monoid_action f

namespace is_group_action
variables [group α] (f : α → β → β) [is_group_action f]
open is_monoid_action

def to_perm (g : α) : equiv.perm β :=
{ to_fun := f g,
  inv_fun := f g⁻¹,
  left_inv := λ a, by rw [← is_monoid_action.mul f, inv_mul_self, is_monoid_action.one f],
  right_inv := λ a, by rw [← is_monoid_action.mul f, mul_inv_self, is_monoid_action.one f] }

instance : is_group_hom (to_perm f) :=
{ mul := λ x y, equiv.ext _ _ (λ a, is_monoid_action.mul f x y a) }

lemma bijective (g : α) : function.bijective (f g) :=
(to_perm f g).bijective

lemma orbit_eq_iff {f : α → β → β} [is_monoid_action f] {a b : β} :
   orbit f a = orbit f b ↔ a ∈ orbit f b:=
⟨λ h, h ▸ mem_orbit_self _ _,
λ ⟨x, (hx : f x b = a)⟩, set.ext (λ c, ⟨λ ⟨y, (hy : f y a = c)⟩, ⟨y * x,
  show f (y * x) b = c, by rwa [is_monoid_action.mul f, hx]⟩,
  λ ⟨y, (hy : f y b = c)⟩, ⟨y * x⁻¹,
    show f (y * x⁻¹) a = c, by
      conv {to_rhs, rw [← hy, ← mul_one y, ← inv_mul_self x, ← mul_assoc,
        is_monoid_action.mul f, hx]}⟩⟩)⟩

instance (a : β) : is_subgroup (stabilizer f a) :=
{ one_mem := is_monoid_action.one _ _,
  mul_mem := λ x y (hx : f x a = a) (hy : f y a = a),
    show f (x * y) a = a, by rw is_monoid_action.mul f; simp *,
  inv_mem := λ x (hx : f x a = a), show f x⁻¹ a = a,
    by rw [← hx, ← is_monoid_action.mul f, inv_mul_self, is_monoid_action.one f, hx] }

open quotient_group

noncomputable def orbit_equiv_quotient_stabilizer (a : β) :
  orbit f a ≃ quotient (stabilizer f a) :=
equiv.symm (@equiv.of_bijective _ _
  (λ x : quotient (stabilizer f a), quotient.lift_on' x
    (λ x, (⟨f x a, mem_orbit _ _ _⟩ : orbit f a))
    (λ g h (H : _ = _), subtype.eq $ (is_group_action.bijective f (g⁻¹)).1
      $ show f g⁻¹ (f g a) = f g⁻¹ (f h a),
      by rw [← is_monoid_action.mul f, ← is_monoid_action.mul f,
        H, inv_mul_self, is_monoid_action.one f]))
⟨λ g h, quotient.induction_on₂' g h (λ g h H, quotient.sound' $
  have H : f g a = f h a := subtype.mk.inj H,
  show f (g⁻¹ * h) a = a,
  by rw [is_monoid_action.mul f, ← H, ← is_monoid_action.mul f, inv_mul_self,
    is_monoid_action.one f]),
  λ ⟨b, ⟨g, hgb⟩⟩, ⟨g, subtype.eq hgb⟩⟩)

end is_group_action


import tactic
import data.set
import order.conditionally_complete_lattice

import .defs
import .sequences

noncomputable theory
open_locale classical

section suites
variables {X: Type} [conditionally_complete_linear_order X]
def suite_st_croissante {S: set X}
  (Hinf: set.infinite S)
  (Hset: (∀ M ⊆ S, M.nonempty → is_least M (Inf M))) : ℕ → X :=
  well_founded.fix nat.lt_wf
  (λ n suite_st_croissante,
    Inf (S \ { x : X | ∃ k < n, suite_st_croissante k H = x}))

def suite_st_croissante_def {S: set X}
  (Hinf: set.infinite S)
  (Hset: (∀ M ⊆ S, M.nonempty → is_least M (Inf M))) (n: ℕ):
    suite_st_croissante Hinf Hset n = Inf (S \ { x: X | ∃ k < n, suite_st_croissante Hinf Hset k = x })
    := well_founded.fix_eq _ _ _

lemma suite_st_croissante_image {S: set X}
 (Hinf: set.infinite S) (Hset: (∀ M ⊆ S, M.nonempty → is_least M (Inf M))) (n: ℕ):
    {x : X | ∃ k < n, suite_st_croissante Hinf Hset k = x}
      = (suite_st_croissante Hinf Hset) '' { i : ℕ | i < n} := by ext; simp

lemma suite_st_croissante_finite {S: set X}
 (Hinf: set.infinite S) (Hset: (∀ M ⊆ S, M.nonempty → is_least M (Inf M))) (n: ℕ):
  ({x : X | ∃ k < n, suite_st_croissante Hinf Hset k = x}).finite := begin
    rw suite_st_croissante_image,
    apply set.finite_image,
    apply set.finite_lt_nat,
 end

lemma suite_st_croissante_nonempty {S: set X}
 (Hinf: set.infinite S) (Hset: (∀ M ⊆ S, M.nonempty → is_least M (Inf M))) (n: ℕ):
    (S \ { x: X | ∃ k < n, suite_st_croissante Hinf Hset k = x }).nonempty :=
  begin
  set L := {x : X | ∃ (k : ℕ) (H : k < n), suite_st_croissante Hinf Hset k = x},
  by_contra,
  apply Hinf,
  have a := set.not_nonempty_iff_eq_empty.1 a,
  have := set.diff_eq_empty.1 a,
  apply set.finite_subset,
  exact suite_st_croissante_finite Hinf Hset n,
  exact this,
  end

lemma suite_st_croissante_subset {S: set X}
 (Hinf: set.infinite S) (Hset: (∀ M ⊆ S, M.nonempty → is_least M (Inf M))) (p: ℕ) (q: ℕ):
    p ≤ q →
    S \ { x: X | ∃ k < q, suite_st_croissante Hinf Hset k = x } ⊆  S \ { x: X | ∃ k < p, suite_st_croissante Hinf Hset k = x } :=
    begin
    intro h,
    apply set.diff_subset_diff_right,
    rw suite_st_croissante_image,
    rw suite_st_croissante_image,
    apply set.image_subset,
    intros i hi,
    simp at hi,
    simp,
    exact lt_of_lt_of_le hi h,
    end

lemma suite_st_croissante_mem {S: set X}
 (Hinf: set.infinite S) (Hset: (∀ M ⊆ S, M.nonempty → is_least M (Inf M))) (n: ℕ):
    suite_st_croissante Hinf Hset n ∈ S :=
  begin
  rw suite_st_croissante_def,
  set L := S \ { x: X | ∃ k < n, suite_st_croissante Hinf Hset k = x },
  have Hmem: L ⊆ S := set.diff_subset S _,
  apply Hmem,
  exact (Hset L Hmem (suite_st_croissante_nonempty _ _ n)).1,
  end

lemma suite_st_croissante_props (S: set X)
  (Hinf: set.infinite S):
  (∀ M ⊆ S, M.nonempty → is_least M (Inf M)) → ∃ x : ℕ → X, strictement_croissante x ∧ (set.range x) ⊆ S :=
  begin
  intro H,
  use suite_st_croissante Hinf H,
  split,
  intros p q hq,
  -- ici il s'agit de prouver une inégalité stricte entre deux infs.
  -- il faut comprendre: S_q est inclus strictement dans S_p
  -- donc inf S_p ≤ inf S_q
  -- de plus (inf S_p) = suite_st_croissante p
  -- donc, (inf S_p) n'est pas dans S_q
  -- or, inf S_q est dans S_q
  -- donc, inf S_p < inf S_q.
  -- niveau: moyen+
  apply lt_of_le_of_ne,
  rw suite_st_croissante_def,
  rw suite_st_croissante_def,
  set ssc := suite_st_croissante Hinf H with ← hssc,
  have S_nonempty: ∀ n, (S \ { x : X | ∃ k < n, ssc k = x }).nonempty := suite_st_croissante_nonempty Hinf _,
  set Sp := S \ {x : X | ∃ k < p, ssc k = x} with ← hsp,
  set Sq := S \ {x : X | ∃ k < q, ssc k = x} with ← hsq,
  apply cInf_le_cInf,
  have S_bdd: ∀ n, bdd_below (S \ { x : X | ∃ k < n, ssc k = x }) :=
  begin
    {
      intro n,
      set Sn := (S \ { x : X | ∃ k < n, ssc k = x }),
      apply is_least.bdd_below,
      apply H,
      exact set.diff_subset S _,
      exact S_nonempty n,
    }
  end,
  apply S_bdd p,
  exact S_nonempty q,
  exact suite_st_croissante_subset Hinf H _ _ (le_of_lt hq),
  set ssc := suite_st_croissante Hinf H with ← hssc,
  set Sqq := {x : X | ∃ (k : ℕ) (H : k < q), ssc k = x} with ← hspp,
  set Sp := S \ {x : X | ∃ k < p, ssc k = x} with ← hsp,
  set Sq := S \ Sqq with ← hsq,
  by_contra,
  push_neg at a, -- x_p = x_q est impossible par construction de x.
  -- en effet, puisque p < q, alors x_p = x_q = inf S_q = inf (S \ (réunion_(k < q) S_k)), or x_p est dans S_p
  -- donc: x_p n'est pas dans S \ (réunion (k < q) S_k), donc x_p != inf (S \ …)
  -- ABSURDE.
  have Hn: ∀ n, ssc n ∈ (S \ { x: X | ∃ k < n, ssc k = x }) := begin
  {
    intro n,
    set Sn := S \ {x : X | ∃ k < n, ssc k = x} with ← hsn,
    rw ← hssc,
    rw suite_st_croissante_def,
    rw hssc,
    rw hsn,
    exact (H Sn (set.diff_subset S _) (suite_st_croissante_nonempty Hinf H _)).1,
  }
  end,
  have Hp := Hn q,
  rw ← a at Hp,
  rw hsq at Hp,
  have Hnp := set.not_mem_of_mem_diff Hp,
  have Hpp: ssc p ∈ Sqq := begin
    use p,
    split,
    exact hq,
    refl,
  end,
  exact Hnp Hpp,
  intros x hx,
  simp at hx,
  obtain ⟨ y ⟩ := hx,
  rw ← hx_h,
  exact suite_st_croissante_mem Hinf H _,
end
end suites