/-
Copyright (c) 2022 Xavier Roblot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best, Xavier Roblot
-/

import analysis.complex.polynomial
import field_theory.minpoly.is_integrally_closed
import number_theory.number_field.basic
import ring_theory.norm
import topology.instances.complex

/-!
# Embeddings of number fields
This file defines the embeddings of a number field into an algebraic closed field.

## Main Results
* `number_field.embeddings.range_eval_eq_root_set_minpoly`: let `x ∈ K` with `K` number field and
  let `A` be an algebraic closed field of char. 0, then the images of `x` by the embeddings of `K`
   in `A` are exactly the roots in `A` of the minimal polynomial of `x` over `ℚ`.
* `number_field.embeddings.pow_eq_one_of_norm_eq_one`: an algebraic integer whose conjugates are
  all of norm one is a root of unity.

## Tags
number field, embeddings, places, infinite places
-/

open_locale classical

namespace number_field.embeddings

section fintype

open finite_dimensional

variables (K : Type*) [field K] [number_field K]
variables (A : Type*) [field A] [char_zero A]

/-- There are finitely many embeddings of a number field. -/
noncomputable instance : fintype (K →+* A) := fintype.of_equiv (K →ₐ[ℚ] A)
ring_hom.equiv_rat_alg_hom.symm

variables [is_alg_closed A]

/-- The number of embeddings of a number field is equal to its finrank. -/
lemma card : fintype.card (K →+* A) = finrank ℚ K :=
by rw [fintype.of_equiv_card ring_hom.equiv_rat_alg_hom.symm, alg_hom.card]

instance : nonempty (K →+* A) :=
begin
  rw [← fintype.card_pos_iff, number_field.embeddings.card K A],
  exact finite_dimensional.finrank_pos,
end

end fintype

section roots

open set polynomial

variables (K A : Type*) [field K] [number_field K]
  [field A] [algebra ℚ A] [is_alg_closed A] (x : K)

/-- Let `A` be an algebraically closed field and let `x ∈ K`, with `K` a number field.
The images of `x` by the embeddings of `K` in `A` are exactly the roots in `A` of
the minimal polynomial of `x` over `ℚ`. -/
lemma range_eval_eq_root_set_minpoly : range (λ φ : K →+* A, φ x) = (minpoly ℚ x).root_set A :=
begin
  convert (number_field.is_algebraic K).range_eval_eq_root_set_minpoly A x using 1,
  ext a,
  exact ⟨λ ⟨φ, hφ⟩, ⟨φ.to_rat_alg_hom, hφ⟩, λ ⟨φ, hφ⟩, ⟨φ.to_ring_hom, hφ⟩⟩,
end

end roots

section bounded

open finite_dimensional polynomial set

variables {K : Type*} [field K] [number_field K]
variables {A : Type*} [normed_field A] [is_alg_closed A] [normed_algebra ℚ A]

lemma coeff_bdd_of_norm_le {B : ℝ} {x : K} (h : ∀ φ : K →+* A, ‖φ x‖ ≤ B) (i : ℕ) :
  ‖(minpoly ℚ x).coeff i‖ ≤ (max B 1) ^ (finrank ℚ K) * (finrank ℚ K).choose ((finrank ℚ K) / 2) :=
begin
  have hx := is_separable.is_integral ℚ x,
  rw [← norm_algebra_map' A, ← coeff_map (algebra_map ℚ A)],
  refine coeff_bdd_of_roots_le _ (minpoly.monic hx) (is_alg_closed.splits_codomain _)
    (minpoly.nat_degree_le hx) (λ z hz, _) i,
  classical, rw ← multiset.mem_to_finset at hz,
  obtain ⟨φ, rfl⟩ := (range_eval_eq_root_set_minpoly K A x).symm.subset hz,
  exact h φ,
end

variables (K A)

/-- Let `B` be a real number. The set of algebraic integers in `K` whose conjugates are all
smaller in norm than `B` is finite. -/
lemma finite_of_norm_le (B : ℝ) :
  {x : K | is_integral ℤ x ∧ ∀ φ : K →+* A, ‖φ x‖ ≤ B}.finite :=
begin
  let C := nat.ceil ((max B 1) ^ (finrank ℚ K) * (finrank ℚ K).choose ((finrank ℚ K) / 2)),
  have := bUnion_roots_finite (algebra_map ℤ K) (finrank ℚ K) (finite_Icc (-C : ℤ) C),
  refine this.subset (λ x hx, _), simp_rw mem_Union,
  have h_map_ℚ_minpoly := minpoly.is_integrally_closed_eq_field_fractions' ℚ hx.1,
  refine ⟨_, ⟨_, λ i, _⟩, mem_root_set.2 ⟨minpoly.ne_zero hx.1, minpoly.aeval ℤ x⟩⟩,
  { rw [← (minpoly.monic hx.1).nat_degree_map (algebra_map ℤ ℚ), ← h_map_ℚ_minpoly],
    exact minpoly.nat_degree_le (is_integral_of_is_scalar_tower hx.1) },
  rw [mem_Icc, ← abs_le, ← @int.cast_le ℝ],
  refine (eq.trans_le _ $ coeff_bdd_of_norm_le hx.2 i).trans (nat.le_ceil _),
  rw [h_map_ℚ_minpoly, coeff_map, eq_int_cast, int.norm_cast_rat, int.norm_eq_abs, int.cast_abs],
end

/-- An algebraic integer whose conjugates are all of norm one is a root of unity. -/
lemma pow_eq_one_of_norm_eq_one {x : K}
  (hxi : is_integral ℤ x) (hx : ∀ φ : K →+* A, ‖φ x‖ = 1) :
  ∃ (n : ℕ) (hn : 0 < n), x ^ n = 1 :=
begin
  obtain ⟨a, -, b, -, habne, h⟩ := @set.infinite.exists_ne_map_eq_of_maps_to _ _ _ _
    ((^) x : ℕ → K) set.infinite_univ _ (finite_of_norm_le K A (1:ℝ)),
  { wlog hlt : b < a,
    { exact this hxi hx b a habne.symm h.symm (habne.lt_or_lt.resolve_right hlt) },
    refine ⟨a - b, tsub_pos_of_lt hlt, _⟩,
    rw [← nat.sub_add_cancel hlt.le, pow_add, mul_left_eq_self₀] at h,
    refine h.resolve_right (λ hp, _),
    specialize hx (is_alg_closed.lift (number_field.is_algebraic K)).to_ring_hom,
    rw [pow_eq_zero hp, map_zero, norm_zero] at hx, norm_num at hx },
  { exact λ a _, ⟨hxi.pow a, λ φ, by simp only [hx φ, norm_pow, one_pow, map_pow]⟩ },
end

end bounded

end number_field.embeddings

section place

variables {K : Type*} [field K] {A : Type*} [normed_division_ring A] [nontrivial A] (φ : K →+* A)

/-- An embedding into a normed division ring defines a place of `K` -/
def number_field.place : absolute_value K ℝ :=
(is_absolute_value.to_absolute_value (norm : A → ℝ)).comp φ.injective

@[simp]
lemma number_field.place_apply (x : K) : (number_field.place φ) x = norm (φ x) := rfl

end place

namespace number_field.complex_embedding

open complex number_field

open_locale complex_conjugate

variables {K : Type*} [field K]

/-- The conjugate of a complex embedding as a complex embedding. -/
@[reducible] def conjugate (φ : K →+* ℂ) : K →+* ℂ := star φ

@[simp]
lemma conjugate_coe_eq (φ : K →+* ℂ) (x : K) : (conjugate φ) x = conj (φ x) := rfl

lemma place_conjugate (φ : K →+* ℂ) : place (conjugate φ) = place φ :=
by { ext, simp only [place_apply, norm_eq_abs, abs_conj, conjugate_coe_eq] }

/-- A embedding into `ℂ` is real if it is fixed by complex conjugation. -/
@[reducible] def is_real (φ : K →+* ℂ) : Prop := is_self_adjoint φ

lemma is_real_iff {φ : K →+* ℂ} : is_real φ ↔ conjugate φ = φ := is_self_adjoint_iff

/-- A real embedding as a ring homomorphism from `K` to `ℝ` . -/
def is_real.embedding {φ : K →+* ℂ} (hφ : is_real φ) : K →+* ℝ :=
{ to_fun := λ x, (φ x).re,
  map_one' := by simp only [map_one, one_re],
  map_mul' := by simp only [complex.eq_conj_iff_im.mp (ring_hom.congr_fun hφ _), map_mul, mul_re,
  mul_zero, tsub_zero, eq_self_iff_true, forall_const],
  map_zero' := by simp only [map_zero, zero_re],
  map_add' := by simp only [map_add, add_re, eq_self_iff_true, forall_const], }

@[simp]
lemma is_real.coe_embedding_apply {φ : K →+* ℂ} (hφ : is_real φ) (x : K) :
  (hφ.embedding x : ℂ) = φ x :=
begin
  ext, { refl, },
  { rw [of_real_im, eq_comm, ← complex.eq_conj_iff_im],
    rw is_real at hφ,
    exact ring_hom.congr_fun hφ x, },
end

lemma is_real.place_embedding {φ : K →+* ℂ} (hφ : is_real φ) :
  place hφ.embedding = place φ :=
by { ext x, simp only [place_apply, real.norm_eq_abs, ←abs_of_real, norm_eq_abs,
  hφ.coe_embedding_apply x], }

lemma is_real_conjugate_iff {φ : K →+* ℂ} :
  is_real (conjugate φ) ↔ is_real φ := is_self_adjoint.star_iff

end number_field.complex_embedding

section infinite_place

open number_field

variables (K : Type*) [field K]

/-- An infinite place of a number field `K` is a place associated to a complex embedding. -/
def number_field.infinite_place := { w : absolute_value K ℝ  // ∃ φ : K →+* ℂ, place φ = w}

instance [number_field K] : nonempty (number_field.infinite_place K) := set.range.nonempty _

variables {K}

/-- Return the infinite place defined by a complex embedding `φ`. -/
noncomputable def number_field.infinite_place.mk (φ : K →+* ℂ) : number_field.infinite_place K :=
⟨place φ, ⟨φ, rfl⟩⟩

namespace number_field.infinite_place

open number_field

instance : has_coe_to_fun (infinite_place K) (λ _, K → ℝ) := { coe := λ w, w.1 }

instance : monoid_with_zero_hom_class (infinite_place K) K ℝ :=
{ coe := λ w x, w.1 x,
  coe_injective' := λ _ _ h, subtype.eq (absolute_value.ext (λ x, congr_fun h x)),
  map_mul := λ w _ _, w.1.map_mul _ _,
  map_one := λ w, w.1.map_one,
  map_zero := λ w, w.1.map_zero, }

instance : nonneg_hom_class (infinite_place K) K ℝ :=
{ coe :=  λ w x, w x,
  coe_injective' := λ _ _ h, subtype.eq (absolute_value.ext (λ x, congr_fun h x)),
  map_nonneg := λ w x, w.1.nonneg _ }

lemma coe_mk (φ : K →+* ℂ) : ⇑(mk φ) = place φ := rfl

lemma apply (φ : K →+* ℂ) (x : K) : (mk φ) x = complex.abs (φ x) := rfl

/-- For an infinite place `w`, return an embedding `φ` such that `w = infinite_place φ` . -/
noncomputable def embedding (w : infinite_place K) : K →+* ℂ := (w.2).some

@[simp]
lemma mk_embedding (w : infinite_place K) :
  mk (embedding w) = w :=
subtype.ext (w.2).some_spec

@[simp]
lemma abs_embedding (w : infinite_place K) (x : K) :
  complex.abs (embedding w x) = w x := congr_fun (congr_arg coe_fn w.2.some_spec) x

lemma eq_iff_eq (x : K) (r : ℝ) :
  (∀ w : infinite_place K, w x = r) ↔ (∀ φ : K →+* ℂ, ‖φ x‖ = r) :=
⟨λ hw φ, hw (mk φ), λ hφ ⟨w, ⟨φ, rfl⟩⟩, hφ φ⟩

lemma le_iff_le (x : K) (r : ℝ) :
  (∀ w : infinite_place K, w x ≤ r) ↔ (∀ φ : K →+* ℂ, ‖φ x‖ ≤ r) :=
⟨λ hw φ, hw (mk φ), λ hφ ⟨w, ⟨φ, rfl⟩⟩, hφ φ⟩

lemma pos_iff {w : infinite_place K} {x : K} : 0 < w x ↔ x ≠ 0 := absolute_value.pos_iff w.1

@[simp]
lemma mk_conjugate_eq (φ : K →+* ℂ) :
  mk (complex_embedding.conjugate φ) = mk φ :=
begin
  ext x,
  exact congr_fun (congr_arg coe_fn (complex_embedding.place_conjugate φ)) x,
end

@[simp]
lemma mk_eq_iff {φ ψ : K →+* ℂ} :
  mk φ = mk ψ ↔ φ = ψ ∨ complex_embedding.conjugate φ = ψ :=
begin
  split,
  { -- We prove that the map ψ ∘ φ⁻¹ between φ(K) and ℂ is uniform continuous, thus it is either the
    -- inclusion or the complex conjugation using complex.uniform_continuous_ring_hom_eq_id_or_conj
    intro h₀,
    obtain ⟨j, hiφ⟩ := φ.injective.has_left_inverse,
    let ι := ring_equiv.of_left_inverse hiφ,
    have hlip : lipschitz_with 1 (ring_hom.comp ψ ι.symm.to_ring_hom),
    { change lipschitz_with 1 (ψ ∘ ι.symm),
      apply lipschitz_with.of_dist_le_mul,
      intros x y,
      rw [nonneg.coe_one, one_mul, normed_field.dist_eq, ← map_sub, ← map_sub],
      apply le_of_eq,
      suffices : ‖φ ((ι.symm) (x - y))‖ = ‖ψ ((ι.symm) (x - y))‖,
      { rw [← this, ← ring_equiv.of_left_inverse_apply hiφ _ , ring_equiv.apply_symm_apply ι _],
        refl, },
      exact congr_fun (congr_arg coe_fn h₀) _, },
    cases (complex.uniform_continuous_ring_hom_eq_id_or_conj φ.field_range hlip.uniform_continuous),
    { left, ext1 x,
      convert (congr_fun h (ι x)).symm,
      exact (ring_equiv.apply_symm_apply ι.symm x).symm, },
    { right, ext1 x,
      convert (congr_fun h (ι x)).symm,
      exact (ring_equiv.apply_symm_apply ι.symm x).symm, }},
  { rintros (⟨h⟩ | ⟨h⟩),
    { exact congr_arg mk h, },
    { rw ← mk_conjugate_eq,
      exact congr_arg mk h, }},
end

/-- An infinite place is real if it is defined by a real embedding. -/
def is_real (w : infinite_place K) : Prop :=
  ∃ φ : K →+* ℂ, complex_embedding.is_real φ ∧ mk φ = w

/-- An infinite place is complex if it is defined by a complex (ie. not real) embedding. -/
def is_complex (w : infinite_place K) : Prop :=
  ∃ φ : K →+* ℂ, ¬ complex_embedding.is_real φ ∧ mk φ = w

@[simp]
lemma _root_.number_field.complex_embeddings.is_real.embedding_mk {φ : K →+* ℂ}
  (h : complex_embedding.is_real φ) :
  embedding (mk φ) = φ :=
begin
  have := mk_eq_iff.mp (mk_embedding (mk φ)).symm,
  rwa [complex_embedding.is_real_iff.mp h, or_self, eq_comm] at this,
end

lemma is_real_iff {w : infinite_place K} :
  is_real w ↔ complex_embedding.is_real (embedding w) :=
begin
  split,
  { rintros ⟨φ, ⟨hφ, rfl⟩⟩,
    rwa _root_.number_field.complex_embeddings.is_real.embedding_mk hφ, },
  { exact λ h, ⟨embedding w, h, mk_embedding w⟩, },
end

lemma is_complex_iff {w : infinite_place K} :
  is_complex w ↔ ¬ complex_embedding.is_real (embedding w) :=
begin
  split,
  { rintros ⟨φ, ⟨hφ, rfl⟩⟩,
    contrapose! hφ,
    cases mk_eq_iff.mp (mk_embedding (mk φ)),
    { rwa ← h, },
    { rw ← complex_embedding.is_real_conjugate_iff at hφ,
      rwa ← h, }},
  { exact λ h, ⟨embedding w, h, mk_embedding w⟩, },
end

lemma not_is_real_iff_is_complex {w : infinite_place K} :
  ¬ is_real w ↔ is_complex w :=
by rw [is_complex_iff, is_real_iff]

/-- For `w` a real infinite place, return the corresponding embedding as a morphism `K →+* ℝ`. -/
noncomputable def is_real.embedding {w : infinite_place K} (hw : is_real w) : K →+* ℝ :=
(is_real_iff.mp hw).embedding

@[simp]
lemma is_real.place_embedding_apply {w : infinite_place K} (hw : is_real w) (x : K):
  place (is_real.embedding hw) x = w x :=
begin
  rw [is_real.embedding, complex_embedding.is_real.place_embedding, ← coe_mk],
  exact congr_fun (congr_arg coe_fn (mk_embedding w)) x,
end

variable (K)

/-- The map from real embeddings to real infinite places as an equiv -/
noncomputable def mk_real :
  {φ : K →+* ℂ // complex_embedding.is_real φ} ≃ {w : infinite_place K // is_real w} :=
{ to_fun := subtype.map mk (λ φ hφ, ⟨φ, hφ, rfl⟩),
  inv_fun :=  λ w, ⟨w.1.embedding, is_real_iff.1 w.2⟩,
  left_inv := λ φ, subtype.ext_iff.2 (number_field.complex_embeddings.is_real.embedding_mk φ.2),
  right_inv := λ w, subtype.ext_iff.2 (mk_embedding w.1), }

/-- The map from nonreal embeddings to complex infinite places -/
noncomputable def mk_complex :
  {φ : K →+* ℂ // ¬ complex_embedding.is_real φ} → {w : infinite_place K // is_complex w} :=
subtype.map mk (λ φ hφ, ⟨φ, hφ, rfl⟩)

lemma mk_complex_embedding (φ : {φ : K →+* ℂ // ¬ complex_embedding.is_real φ}) :
  ((mk_complex K φ) : infinite_place K).embedding = φ ∨
    ((mk_complex K φ) : infinite_place K).embedding = complex_embedding.conjugate φ :=
begin
  rw [@eq_comm _ _ ↑φ, @eq_comm _ _ (complex_embedding.conjugate ↑φ), ← mk_eq_iff, mk_embedding],
  refl,
end

@[simp]

@[simp]
lemma mk_complex_coe (φ : {φ : K →+* ℂ // ¬ complex_embedding.is_real φ}) :
  (mk_complex K φ : infinite_place K) = mk (φ : K →+* ℂ) := rfl

@[simp]
lemma mk_real.apply (φ : {φ : K →+* ℂ // complex_embedding.is_real φ}) (x : K) :
  mk_real K φ x = complex.abs (φ x) := apply φ x

@[simp]
lemma mk_complex.apply (φ : {φ : K →+* ℂ // ¬ complex_embedding.is_real φ}) (x : K) :
  mk_complex K φ x = complex.abs (φ x) := apply φ x

variable [number_field K]

lemma mk_complex.filter (w : { w : infinite_place K // w.is_complex }) :
  finset.univ.filter (λ φ, mk_complex K φ = w) =
    { ⟨w.1.embedding, is_complex_iff.1 w.2⟩,
      ⟨complex_embedding.conjugate w.1.embedding,
        complex_embedding.is_real_conjugate_iff.not.2 (is_complex_iff.1 w.2)⟩ } :=
begin
  ext φ,
  simp_rw [finset.mem_filter, subtype.val_eq_coe, finset.mem_insert, finset.mem_singleton,
    @subtype.ext_iff_val (infinite_place K), @subtype.ext_iff_val (K →+* ℂ), @eq_comm _ φ.val,
    ← mk_eq_iff, mk_embedding, @eq_comm _ _ w.val],
  simpa only [finset.mem_univ, true_and],
end

lemma mk_complex.filter_card (w : { w : infinite_place K // w.is_complex }) :
  (finset.univ.filter (λ φ, mk_complex K φ = w)).card = 2 :=
begin
  rw mk_complex.filter,
  exact finset.card_doubleton
    (subtype.mk_eq_mk.not.2 $ ne_comm.1 $
      complex_embedding.is_real_iff.not.1 $ is_complex_iff.1 w.2),
end

noncomputable instance number_field.infinite_place.fintype : fintype (infinite_place K) :=
set.fintype_range _

/-- The infinite part of the product formula : for `x ∈ K`, we have `Π_w ‖x‖_w = |norm(x)|` where
`‖·‖_w` is the normalized absolute value for `w`.  -/
lemma prod_eq_abs_norm (x : K) :
  finset.univ.prod (λ w : infinite_place K, ite (w.is_real) (w x) ((w x) ^ 2)) =
    abs (algebra.norm ℚ x) :=
begin
  convert (congr_arg complex.abs (@algebra.norm_eq_prod_embeddings ℚ _ _ _ _ ℂ _ _ _ _ _ x)).symm,
  { rw [map_prod, ← equiv.prod_comp' ring_hom.equiv_rat_alg_hom (λ f, complex.abs (f x))
      (λ φ, complex.abs (φ x)) (λ _, by simpa only [ring_hom.equiv_rat_alg_hom_apply])],
    dsimp only,
    conv { to_rhs, congr, skip, funext,
      rw ( by simp only [if_t_t] : complex.abs (f x) =
        ite (complex_embedding.is_real f) (complex.abs (f x)) (complex.abs (f x))) },
    rw [finset.prod_ite, finset.prod_ite],
    refine congr (congr_arg has_mul.mul _) _,
    { rw [← finset.prod_subtype_eq_prod_filter, ← finset.prod_subtype_eq_prod_filter],
      convert (equiv.prod_comp' (mk_real K) (λ φ, complex.abs (φ x)) (λ w, w x) _).symm,
      any_goals { ext, simp only [finset.mem_subtype, finset.mem_univ], },
      exact λ φ, mk_real.apply K φ x, },
    { rw [finset.filter_congr (λ (w : infinite_place K) _, @not_is_real_iff_is_complex K _ w),
        ← finset.prod_subtype_eq_prod_filter, ← finset.prod_subtype_eq_prod_filter],
      convert finset.prod_fiberwise finset.univ (λ φ, mk_complex K φ) (λ φ, complex.abs (φ x)),
      any_goals
      { ext, simp only [finset.mem_subtype, finset.mem_univ, not_is_real_iff_is_complex], },
      { ext w,
        rw [@finset.prod_congr _ _ _ _ _ (λ φ, w x) _ (eq.refl _)
          (λ φ hφ, (mk_complex.apply K φ x).symm.trans
          (congr_fun (congr_arg coe_fn (finset.mem_filter.1 hφ).2) x)), finset.prod_const,
          mk_complex.filter_card K w],
        refl, }}},
  { rw [eq_rat_cast, ← complex.abs_of_real, complex.of_real_rat_cast], },
end

open fintype

lemma card_real_embeddings :
  card {φ : K →+* ℂ // complex_embedding.is_real φ} = card {w : infinite_place K // is_real w} :=
by convert (fintype.of_equiv_card (mk_real K)).symm

lemma card_complex_embeddings :
  card {φ : K →+* ℂ // ¬ complex_embedding.is_real φ} =
    2 * card {w : infinite_place K // is_complex w} :=
begin
  rw [fintype.card, fintype.card, mul_comm, ← algebra.id.smul_eq_mul, ← finset.sum_const],
  conv { to_rhs, congr, skip, funext, rw ← mk_complex.filter_card K x },
  simp_rw finset.card_eq_sum_ones,
  exact (finset.sum_fiberwise finset.univ (λ φ, mk_complex K φ) (λ φ, 1)).symm
end

end number_field.infinite_place

end infinite_place


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov

! This file was ported from Lean 3 source module topology.metric_space.shrinking_lemma
! leanprover-community/mathlib commit f47581155c818e6361af4e4fda60d27d020c226b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.MetricSpace.Basic
import Mathbin.Topology.MetricSpace.EmetricParacompact
import Mathbin.Topology.ShrinkingLemma

/-!
# Shrinking lemma in a proper metric space

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

In this file we prove a few versions of the shrinking lemma for coverings by balls in a proper
(pseudo) metric space.

## Tags

shrinking lemma, metric space
-/

universe u v

open Set Metric

open Topology

variable {α : Type u} {ι : Type v} [MetricSpace α] [ProperSpace α] {c : ι → α}

variable {x : α} {r : ℝ} {s : Set α}

/- warning: exists_subset_Union_ball_radius_lt -> exists_subset_unionᵢ_ball_radius_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {s : Set.{u1} α} {r : ι -> Real}, (IsClosed.{u1} α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) s) -> (forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s) -> (Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))))) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i)))) (forall (i : ι), LT.lt.{0} Real Real.hasLt (r' i) (r i))))
but is expected to have type
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {s : Set.{u1} α} {r : ι -> Real}, (IsClosed.{u1} α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) s) -> (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s) -> (Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))))) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i)))) (forall (i : ι), LT.lt.{0} Real Real.instLTReal (r' i) (r i))))
Case conversion may be inaccurate. Consider using '#align exists_subset_Union_ball_radius_lt exists_subset_unionᵢ_ball_radius_ltₓ'. -/
/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a closed subset of a proper metric space by open balls can be shrunk to a new cover by open balls
so that each of the new balls has strictly smaller radius than the old one. This version assumes
that `λ x, ball (c i) (r i)` is a locally finite covering and provides a covering indexed by the
same type. -/
theorem exists_subset_unionᵢ_ball_radius_lt {r : ι → ℝ} (hs : IsClosed s)
    (uf : ∀ x ∈ s, { i | x ∈ ball (c i) (r i) }.Finite) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
    ∃ r' : ι → ℝ, (s ⊆ ⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i < r i :=
  by
  rcases exists_subset_unionᵢ_closed_subset hs (fun i => @is_open_ball _ _ (c i) (r i)) uf us with
    ⟨v, hsv, hvc, hcv⟩
  have := fun i => exists_lt_subset_ball (hvc i) (hcv i)
  choose r' hlt hsub
  exact ⟨r', hsv.trans <| Union_mono <| hsub, hlt⟩
#align exists_subset_Union_ball_radius_lt exists_subset_unionᵢ_ball_radius_lt

/- warning: exists_Union_ball_eq_radius_lt -> exists_unionᵢ_ball_eq_radius_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {r : ι -> Real}, (forall (x : α), Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))))) -> (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))) (Set.univ.{u1} α)) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (Set.univ.{u1} α)) (forall (i : ι), LT.lt.{0} Real Real.hasLt (r' i) (r i))))
but is expected to have type
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {r : ι -> Real}, (forall (x : α), Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))))) -> (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))) (Set.univ.{u1} α)) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (Set.univ.{u1} α)) (forall (i : ι), LT.lt.{0} Real Real.instLTReal (r' i) (r i))))
Case conversion may be inaccurate. Consider using '#align exists_Union_ball_eq_radius_lt exists_unionᵢ_ball_eq_radius_ltₓ'. -/
/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a proper metric space by open balls can be shrunk to a new cover by open balls so that each of
the new balls has strictly smaller radius than the old one. -/
theorem exists_unionᵢ_ball_eq_radius_lt {r : ι → ℝ} (uf : ∀ x, { i | x ∈ ball (c i) (r i) }.Finite)
    (uU : (⋃ i, ball (c i) (r i)) = univ) :
    ∃ r' : ι → ℝ, (⋃ i, ball (c i) (r' i)) = univ ∧ ∀ i, r' i < r i :=
  let ⟨r', hU, hv⟩ := exists_subset_unionᵢ_ball_radius_lt isClosed_univ (fun x _ => uf x) uU.ge
  ⟨r', univ_subset_iff.1 hU, hv⟩
#align exists_Union_ball_eq_radius_lt exists_unionᵢ_ball_eq_radius_lt

/- warning: exists_subset_Union_ball_radius_pos_lt -> exists_subset_unionᵢ_ball_radius_pos_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {s : Set.{u1} α} {r : ι -> Real}, (forall (i : ι), LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (r i)) -> (IsClosed.{u1} α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) s) -> (forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s) -> (Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))))) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i)))) (forall (i : ι), Membership.Mem.{0, 0} Real (Set.{0} Real) (Set.hasMem.{0} Real) (r' i) (Set.Ioo.{0} Real Real.preorder (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (r i)))))
but is expected to have type
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {s : Set.{u1} α} {r : ι -> Real}, (forall (i : ι), LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (r i)) -> (IsClosed.{u1} α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) s) -> (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s) -> (Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))))) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) s (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i)))) (forall (i : ι), Membership.mem.{0, 0} Real (Set.{0} Real) (Set.instMembershipSet.{0} Real) (r' i) (Set.Ioo.{0} Real Real.instPreorderReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (r i)))))
Case conversion may be inaccurate. Consider using '#align exists_subset_Union_ball_radius_pos_lt exists_subset_unionᵢ_ball_radius_pos_ltₓ'. -/
/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a closed subset of a proper metric space by nonempty open balls can be shrunk to a new cover by
nonempty open balls so that each of the new balls has strictly smaller radius than the old one. -/
theorem exists_subset_unionᵢ_ball_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i) (hs : IsClosed s)
    (uf : ∀ x ∈ s, { i | x ∈ ball (c i) (r i) }.Finite) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
    ∃ r' : ι → ℝ, (s ⊆ ⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i ∈ Ioo 0 (r i) :=
  by
  rcases exists_subset_unionᵢ_closed_subset hs (fun i => @is_open_ball _ _ (c i) (r i)) uf us with
    ⟨v, hsv, hvc, hcv⟩
  have := fun i => exists_pos_lt_subset_ball (hr i) (hvc i) (hcv i)
  choose r' hlt hsub
  exact ⟨r', hsv.trans <| Union_mono hsub, hlt⟩
#align exists_subset_Union_ball_radius_pos_lt exists_subset_unionᵢ_ball_radius_pos_lt

/- warning: exists_Union_ball_eq_radius_pos_lt -> exists_unionᵢ_ball_eq_radius_pos_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {r : ι -> Real}, (forall (i : ι), LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (r i)) -> (forall (x : α), Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))))) -> (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))) (Set.univ.{u1} α)) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (Set.univ.{u1} α)) (forall (i : ι), Membership.Mem.{0, 0} Real (Set.{0} Real) (Set.hasMem.{0} Real) (r' i) (Set.Ioo.{0} Real Real.preorder (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (r i)))))
but is expected to have type
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {c : ι -> α} {r : ι -> Real}, (forall (i : ι), LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (r i)) -> (forall (x : α), Set.Finite.{u2} ι (setOf.{u2} ι (fun (i : ι) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x (Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))))) -> (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))) (Set.univ.{u1} α)) -> (Exists.{succ u2} (ι -> Real) (fun (r' : ι -> Real) => And (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u2} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (Set.univ.{u1} α)) (forall (i : ι), Membership.mem.{0, 0} Real (Set.{0} Real) (Set.instMembershipSet.{0} Real) (r' i) (Set.Ioo.{0} Real Real.instPreorderReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (r i)))))
Case conversion may be inaccurate. Consider using '#align exists_Union_ball_eq_radius_pos_lt exists_unionᵢ_ball_eq_radius_pos_ltₓ'. -/
/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a proper metric space by nonempty open balls can be shrunk to a new cover by nonempty open balls
so that each of the new balls has strictly smaller radius than the old one. -/
theorem exists_unionᵢ_ball_eq_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i)
    (uf : ∀ x, { i | x ∈ ball (c i) (r i) }.Finite) (uU : (⋃ i, ball (c i) (r i)) = univ) :
    ∃ r' : ι → ℝ, (⋃ i, ball (c i) (r' i)) = univ ∧ ∀ i, r' i ∈ Ioo 0 (r i) :=
  let ⟨r', hU, hv⟩ :=
    exists_subset_unionᵢ_ball_radius_pos_lt hr isClosed_univ (fun x _ => uf x) uU.ge
  ⟨r', univ_subset_iff.1 hU, hv⟩
#align exists_Union_ball_eq_radius_pos_lt exists_unionᵢ_ball_eq_radius_pos_lt

/- warning: exists_locally_finite_subset_Union_ball_radius_lt -> exists_locallyFinite_subset_unionᵢ_ball_radius_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {s : Set.{u1} α}, (IsClosed.{u1} α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) s) -> (forall {R : α -> Real}, (forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s) -> (LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (R x))) -> (Exists.{succ (succ u1)} Type.{u1} (fun (ι : Type.{u1}) => Exists.{succ u1} (ι -> α) (fun (c : ι -> α) => Exists.{succ u1} (ι -> Real) (fun (r : ι -> Real) => Exists.{succ u1} (ι -> Real) (fun (r' : ι -> Real) => And (forall (i : ι), And (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (c i) s) (And (LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (r i)) (And (LT.lt.{0} Real Real.hasLt (r i) (r' i)) (LT.lt.{0} Real Real.hasLt (r' i) (R (c i)))))) (And (LocallyFinite.{u1, u1} ι α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) s (Set.unionᵢ.{u1, succ u1} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {s : Set.{u1} α}, (IsClosed.{u1} α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) s) -> (forall {R : α -> Real}, (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s) -> (LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (R x))) -> (Exists.{succ (succ u1)} Type.{u1} (fun (ι : Type.{u1}) => Exists.{succ u1} (ι -> α) (fun (c : ι -> α) => Exists.{succ u1} (ι -> Real) (fun (r : ι -> Real) => Exists.{succ u1} (ι -> Real) (fun (r' : ι -> Real) => And (forall (i : ι), And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (c i) s) (And (LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (r i)) (And (LT.lt.{0} Real Real.instLTReal (r i) (r' i)) (LT.lt.{0} Real Real.instLTReal (r' i) (R (c i)))))) (And (LocallyFinite.{u1, u1} ι α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) s (Set.unionᵢ.{u1, succ u1} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i)))))))))))
Case conversion may be inaccurate. Consider using '#align exists_locally_finite_subset_Union_ball_radius_lt exists_locallyFinite_subset_unionᵢ_ball_radius_ltₓ'. -/
/-- Let `R : α → ℝ` be a (possibly discontinuous) function on a proper metric space.
Let `s` be a closed set in `α` such that `R` is positive on `s`. Then there exists a collection of
pairs of balls `metric.ball (c i) (r i)`, `metric.ball (c i) (r' i)` such that

* all centers belong to `s`;
* for all `i` we have `0 < r i < r' i < R (c i)`;
* the family of balls `metric.ball (c i) (r' i)` is locally finite;
* the balls `metric.ball (c i) (r i)` cover `s`.

This is a simple corollary of `refinement_of_locally_compact_sigma_compact_of_nhds_basis_set`
and `exists_subset_Union_ball_radius_pos_lt`. -/
theorem exists_locallyFinite_subset_unionᵢ_ball_radius_lt (hs : IsClosed s) {R : α → ℝ}
    (hR : ∀ x ∈ s, 0 < R x) :
    ∃ (ι : Type u)(c : ι → α)(r r' : ι → ℝ),
      (∀ i, c i ∈ s ∧ 0 < r i ∧ r i < r' i ∧ r' i < R (c i)) ∧
        (LocallyFinite fun i => ball (c i) (r' i)) ∧ s ⊆ ⋃ i, ball (c i) (r i) :=
  by
  have : ∀ x ∈ s, (𝓝 x).HasBasis (fun r : ℝ => 0 < r ∧ r < R x) fun r => ball x r := fun x hx =>
    nhds_basis_uniformity (uniformity_basis_dist_lt (hR x hx))
  rcases refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set hs this with
    ⟨ι, c, r', hr', hsub', hfin⟩
  rcases exists_subset_unionᵢ_ball_radius_pos_lt (fun i => (hr' i).2.1) hs
      (fun x hx => hfin.point_finite x) hsub' with
    ⟨r, hsub, hlt⟩
  exact ⟨ι, c, r, r', fun i => ⟨(hr' i).1, (hlt i).1, (hlt i).2, (hr' i).2.2⟩, hfin, hsub⟩
#align exists_locally_finite_subset_Union_ball_radius_lt exists_locallyFinite_subset_unionᵢ_ball_radius_lt

/- warning: exists_locally_finite_Union_eq_ball_radius_lt -> exists_locallyFinite_unionᵢ_eq_ball_radius_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {R : α -> Real}, (forall (x : α), LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (R x)) -> (Exists.{succ (succ u1)} Type.{u1} (fun (ι : Type.{u1}) => Exists.{succ u1} (ι -> α) (fun (c : ι -> α) => Exists.{succ u1} (ι -> Real) (fun (r : ι -> Real) => Exists.{succ u1} (ι -> Real) (fun (r' : ι -> Real) => And (forall (i : ι), And (LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) (r i)) (And (LT.lt.{0} Real Real.hasLt (r i) (r' i)) (LT.lt.{0} Real Real.hasLt (r' i) (R (c i))))) (And (LocallyFinite.{u1, u1} ι α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u1} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))) (Set.univ.{u1} α))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : MetricSpace.{u1} α] [_inst_2 : ProperSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1)] {R : α -> Real}, (forall (x : α), LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (R x)) -> (Exists.{succ (succ u1)} Type.{u1} (fun (ι : Type.{u1}) => Exists.{succ u1} (ι -> α) (fun (c : ι -> α) => Exists.{succ u1} (ι -> Real) (fun (r : ι -> Real) => Exists.{succ u1} (ι -> Real) (fun (r' : ι -> Real) => And (forall (i : ι), And (LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) (r i)) (And (LT.lt.{0} Real Real.instLTReal (r i) (r' i)) (LT.lt.{0} Real Real.instLTReal (r' i) (R (c i))))) (And (LocallyFinite.{u1, u1} ι α (UniformSpace.toTopologicalSpace.{u1} α (PseudoMetricSpace.toUniformSpace.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1))) (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r' i))) (Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, succ u1} α ι (fun (i : ι) => Metric.ball.{u1} α (MetricSpace.toPseudoMetricSpace.{u1} α _inst_1) (c i) (r i))) (Set.univ.{u1} α))))))))
Case conversion may be inaccurate. Consider using '#align exists_locally_finite_Union_eq_ball_radius_lt exists_locallyFinite_unionᵢ_eq_ball_radius_ltₓ'. -/
/-- Let `R : α → ℝ` be a (possibly discontinuous) positive function on a proper metric space. Then
there exists a collection of pairs of balls `metric.ball (c i) (r i)`, `metric.ball (c i) (r' i)`
such that

* for all `i` we have `0 < r i < r' i < R (c i)`;
* the family of balls `metric.ball (c i) (r' i)` is locally finite;
* the balls `metric.ball (c i) (r i)` cover the whole space.

This is a simple corollary of `refinement_of_locally_compact_sigma_compact_of_nhds_basis`
and `exists_Union_ball_eq_radius_pos_lt` or `exists_locally_finite_subset_Union_ball_radius_lt`. -/
theorem exists_locallyFinite_unionᵢ_eq_ball_radius_lt {R : α → ℝ} (hR : ∀ x, 0 < R x) :
    ∃ (ι : Type u)(c : ι → α)(r r' : ι → ℝ),
      (∀ i, 0 < r i ∧ r i < r' i ∧ r' i < R (c i)) ∧
        (LocallyFinite fun i => ball (c i) (r' i)) ∧ (⋃ i, ball (c i) (r i)) = univ :=
  let ⟨ι, c, r, r', hlt, hfin, hsub⟩ :=
    exists_locallyFinite_subset_unionᵢ_ball_radius_lt isClosed_univ fun x _ => hR x
  ⟨ι, c, r, r', fun i => (hlt i).2, hfin, univ_subset_iff.1 hsub⟩
#align exists_locally_finite_Union_eq_ball_radius_lt exists_locallyFinite_unionᵢ_eq_ball_radius_lt


/-
Copyright (c) 2022 Yaël Dillies, Sara Rousta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Sara Rousta
-/
import data.set_like.basic
import data.set.intervals.ord_connected
import data.set.intervals.order_iso

/-!
# Up-sets and down-sets

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

This file defines upper and lower sets in an order.

## Main declarations

* `is_upper_set`: Predicate for a set to be an upper set. This means every element greater than a
  member of the set is in the set itself.
* `is_lower_set`: Predicate for a set to be a lower set. This means every element less than a member
  of the set is in the set itself.
* `upper_set`: The type of upper sets.
* `lower_set`: The type of lower sets.
* `upper_closure`: The greatest upper set containing a set.
* `lower_closure`: The least lower set containing a set.
* `upper_set.Ici`: Principal upper set. `set.Ici` as an upper set.
* `upper_set.Ioi`: Strict principal upper set. `set.Ioi` as an upper set.
* `lower_set.Iic`: Principal lower set. `set.Iic` as an lower set.
* `lower_set.Iio`: Strict principal lower set. `set.Iio` as an lower set.

## Notation

`×ˢ` is notation for `upper_set.prod`/`lower_set.prod`.

## Notes

Upper sets are ordered by **reverse** inclusion. This convention is motivated by the fact that this
makes them order-isomorphic to lower sets and antichains, and matches the convention on `filter`.

## TODO

Lattice structure on antichains. Order equivalence between upper/lower sets and antichains.
-/

open order_dual set

variables {α β γ : Type*} {ι : Sort*} {κ : ι → Sort*}

/-! ### Unbundled upper/lower sets -/

section has_le
variables [has_le α] [has_le β] {s t : set α}

/-- An upper set in an order `α` is a set such that any element greater than one of its members is
also a member. Also called up-set, upward-closed set. -/
def is_upper_set (s : set α) : Prop := ∀ ⦃a b : α⦄, a ≤ b → a ∈ s → b ∈ s

/-- A lower set in an order `α` is a set such that any element less than one of its members is also
a member. Also called down-set, downward-closed set. -/
def is_lower_set (s : set α) : Prop := ∀ ⦃a b : α⦄, b ≤ a → a ∈ s → b ∈ s

lemma is_upper_set_empty : is_upper_set (∅ : set α) := λ _ _ _, id
lemma is_lower_set_empty : is_lower_set (∅ : set α) := λ _ _ _, id
lemma is_upper_set_univ : is_upper_set (univ : set α) := λ _ _ _, id
lemma is_lower_set_univ : is_lower_set (univ : set α) := λ _ _ _, id
lemma is_upper_set.compl (hs : is_upper_set s) : is_lower_set sᶜ := λ a b h hb ha, hb $ hs h ha
lemma is_lower_set.compl (hs : is_lower_set s) : is_upper_set sᶜ := λ a b h hb ha, hb $ hs h ha

@[simp] lemma is_upper_set_compl : is_upper_set sᶜ ↔ is_lower_set s :=
⟨λ h, by { convert h.compl, rw compl_compl }, is_lower_set.compl⟩

@[simp] lemma is_lower_set_compl : is_lower_set sᶜ ↔ is_upper_set s :=
⟨λ h, by { convert h.compl, rw compl_compl }, is_upper_set.compl⟩

lemma is_upper_set.union (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∪ t) :=
λ a b h, or.imp (hs h) (ht h)

lemma is_lower_set.union (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∪ t) :=
λ a b h, or.imp (hs h) (ht h)

lemma is_upper_set.inter (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∩ t) :=
λ a b h, and.imp (hs h) (ht h)

lemma is_lower_set.inter (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∩ t) :=
λ a b h, and.imp (hs h) (ht h)

lemma is_upper_set_Union {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋃ i, f i) :=
λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_lower_set_Union {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋃ i, f i) :=
λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_upper_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
  is_upper_set (⋃ i j, f i j) :=
is_upper_set_Union $ λ i, is_upper_set_Union $ hf i

lemma is_lower_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
  is_lower_set (⋃ i j, f i j) :=
is_lower_set_Union $ λ i, is_lower_set_Union $ hf i

lemma is_upper_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋃₀ S) :=
λ a b h, Exists₂.imp $ λ s hs, hf s hs h

lemma is_lower_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋃₀ S) :=
λ a b h, Exists₂.imp $ λ s hs, hf s hs h

lemma is_upper_set_Inter {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋂ i, f i) :=
λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_lower_set_Inter {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋂ i, f i) :=
λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_upper_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
  is_upper_set (⋂ i j, f i j) :=
is_upper_set_Inter $ λ i, is_upper_set_Inter $ hf i

lemma is_lower_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
  is_lower_set (⋂ i j, f i j) :=
is_lower_set_Inter $ λ i, is_lower_set_Inter $ hf i

lemma is_upper_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋂₀ S) :=
λ a b h, forall₂_imp $ λ s hs, hf s hs h

lemma is_lower_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋂₀ S) :=
λ a b h, forall₂_imp $ λ s hs, hf s hs h

@[simp] lemma is_lower_set_preimage_of_dual_iff : is_lower_set (of_dual ⁻¹' s) ↔ is_upper_set s :=
iff.rfl
@[simp] lemma is_upper_set_preimage_of_dual_iff : is_upper_set (of_dual ⁻¹' s) ↔ is_lower_set s :=
iff.rfl
@[simp] lemma is_lower_set_preimage_to_dual_iff {s : set αᵒᵈ} :
  is_lower_set (to_dual ⁻¹' s) ↔ is_upper_set s := iff.rfl
@[simp] lemma is_upper_set_preimage_to_dual_iff {s : set αᵒᵈ} :
  is_upper_set (to_dual ⁻¹' s) ↔ is_lower_set s := iff.rfl

alias is_lower_set_preimage_of_dual_iff ↔ _ is_upper_set.of_dual
alias is_upper_set_preimage_of_dual_iff ↔ _ is_lower_set.of_dual
alias is_lower_set_preimage_to_dual_iff ↔ _ is_upper_set.to_dual
alias is_upper_set_preimage_to_dual_iff ↔ _ is_lower_set.to_dual

end has_le

section preorder
variables [preorder α] [preorder β] {s : set α} {p : α → Prop} (a : α)

lemma is_upper_set_Ici : is_upper_set (Ici a) := λ _ _, ge_trans
lemma is_lower_set_Iic : is_lower_set (Iic a) := λ _ _, le_trans
lemma is_upper_set_Ioi : is_upper_set (Ioi a) := λ _ _, flip lt_of_lt_of_le
lemma is_lower_set_Iio : is_lower_set (Iio a) := λ _ _, lt_of_le_of_lt

lemma is_upper_set_iff_Ici_subset : is_upper_set s ↔ ∀ ⦃a⦄, a ∈ s → Ici a ⊆ s :=
by simp [is_upper_set, subset_def, @forall_swap (_ ∈ s)]

lemma is_lower_set_iff_Iic_subset : is_lower_set s ↔ ∀ ⦃a⦄, a ∈ s → Iic a ⊆ s :=
by simp [is_lower_set, subset_def, @forall_swap (_ ∈ s)]

alias is_upper_set_iff_Ici_subset ↔ is_upper_set.Ici_subset _
alias is_lower_set_iff_Iic_subset ↔ is_lower_set.Iic_subset _

lemma is_upper_set.ord_connected (h : is_upper_set s) : s.ord_connected :=
⟨λ a ha b _, Icc_subset_Ici_self.trans $ h.Ici_subset ha⟩

lemma is_lower_set.ord_connected (h : is_lower_set s) : s.ord_connected :=
⟨λ a _ b hb, Icc_subset_Iic_self.trans $ h.Iic_subset hb⟩

lemma is_upper_set.preimage (hs : is_upper_set s) {f : β → α} (hf : monotone f) :
  is_upper_set (f ⁻¹' s : set β) :=
λ x y hxy, hs $ hf hxy

lemma is_lower_set.preimage (hs : is_lower_set s) {f : β → α} (hf : monotone f) :
  is_lower_set (f ⁻¹' s : set β) :=
λ x y hxy, hs $ hf hxy

lemma is_upper_set.image (hs : is_upper_set s) (f : α ≃o β) : is_upper_set (f '' s : set β) :=
by { change is_upper_set ((f : α ≃ β) '' s), rw set.image_equiv_eq_preimage_symm,
  exact hs.preimage f.symm.monotone }

lemma is_lower_set.image (hs : is_lower_set s) (f : α ≃o β) : is_lower_set (f '' s : set β) :=
by { change is_lower_set ((f : α ≃ β) '' s), rw set.image_equiv_eq_preimage_symm,
  exact hs.preimage f.symm.monotone }

@[simp] lemma set.monotone_mem : monotone (∈ s) ↔ is_upper_set s := iff.rfl
@[simp] lemma set.antitone_mem : antitone (∈ s) ↔ is_lower_set s := forall_swap

@[simp] lemma is_upper_set_set_of : is_upper_set {a | p a} ↔ monotone p := iff.rfl
@[simp] lemma is_lower_set_set_of : is_lower_set {a | p a} ↔ antitone p := forall_swap

section order_top
variables [order_top α]

lemma is_lower_set.top_mem (hs : is_lower_set s) : ⊤ ∈ s ↔ s = univ :=
⟨λ h, eq_univ_of_forall $ λ a, hs le_top h, λ h, h.symm ▸ mem_univ _⟩

lemma is_upper_set.top_mem (hs : is_upper_set s) : ⊤ ∈ s ↔ s.nonempty :=
⟨λ h, ⟨_, h⟩, λ ⟨a, ha⟩, hs le_top ha⟩

lemma is_upper_set.not_top_mem (hs : is_upper_set s) : ⊤ ∉ s ↔ s = ∅ :=
hs.top_mem.not.trans not_nonempty_iff_eq_empty

end order_top

section order_bot
variables [order_bot α]

lemma is_upper_set.bot_mem (hs : is_upper_set s) : ⊥ ∈ s ↔ s = univ :=
⟨λ h, eq_univ_of_forall $ λ a, hs bot_le h, λ h, h.symm ▸ mem_univ _⟩

lemma is_lower_set.bot_mem (hs : is_lower_set s) : ⊥ ∈ s ↔ s.nonempty :=
⟨λ h, ⟨_, h⟩, λ ⟨a, ha⟩, hs bot_le ha⟩

lemma is_lower_set.not_bot_mem (hs : is_lower_set s) : ⊥ ∉ s ↔ s = ∅ :=
hs.bot_mem.not.trans not_nonempty_iff_eq_empty

end order_bot

section no_max_order
variables [no_max_order α] (a)

lemma is_upper_set.not_bdd_above (hs : is_upper_set s) : s.nonempty → ¬ bdd_above s :=
begin
  rintro ⟨a, ha⟩ ⟨b, hb⟩,
  obtain ⟨c, hc⟩ := exists_gt b,
  exact hc.not_le (hb $ hs ((hb ha).trans hc.le) ha),
end

lemma not_bdd_above_Ici : ¬ bdd_above (Ici a) := (is_upper_set_Ici _).not_bdd_above nonempty_Ici
lemma not_bdd_above_Ioi : ¬ bdd_above (Ioi a) := (is_upper_set_Ioi _).not_bdd_above nonempty_Ioi

end no_max_order

section no_min_order
variables [no_min_order α] (a)

lemma is_lower_set.not_bdd_below (hs : is_lower_set s) : s.nonempty → ¬ bdd_below s :=
begin
  rintro ⟨a, ha⟩ ⟨b, hb⟩,
  obtain ⟨c, hc⟩ := exists_lt b,
  exact hc.not_le (hb $ hs (hc.le.trans $ hb ha) ha),
end

lemma not_bdd_below_Iic : ¬ bdd_below (Iic a) := (is_lower_set_Iic _).not_bdd_below nonempty_Iic
lemma not_bdd_below_Iio : ¬ bdd_below (Iio a) := (is_lower_set_Iio _).not_bdd_below nonempty_Iio

end no_min_order
end preorder

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

lemma is_upper_set_iff_forall_lt : is_upper_set s ↔ ∀ ⦃a b : α⦄, a < b → a ∈ s → b ∈ s :=
forall_congr $ λ a, by simp [le_iff_eq_or_lt, or_imp_distrib, forall_and_distrib]

lemma is_lower_set_iff_forall_lt : is_lower_set s ↔ ∀ ⦃a b : α⦄, b < a → a ∈ s → b ∈ s :=
forall_congr $ λ a, by simp [le_iff_eq_or_lt, or_imp_distrib, forall_and_distrib]

lemma is_upper_set_iff_Ioi_subset : is_upper_set s ↔ ∀ ⦃a⦄, a ∈ s → Ioi a ⊆ s :=
by simp [is_upper_set_iff_forall_lt, subset_def, @forall_swap (_ ∈ s)]

lemma is_lower_set_iff_Iio_subset : is_lower_set s ↔ ∀ ⦃a⦄, a ∈ s → Iio a ⊆ s :=
by simp [is_lower_set_iff_forall_lt, subset_def, @forall_swap (_ ∈ s)]

alias is_upper_set_iff_Ioi_subset ↔ is_upper_set.Ioi_subset _
alias is_lower_set_iff_Iio_subset ↔ is_lower_set.Iio_subset _

end partial_order

/-! ### Bundled upper/lower sets -/

section has_le
variables [has_le α]

/-- The type of upper sets of an order. -/
structure upper_set (α : Type*) [has_le α] :=
(carrier : set α)
(upper' : is_upper_set carrier)

/-- The type of lower sets of an order. -/
structure lower_set (α : Type*) [has_le α] :=
(carrier : set α)
(lower' : is_lower_set carrier)

namespace upper_set

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

@[ext] lemma ext {s t : upper_set α} : (s : set α) = t → s = t := set_like.ext'

@[simp] lemma carrier_eq_coe (s : upper_set α) : s.carrier = s := rfl

protected lemma upper (s : upper_set α) : is_upper_set (s : set α) := s.upper'

@[simp] lemma mem_mk (carrier : set α) (upper') {a : α} : a ∈ mk carrier upper' ↔ a ∈ carrier :=
iff.rfl

end upper_set

namespace lower_set

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

@[ext] lemma ext {s t : lower_set α} : (s : set α) = t → s = t := set_like.ext'

@[simp] lemma carrier_eq_coe (s : lower_set α) : s.carrier = s := rfl

protected lemma lower (s : lower_set α) : is_lower_set (s : set α) := s.lower'

@[simp] lemma mem_mk (carrier : set α) (lower') {a : α} : a ∈ mk carrier lower' ↔ a ∈ carrier :=
iff.rfl

end lower_set

/-! #### Order -/

namespace upper_set
variables {S : set (upper_set α)} {s t : upper_set α} {a : α}

instance : has_sup (upper_set α) := ⟨λ s t, ⟨s ∩ t, s.upper.inter t.upper⟩⟩
instance : has_inf (upper_set α) := ⟨λ s t, ⟨s ∪ t, s.upper.union t.upper⟩⟩
instance : has_top (upper_set α) := ⟨⟨∅, is_upper_set_empty⟩⟩
instance : has_bot (upper_set α) := ⟨⟨univ, is_upper_set_univ⟩⟩
instance : has_Sup (upper_set α) :=
⟨λ S, ⟨⋂ s ∈ S, ↑s, is_upper_set_Inter₂ $ λ s _, s.upper⟩⟩
instance : has_Inf (upper_set α) :=
⟨λ S, ⟨⋃ s ∈ S, ↑s, is_upper_set_Union₂ $ λ s _, s.upper⟩⟩

instance : complete_distrib_lattice (upper_set α) :=
(to_dual.injective.comp $ set_like.coe_injective).complete_distrib_lattice _
  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl

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

@[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ t ≤ s := iff.rfl
@[simp, norm_cast] lemma coe_top : ((⊤ : upper_set α) : set α) = ∅ := rfl
@[simp, norm_cast] lemma coe_bot : ((⊥ : upper_set α) : set α) = univ := rfl
@[simp, norm_cast] lemma coe_eq_univ : (s : set α) = univ ↔ s = ⊥ := by simp [set_like.ext'_iff]
@[simp, norm_cast] lemma coe_eq_empty : (s : set α) = ∅ ↔ s = ⊤ := by simp [set_like.ext'_iff]
@[simp, norm_cast] lemma coe_sup (s t : upper_set α) : (↑(s ⊔ t) : set α) = s ∩ t := rfl
@[simp, norm_cast] lemma coe_inf (s t : upper_set α) : (↑(s ⊓ t) : set α) = s ∪ t := rfl
@[simp, norm_cast] lemma coe_Sup (S : set (upper_set α)) : (↑(Sup S) : set α) = ⋂ s ∈ S, ↑s := rfl
@[simp, norm_cast] lemma coe_Inf (S : set (upper_set α)) : (↑(Inf S) : set α) = ⋃ s ∈ S, ↑s := rfl
@[simp, norm_cast] lemma coe_supr (f : ι → upper_set α) : (↑(⨆ i, f i) : set α) = ⋂ i, f i :=
by simp [supr]
@[simp, norm_cast] lemma coe_infi (f : ι → upper_set α) : (↑(⨅ i, f i) : set α) = ⋃ i, f i :=
by simp [infi]
@[simp, norm_cast] lemma coe_supr₂ (f : Π i, κ i → upper_set α) :
  (↑(⨆ i j, f i j) : set α) = ⋂ i j, f i j := by simp_rw coe_supr
@[simp, norm_cast] lemma coe_infi₂ (f : Π i, κ i → upper_set α) :
  (↑(⨅ i j, f i j) : set α) = ⋃ i j, f i j := by simp_rw coe_infi

@[simp] lemma not_mem_top : a ∉ (⊤ : upper_set α) := id
@[simp] lemma mem_bot : a ∈ (⊥ : upper_set α) := trivial
@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
@[simp] lemma mem_supr_iff {f : ι → upper_set α} : a ∈ (⨆ i, f i) ↔ ∀ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_supr], exact mem_Inter }
@[simp] lemma mem_infi_iff {f : ι → upper_set α} : a ∈ (⨅ i, f i) ↔ ∃ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_infi], exact mem_Union }
@[simp] lemma mem_supr₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨆ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
by simp_rw mem_supr_iff
@[simp] lemma mem_infi₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨅ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
by simp_rw mem_infi_iff

@[simp, norm_cast] lemma codisjoint_coe : codisjoint (s : set α) t ↔ disjoint s t :=
by simp [disjoint_iff, codisjoint_iff, set_like.ext'_iff]

end upper_set

namespace lower_set
variables {S : set (lower_set α)} {s t : lower_set α} {a : α}

instance : has_sup (lower_set α) := ⟨λ s t, ⟨s ∪ t, λ a b h, or.imp (s.lower h) (t.lower h)⟩⟩
instance : has_inf (lower_set α) := ⟨λ s t, ⟨s ∩ t, λ a b h, and.imp (s.lower h) (t.lower h)⟩⟩
instance : has_top (lower_set α) := ⟨⟨univ, λ a b h, id⟩⟩
instance : has_bot (lower_set α) := ⟨⟨∅, λ a b h, id⟩⟩
instance : has_Sup (lower_set α) := ⟨λ S, ⟨⋃ s ∈ S, ↑s, is_lower_set_Union₂ $ λ s _, s.lower⟩⟩
instance : has_Inf (lower_set α) := ⟨λ S, ⟨⋂ s ∈ S, ↑s, is_lower_set_Inter₂ $ λ s _, s.lower⟩⟩

instance : complete_distrib_lattice (lower_set α) :=
set_like.coe_injective.complete_distrib_lattice _
  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl

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

@[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ s ≤ t := iff.rfl
@[simp, norm_cast] lemma coe_top : ((⊤ : lower_set α) : set α) = univ := rfl
@[simp, norm_cast] lemma coe_bot : ((⊥ : lower_set α) : set α) = ∅ := rfl
@[simp, norm_cast] lemma coe_eq_univ : (s : set α) = univ ↔ s = ⊤ := by simp [set_like.ext'_iff]
@[simp, norm_cast] lemma coe_eq_empty : (s : set α) = ∅ ↔ s = ⊥ := by simp [set_like.ext'_iff]
@[simp, norm_cast] lemma coe_sup (s t : lower_set α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
@[simp, norm_cast] lemma coe_inf (s t : lower_set α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
@[simp, norm_cast] lemma coe_Sup (S : set (lower_set α)) : (↑(Sup S) : set α) = ⋃ s ∈ S, ↑s := rfl
@[simp, norm_cast] lemma coe_Inf (S : set (lower_set α)) : (↑(Inf S) : set α) = ⋂ s ∈ S, ↑s := rfl
@[simp, norm_cast] lemma coe_supr (f : ι → lower_set α) : (↑(⨆ i, f i) : set α) = ⋃ i, f i :=
by simp_rw [supr, coe_Sup, mem_range, Union_exists, Union_Union_eq']
@[simp, norm_cast] lemma coe_infi (f : ι → lower_set α) : (↑(⨅ i, f i) : set α) = ⋂ i, f i :=
by simp_rw [infi, coe_Inf, mem_range, Inter_exists, Inter_Inter_eq']
@[simp, norm_cast] lemma coe_supr₂ (f : Π i, κ i → lower_set α) :
  (↑(⨆ i j, f i j) : set α) = ⋃ i j, f i j := by simp_rw coe_supr
@[simp, norm_cast] lemma coe_infi₂ (f : Π i, κ i → lower_set α) :
  (↑(⨅ i j, f i j) : set α) = ⋂ i j, f i j := by simp_rw coe_infi

@[simp] lemma mem_top : a ∈ (⊤ : lower_set α) := trivial
@[simp] lemma not_mem_bot : a ∉ (⊥ : lower_set α) := id
@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
@[simp] lemma mem_supr_iff {f : ι → lower_set α} : a ∈ (⨆ i, f i) ↔ ∃ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_supr], exact mem_Union }
@[simp] lemma mem_infi_iff {f : ι → lower_set α} : a ∈ (⨅ i, f i) ↔ ∀ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_infi], exact mem_Inter }
@[simp] lemma mem_supr₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨆ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
by simp_rw mem_supr_iff
@[simp] lemma mem_infi₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨅ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
by simp_rw mem_infi_iff

@[simp, norm_cast]

end lower_set

/-! #### Complement -/

/-- The complement of a lower set as an upper set. -/
def upper_set.compl (s : upper_set α) : lower_set α := ⟨sᶜ, s.upper.compl⟩

/-- The complement of a lower set as an upper set. -/
def lower_set.compl (s : lower_set α) : upper_set α := ⟨sᶜ, s.lower.compl⟩

namespace upper_set
variables {s t : upper_set α} {a : α}

@[simp] lemma coe_compl (s : upper_set α) : (s.compl : set α) = sᶜ := rfl
@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
@[simp] lemma compl_compl (s : upper_set α) : s.compl.compl = s := upper_set.ext $ compl_compl _
@[simp] lemma compl_le_compl : s.compl ≤ t.compl ↔ s ≤ t := compl_subset_compl

@[simp] protected lemma compl_sup (s t : upper_set α) : (s ⊔ t).compl = s.compl ⊔ t.compl :=
lower_set.ext compl_inf
@[simp] protected lemma compl_inf (s t : upper_set α) : (s ⊓ t).compl = s.compl ⊓ t.compl :=
lower_set.ext compl_sup
@[simp] protected lemma compl_top : (⊤ : upper_set α).compl = ⊤ := lower_set.ext compl_empty
@[simp] protected lemma compl_bot : (⊥ : upper_set α).compl = ⊥  := lower_set.ext compl_univ
@[simp] protected lemma compl_Sup (S : set (upper_set α)) :
  (Sup S).compl = ⨆ s ∈ S, upper_set.compl s :=
lower_set.ext $ by simp only [coe_compl, coe_Sup, compl_Inter₂, lower_set.coe_supr₂]

@[simp] protected lemma compl_Inf (S : set (upper_set α)) :
  (Inf S).compl = ⨅ s ∈ S, upper_set.compl s :=
lower_set.ext $ by simp only [coe_compl, coe_Inf, compl_Union₂, lower_set.coe_infi₂]

@[simp] protected lemma compl_supr (f : ι → upper_set α) : (⨆ i, f i).compl = ⨆ i, (f i).compl :=
lower_set.ext $ by simp only [coe_compl, coe_supr, compl_Inter, lower_set.coe_supr]

@[simp] protected lemma compl_infi (f : ι → upper_set α) : (⨅ i, f i).compl = ⨅ i, (f i).compl :=
lower_set.ext $ by simp only [coe_compl, coe_infi, compl_Union, lower_set.coe_infi]

@[simp] lemma compl_supr₂ (f : Π i, κ i → upper_set α) :
  (⨆ i j, f i j).compl = ⨆ i j, (f i j).compl :=
by simp_rw upper_set.compl_supr

@[simp] lemma compl_infi₂ (f : Π i, κ i → upper_set α) :
  (⨅ i j, f i j).compl = ⨅ i j, (f i j).compl :=
by simp_rw upper_set.compl_infi

end upper_set

namespace lower_set
variables {s t : lower_set α} {a : α}

@[simp] lemma coe_compl (s : lower_set α) : (s.compl : set α) = sᶜ := rfl
@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
@[simp] lemma compl_compl (s : lower_set α) : s.compl.compl = s := lower_set.ext $ compl_compl _
@[simp] lemma compl_le_compl : s.compl ≤ t.compl ↔ s ≤ t := compl_subset_compl

protected lemma compl_sup (s t : lower_set α) : (s ⊔ t).compl = s.compl ⊔ t.compl :=
upper_set.ext compl_sup
protected lemma compl_inf (s t : lower_set α) : (s ⊓ t).compl = s.compl ⊓ t.compl :=
upper_set.ext compl_inf
protected lemma compl_top : (⊤ : lower_set α).compl = ⊤ := upper_set.ext compl_univ
protected lemma compl_bot : (⊥ : lower_set α).compl = ⊥ := upper_set.ext compl_empty
protected lemma compl_Sup (S : set (lower_set α)) : (Sup S).compl = ⨆ s ∈ S, lower_set.compl s :=
upper_set.ext $ by simp only [coe_compl, coe_Sup, compl_Union₂, upper_set.coe_supr₂]

protected lemma compl_Inf (S : set (lower_set α)) : (Inf S).compl = ⨅ s ∈ S, lower_set.compl s :=
upper_set.ext $ by simp only [coe_compl, coe_Inf, compl_Inter₂, upper_set.coe_infi₂]

protected lemma compl_supr (f : ι → lower_set α) : (⨆ i, f i).compl = ⨆ i, (f i).compl :=
upper_set.ext $ by simp only [coe_compl, coe_supr, compl_Union, upper_set.coe_supr]

protected lemma compl_infi (f : ι → lower_set α) : (⨅ i, f i).compl = ⨅ i, (f i).compl :=
upper_set.ext $ by simp only [coe_compl, coe_infi, compl_Inter, upper_set.coe_infi]

@[simp] lemma compl_supr₂ (f : Π i, κ i → lower_set α) :
  (⨆ i j, f i j).compl = ⨆ i j, (f i j).compl :=
by simp_rw lower_set.compl_supr

@[simp] lemma compl_infi₂ (f : Π i, κ i → lower_set α) :
  (⨅ i j, f i j).compl = ⨅ i j, (f i j).compl :=
by simp_rw lower_set.compl_infi

end lower_set

/-- Upper sets are order-isomorphic to lower sets under complementation. -/
@[simps] def upper_set_iso_lower_set : upper_set α ≃o lower_set α :=
{ to_fun := upper_set.compl,
  inv_fun := lower_set.compl,
  left_inv := upper_set.compl_compl,
  right_inv := lower_set.compl_compl,
  map_rel_iff' := λ _ _, upper_set.compl_le_compl }

end has_le

/-! #### Map -/

section
variables [preorder α] [preorder β] [preorder γ]

namespace upper_set
variables {f : α ≃o β} {s t : upper_set α} {a : α} {b : β}

/-- An order isomorphism of preorders induces an order isomorphism of their upper sets. -/
def map (f : α ≃o β) : upper_set α ≃o upper_set β :=
{ to_fun := λ s, ⟨f '' s, s.upper.image f⟩,
  inv_fun := λ t, ⟨f ⁻¹' t, t.upper.preimage f.monotone⟩,
  left_inv := λ _, ext $ f.preimage_image _,
  right_inv := λ _, ext $ f.image_preimage _,
  map_rel_iff' := λ s t, image_subset_image_iff f.injective }

@[simp] lemma symm_map (f : α ≃o β) : (map f).symm = map f.symm :=
fun_like.ext _ _ $ λ s, ext $ set.preimage_equiv_eq_image_symm _ _

@[simp] lemma mem_map : b ∈ map f s ↔ f.symm b ∈ s :=
by { rw [←f.symm_symm, ←symm_map, f.symm_symm], refl }

@[simp] lemma map_refl : map (order_iso.refl α) = order_iso.refl _ := by { ext, simp }

@[simp] lemma map_map (g : β ≃o γ) (f : α ≃o β) : map g (map f s) = map (f.trans g) s :=
by { ext, simp }

variables (f s t)

@[simp, norm_cast] lemma coe_map : (map f s : set β) = f '' s := rfl

end upper_set

namespace lower_set
variables {f : α ≃o β} {s t : lower_set α} {a : α} {b : β}

/-- An order isomorphism of preorders induces an order isomorphism of their lower sets. -/
def map (f : α ≃o β) : lower_set α ≃o lower_set β :=
{ to_fun := λ s, ⟨f '' s, s.lower.image f⟩,
  inv_fun := λ t, ⟨f ⁻¹' t, t.lower.preimage f.monotone⟩,
  left_inv := λ _, set_like.coe_injective $ f.preimage_image _,
  right_inv := λ _, set_like.coe_injective $ f.image_preimage _,
  map_rel_iff' := λ s t, image_subset_image_iff f.injective }

@[simp] lemma symm_map (f : α ≃o β) : (map f).symm = map f.symm :=
fun_like.ext _ _ $ λ s, set_like.coe_injective $ set.preimage_equiv_eq_image_symm _ _

@[simp] lemma mem_map {f : α ≃o β} {b : β} : b ∈ map f s ↔ f.symm b ∈ s :=
by { rw [←f.symm_symm, ←symm_map, f.symm_symm], refl }

@[simp] lemma map_refl : map (order_iso.refl α) = order_iso.refl _ := by { ext, simp }

@[simp] lemma map_map (g : β ≃o γ) (f : α ≃o β) : map g (map f s) = map (f.trans g) s :=
by { ext, simp }

variables (f s t)

@[simp, norm_cast] lemma coe_map : (map f s : set β) = f '' s := rfl

end lower_set

namespace upper_set

@[simp] lemma compl_map (f : α ≃o β) (s : upper_set α) :
  (map f s).compl = lower_set.map f s.compl :=
set_like.coe_injective (set.image_compl_eq f.bijective).symm

end upper_set

namespace lower_set

@[simp] lemma compl_map (f : α ≃o β) (s : lower_set α) :
  (map f s).compl = upper_set.map f s.compl :=
set_like.coe_injective (set.image_compl_eq f.bijective).symm

end lower_set

end

/-! #### Principal sets -/

namespace upper_set
section preorder
variables [preorder α] [preorder β] {s : upper_set α} {a b : α}

/-- The smallest upper set containing a given element. -/
def Ici (a : α) : upper_set α := ⟨Ici a, is_upper_set_Ici a⟩

/-- The smallest upper set containing a given element. -/
def Ioi (a : α) : upper_set α := ⟨Ioi a, is_upper_set_Ioi a⟩

@[simp] lemma coe_Ici (a : α) : ↑(Ici a) = set.Ici a := rfl
@[simp] lemma coe_Ioi (a : α) : ↑(Ioi a) = set.Ioi a := rfl
@[simp] lemma mem_Ici_iff : b ∈ Ici a ↔ a ≤ b := iff.rfl
@[simp] lemma mem_Ioi_iff : b ∈ Ioi a ↔ a < b := iff.rfl
@[simp] lemma map_Ici (f : α ≃o β) (a : α) : map f (Ici a) = Ici (f a) := by { ext, simp }
@[simp] lemma map_Ioi (f : α ≃o β) (a : α) : map f (Ioi a) = Ioi (f a) := by { ext, simp }

lemma Ici_le_Ioi (a : α) : Ici a ≤ Ioi a := Ioi_subset_Ici_self

@[simp] lemma Ioi_top [order_top α] : Ioi (⊤ : α) = ⊤ := set_like.coe_injective Ioi_top
@[simp] lemma Ici_bot [order_bot α] : Ici (⊥ : α) = ⊥ := set_like.coe_injective Ici_bot

end preorder

@[simp] lemma Ici_sup [semilattice_sup α] (a b : α) : Ici (a ⊔ b) = Ici a ⊔ Ici b :=
ext Ici_inter_Ici.symm

section complete_lattice
variables [complete_lattice α]

@[simp] lemma Ici_Sup (S : set α) : Ici (Sup S) = ⨆ a ∈ S, Ici a :=
set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_supr_iff, Sup_le_iff]

@[simp] lemma Ici_supr (f : ι → α) : Ici (⨆ i, f i) = ⨆ i, Ici (f i) :=
set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_supr_iff, supr_le_iff]

@[simp] lemma Ici_supr₂ (f : Π i, κ i → α) : Ici (⨆ i j, f i j) = ⨆ i j, Ici (f i j) :=
by simp_rw Ici_supr

end complete_lattice
end upper_set

namespace lower_set
section preorder
variables [preorder α] [preorder β] {s : lower_set α} {a b : α}

/-- Principal lower set. `set.Iic` as a lower set. The smallest lower set containing a given
element. -/
def Iic (a : α) : lower_set α := ⟨Iic a, is_lower_set_Iic a⟩

/-- Strict principal lower set. `set.Iio` as a lower set. -/
def Iio (a : α) : lower_set α := ⟨Iio a, is_lower_set_Iio a⟩

@[simp] lemma coe_Iic (a : α) : ↑(Iic a) = set.Iic a := rfl
@[simp] lemma coe_Iio (a : α) : ↑(Iio a) = set.Iio a := rfl
@[simp] lemma mem_Iic_iff : b ∈ Iic a ↔ b ≤ a := iff.rfl
@[simp] lemma mem_Iio_iff : b ∈ Iio a ↔ b < a := iff.rfl
@[simp] lemma map_Iic (f : α ≃o β) (a : α) : map f (Iic a) = Iic (f a) := by { ext, simp }
@[simp] lemma map_Iio (f : α ≃o β) (a : α) : map f (Iio a) = Iio (f a) := by { ext, simp }

lemma Ioi_le_Ici (a : α) : Ioi a ≤ Ici a := Ioi_subset_Ici_self

@[simp] lemma Iic_top [order_top α] : Iic (⊤ : α) = ⊤ := set_like.coe_injective Iic_top
@[simp] lemma Iio_bot [order_bot α] : Iio (⊥ : α) = ⊥ := set_like.coe_injective Iio_bot

end preorder

@[simp] lemma Iic_inf [semilattice_inf α] (a b : α) : Iic (a ⊓ b) = Iic a ⊓ Iic b :=
set_like.coe_injective Iic_inter_Iic.symm

section complete_lattice
variables [complete_lattice α]

@[simp] lemma Iic_Inf (S : set α) : Iic (Inf S) = ⨅ a ∈ S, Iic a :=
set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi₂_iff, le_Inf_iff]

@[simp] lemma Iic_infi (f : ι → α) : Iic (⨅ i, f i) = ⨅ i, Iic (f i) :=
set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi_iff, le_infi_iff]

@[simp] lemma Iic_infi₂ (f : Π i, κ i → α) : Iic (⨅ i j, f i j) = ⨅ i j, Iic (f i j) :=
by simp_rw Iic_infi

end complete_lattice
end lower_set

section closure
variables [preorder α] [preorder β] {s t : set α} {x : α}

/-- The greatest upper set containing a given set. -/
def upper_closure (s : set α) : upper_set α :=
⟨{x | ∃ a ∈ s, a ≤ x}, λ x y h, Exists₂.imp $ λ a _, h.trans'⟩

/-- The least lower set containing a given set. -/
def lower_closure (s : set α) : lower_set α :=
⟨{x | ∃ a ∈ s, x ≤ a}, λ x y h, Exists₂.imp $ λ a _, h.trans⟩

@[simp] lemma mem_upper_closure : x ∈ upper_closure s ↔ ∃ a ∈ s, a ≤ x := iff.rfl
@[simp] lemma mem_lower_closure : x ∈ lower_closure s ↔ ∃ a ∈ s, x ≤ a := iff.rfl

-- We do not tag those two as `simp` to respect the abstraction.
@[norm_cast] lemma coe_upper_closure (s : set α) : ↑(upper_closure s) = ⋃ a ∈ s, Ici a :=
by { ext, simp }
@[norm_cast] lemma coe_lower_closure (s : set α) : ↑(lower_closure s) = ⋃ a ∈ s, Iic a :=
by { ext, simp }

lemma subset_upper_closure : s ⊆ upper_closure s := λ x hx, ⟨x, hx, le_rfl⟩
lemma subset_lower_closure : s ⊆ lower_closure s := λ x hx, ⟨x, hx, le_rfl⟩

lemma upper_closure_min (h : s ⊆ t) (ht : is_upper_set t) : ↑(upper_closure s) ⊆ t :=
λ a ⟨b, hb, hba⟩, ht hba $ h hb

lemma lower_closure_min (h : s ⊆ t) (ht : is_lower_set t) : ↑(lower_closure s) ⊆ t :=
λ a ⟨b, hb, hab⟩, ht hab $ h hb

protected lemma is_upper_set.upper_closure (hs : is_upper_set s) : ↑(upper_closure s) = s :=
(upper_closure_min subset.rfl hs).antisymm subset_upper_closure

protected lemma is_lower_set.lower_closure (hs : is_lower_set s) : ↑(lower_closure s) = s :=
(lower_closure_min subset.rfl hs).antisymm subset_lower_closure

@[simp] protected lemma upper_set.upper_closure (s : upper_set α) : upper_closure (s : set α) = s :=
set_like.coe_injective s.2.upper_closure

@[simp] protected lemma lower_set.lower_closure (s : lower_set α) : lower_closure (s : set α) = s :=
set_like.coe_injective s.2.lower_closure

@[simp] lemma upper_closure_image (f : α ≃o β) :
  upper_closure (f '' s) = upper_set.map f (upper_closure s) :=
begin
  rw [←f.symm_symm, ←upper_set.symm_map, f.symm_symm],
  ext,
  simp [-upper_set.symm_map, upper_set.map, order_iso.symm, ←f.le_symm_apply],
end

@[simp] lemma lower_closure_image (f : α ≃o β) :
  lower_closure (f '' s) = lower_set.map f (lower_closure s) :=
begin
  rw [←f.symm_symm, ←lower_set.symm_map, f.symm_symm],
  ext,
  simp [-lower_set.symm_map, lower_set.map, order_iso.symm, ←f.symm_apply_le],
end

@[simp] lemma upper_set.infi_Ici (s : set α) : (⨅ a ∈ s, upper_set.Ici a) = upper_closure s :=
by { ext, simp }

@[simp] lemma lower_set.supr_Iic (s : set α) : (⨆ a ∈ s, lower_set.Iic a) = lower_closure s :=
by { ext, simp }

lemma gc_upper_closure_coe :
  galois_connection (to_dual ∘ upper_closure : set α → (upper_set α)ᵒᵈ) (coe ∘ of_dual) :=
λ s t, ⟨λ h, subset_upper_closure.trans $ upper_set.coe_subset_coe.2 h,
  λ h, upper_closure_min h t.upper⟩

lemma gc_lower_closure_coe : galois_connection (lower_closure : set α → lower_set α) coe :=
λ s t, ⟨λ h, subset_lower_closure.trans $ lower_set.coe_subset_coe.2 h,
  λ h, lower_closure_min h t.lower⟩

/-- `upper_closure` forms a reversed Galois insertion with the coercion from upper sets to sets. -/
def gi_upper_closure_coe :
  galois_insertion (to_dual ∘ upper_closure : set α → (upper_set α)ᵒᵈ) (coe ∘ of_dual) :=
{ choice := λ s hs, to_dual (⟨s, λ a b hab ha, hs ⟨a, ha, hab⟩⟩ : upper_set α),
  gc := gc_upper_closure_coe,
  le_l_u := λ _, subset_upper_closure,
  choice_eq := λ s hs,
    of_dual.injective $ set_like.coe_injective $ subset_upper_closure.antisymm hs }

/-- `lower_closure` forms a Galois insertion with the coercion from lower sets to sets. -/
def gi_lower_closure_coe : galois_insertion (lower_closure : set α → lower_set α) coe :=
{ choice := λ s hs, ⟨s, λ a b hba ha, hs ⟨a, ha, hba⟩⟩,
  gc := gc_lower_closure_coe,
  le_l_u := λ _, subset_lower_closure,
  choice_eq := λ s hs, set_like.coe_injective $ subset_lower_closure.antisymm hs }

lemma upper_closure_anti : antitone (upper_closure : set α → upper_set α) :=
gc_upper_closure_coe.monotone_l

lemma lower_closure_mono : monotone (lower_closure : set α → lower_set α) :=
gc_lower_closure_coe.monotone_l

@[simp] lemma upper_closure_empty : upper_closure (∅ : set α) = ⊤ := by { ext, simp }
@[simp] lemma lower_closure_empty : lower_closure (∅ : set α) = ⊥ := by { ext, simp }

@[simp] lemma upper_closure_singleton (a : α) : upper_closure ({a} : set α) = upper_set.Ici a :=
by { ext, simp }

@[simp] lemma lower_closure_singleton (a : α) : lower_closure ({a} : set α) = lower_set.Iic a :=
by { ext, simp }

@[simp] lemma upper_closure_univ : upper_closure (univ : set α) = ⊥ :=
le_bot_iff.1 subset_upper_closure

@[simp] lemma lower_closure_univ : lower_closure (univ : set α) = ⊤ :=
top_le_iff.1 subset_lower_closure

@[simp] lemma upper_closure_eq_top_iff : upper_closure s = ⊤ ↔ s = ∅ :=
⟨λ h, subset_empty_iff.1 $ subset_upper_closure.trans (congr_arg coe h).subset,
  by { rintro rfl, exact upper_closure_empty }⟩

@[simp] lemma lower_closure_eq_bot_iff : lower_closure s = ⊥ ↔ s = ∅ :=
⟨λ h, subset_empty_iff.1 $ subset_lower_closure.trans (congr_arg coe h).subset,
  by { rintro rfl, exact lower_closure_empty }⟩

@[simp] lemma upper_closure_union (s t : set α) :
  upper_closure (s ∪ t) = upper_closure s ⊓ upper_closure t :=
by { ext, simp [or_and_distrib_right, exists_or_distrib] }

@[simp] lemma lower_closure_union (s t : set α) :
  lower_closure (s ∪ t) = lower_closure s ⊔ lower_closure t :=
by { ext, simp [or_and_distrib_right, exists_or_distrib] }

@[simp] lemma upper_closure_Union (f : ι → set α) :
  upper_closure (⋃ i, f i) = ⨅ i, upper_closure (f i) :=
by { ext, simp [←exists_and_distrib_right, @exists_comm α] }

@[simp] lemma lower_closure_Union (f : ι → set α) :
  lower_closure (⋃ i, f i) = ⨆ i, lower_closure (f i) :=
by { ext, simp [←exists_and_distrib_right, @exists_comm α] }

@[simp] lemma upper_closure_sUnion (S : set (set α)) :
  upper_closure (⋃₀ S) = ⨅ s ∈ S, upper_closure s :=
by simp_rw [sUnion_eq_bUnion, upper_closure_Union]

@[simp] lemma lower_closure_sUnion (S : set (set α)) :
  lower_closure (⋃₀ S) = ⨆ s ∈ S, lower_closure s :=
by simp_rw [sUnion_eq_bUnion, lower_closure_Union]

lemma set.ord_connected.upper_closure_inter_lower_closure (h : s.ord_connected) :
  ↑(upper_closure s) ∩ ↑(lower_closure s) = s :=
(subset_inter subset_upper_closure subset_lower_closure).antisymm' $ λ a ⟨⟨b, hb, hba⟩, c, hc, hac⟩,
  h.out hb hc ⟨hba, hac⟩

lemma ord_connected_iff_upper_closure_inter_lower_closure :
  s.ord_connected ↔ ↑(upper_closure s) ∩ ↑(lower_closure s) = s :=
begin
  refine ⟨set.ord_connected.upper_closure_inter_lower_closure, λ h, _⟩,
  rw ←h,
  exact (upper_set.upper _).ord_connected.inter (lower_set.lower _).ord_connected,
end

@[simp] lemma upper_bounds_lower_closure :
  upper_bounds (lower_closure s : set α) = upper_bounds s :=
(upper_bounds_mono_set subset_lower_closure).antisymm $ λ a ha b ⟨c, hc, hcb⟩, hcb.trans $ ha hc

@[simp] lemma lower_bounds_upper_closure :
  lower_bounds (upper_closure s : set α) = lower_bounds s :=
(lower_bounds_mono_set subset_upper_closure).antisymm $ λ a ha b ⟨c, hc, hcb⟩, (ha hc).trans hcb

@[simp] lemma bdd_above_lower_closure : bdd_above (lower_closure s : set α) ↔ bdd_above s :=
by simp_rw [bdd_above, upper_bounds_lower_closure]

@[simp] lemma bdd_below_upper_closure : bdd_below (upper_closure s : set α) ↔ bdd_below s :=
by simp_rw [bdd_below, lower_bounds_upper_closure]

alias bdd_above_lower_closure ↔ bdd_above.of_lower_closure bdd_above.lower_closure
alias bdd_below_upper_closure ↔ bdd_below.of_upper_closure bdd_below.upper_closure

attribute [protected] bdd_above.lower_closure bdd_below.upper_closure

end closure

/-! ### Product -/

section preorder
variables [preorder α] [preorder β]

section
variables {s : set α} {t : set β} {x : α × β}

lemma is_upper_set.prod (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ×ˢ t) :=
λ a b h ha, ⟨hs h.1 ha.1, ht h.2 ha.2⟩

lemma is_lower_set.prod (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ×ˢ t) :=
λ a b h ha, ⟨hs h.1 ha.1, ht h.2 ha.2⟩

end

namespace upper_set
variables (s s₁ s₂ : upper_set α) (t t₁ t₂ : upper_set β) {x : α × β}

/-- The product of two upper sets as an upper set. -/
def prod : upper_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩

infixr (name := upper_set.prod) ` ×ˢ `:82 := prod

@[simp, norm_cast] lemma coe_prod : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t := rfl

@[simp] lemma mem_prod {s : upper_set α} {t : upper_set β} : x ∈ s ×ˢ t ↔ x.1 ∈ s ∧ x.2 ∈ t :=
iff.rfl

lemma Ici_prod (x : α × β) : Ici x = Ici x.1 ×ˢ Ici x.2 := rfl
@[simp] lemma Ici_prod_Ici (a : α) (b : β) : Ici a ×ˢ Ici b = Ici (a, b) := rfl

@[simp] lemma prod_top : s ×ˢ (⊤ : upper_set β) = ⊤ := ext prod_empty
@[simp] lemma top_prod : (⊤ : upper_set α) ×ˢ t = ⊤ := ext empty_prod
@[simp] lemma bot_prod_bot : (⊥ : upper_set α) ×ˢ (⊥ : upper_set β) = ⊥ := ext univ_prod_univ
@[simp] lemma sup_prod : (s₁ ⊔ s₂) ×ˢ t = s₁ ×ˢ t ⊔ s₂ ×ˢ t := ext inter_prod
@[simp] lemma prod_sup : s ×ˢ (t₁ ⊔ t₂) = s ×ˢ t₁ ⊔ s ×ˢ t₂ := ext prod_inter
@[simp] lemma inf_prod : (s₁ ⊓ s₂) ×ˢ t = s₁ ×ˢ t ⊓ s₂ ×ˢ t := ext union_prod
@[simp] lemma prod_inf : s ×ˢ (t₁ ⊓ t₂) = s ×ˢ t₁ ⊓ s ×ˢ t₂ := ext prod_union
lemma prod_sup_prod : s₁ ×ˢ t₁ ⊔ s₂ ×ˢ t₂ = (s₁ ⊔ s₂) ×ˢ (t₁ ⊔ t₂) := ext prod_inter_prod

variables {s s₁ s₂ t t₁ t₂}

lemma prod_mono : s₁ ≤ s₂ → t₁ ≤ t₂ → s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ := prod_mono
lemma prod_mono_left : s₁ ≤ s₂ → s₁ ×ˢ t ≤ s₂ ×ˢ t := prod_mono_left
lemma prod_mono_right : t₁ ≤ t₂ → s ×ˢ t₁ ≤ s ×ˢ t₂ := prod_mono_right

@[simp] lemma prod_self_le_prod_self : s₁ ×ˢ s₁ ≤ s₂ ×ˢ s₂ ↔ s₁ ≤ s₂ := prod_self_subset_prod_self
@[simp] lemma prod_self_lt_prod_self : s₁ ×ˢ s₁ < s₂ ×ˢ s₂ ↔ s₁ < s₂ := prod_self_ssubset_prod_self

lemma prod_le_prod_iff : s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ ↔ s₁ ≤ s₂ ∧ t₁ ≤ t₂ ∨ s₂ = ⊤ ∨ t₂ = ⊤ :=
prod_subset_prod_iff.trans $ by simp

@[simp] lemma prod_eq_top : s ×ˢ t = ⊤ ↔ s = ⊤ ∨ t = ⊤ :=
by { simp_rw set_like.ext'_iff, exact prod_eq_empty_iff }

@[simp] lemma codisjoint_prod :
  codisjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ codisjoint s₁ s₂ ∨ codisjoint t₁ t₂ :=
by simp_rw [codisjoint_iff, prod_sup_prod, prod_eq_top]

end upper_set

namespace lower_set
variables (s s₁ s₂ : lower_set α) (t t₁ t₂ : lower_set β) {x : α × β}

/-- The product of two lower sets as a lower set. -/
def prod : lower_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩

infixr (name := lower_set.prod) ` ×ˢ `:82 := lower_set.prod

@[simp, norm_cast] lemma coe_prod : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t := rfl

@[simp] lemma mem_prod {s : lower_set α} {t : lower_set β} : x ∈ s ×ˢ t ↔ x.1 ∈ s ∧ x.2 ∈ t :=
iff.rfl

lemma Iic_prod (x : α × β) : Iic x = Iic x.1 ×ˢ Iic x.2 := rfl
@[simp] lemma Ici_prod_Ici (a : α) (b : β) : Iic a ×ˢ Iic b = Iic (a, b) := rfl

@[simp] lemma prod_bot : s ×ˢ (⊥ : lower_set β) = ⊥ := ext prod_empty
@[simp] lemma bot_prod : (⊥ : lower_set α) ×ˢ t = ⊥ := ext empty_prod
@[simp] lemma top_prod_top : (⊤ : lower_set α) ×ˢ (⊤ : lower_set β) = ⊤ := ext univ_prod_univ
@[simp] lemma inf_prod : (s₁ ⊓ s₂) ×ˢ t = s₁ ×ˢ t ⊓ s₂ ×ˢ t := ext inter_prod
@[simp] lemma prod_inf : s ×ˢ (t₁ ⊓ t₂) = s ×ˢ t₁ ⊓ s ×ˢ t₂ := ext prod_inter
@[simp] lemma sup_prod : (s₁ ⊔ s₂) ×ˢ t = s₁ ×ˢ t ⊔ s₂ ×ˢ t := ext union_prod
@[simp] lemma prod_sup : s ×ˢ (t₁ ⊔ t₂) = s ×ˢ t₁ ⊔ s ×ˢ t₂ := ext prod_union
lemma prod_inf_prod : s₁ ×ˢ t₁ ⊓ s₂ ×ˢ t₂ = (s₁ ⊓ s₂) ×ˢ (t₁ ⊓ t₂) := ext prod_inter_prod

variables {s s₁ s₂ t t₁ t₂}

lemma prod_mono : s₁ ≤ s₂ → t₁ ≤ t₂ → s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ := prod_mono
lemma prod_mono_left : s₁ ≤ s₂ → s₁ ×ˢ t ≤ s₂ ×ˢ t := prod_mono_left
lemma prod_mono_right : t₁ ≤ t₂ → s ×ˢ t₁ ≤ s ×ˢ t₂ := prod_mono_right

@[simp] lemma prod_self_le_prod_self : s₁ ×ˢ s₁ ≤ s₂ ×ˢ s₂ ↔ s₁ ≤ s₂ := prod_self_subset_prod_self
@[simp] lemma prod_self_lt_prod_self : s₁ ×ˢ s₁ < s₂ ×ˢ s₂ ↔ s₁ < s₂ := prod_self_ssubset_prod_self

lemma prod_le_prod_iff : s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ ↔ s₁ ≤ s₂ ∧ t₁ ≤ t₂ ∨ s₁ = ⊥ ∨ t₁ = ⊥ :=
prod_subset_prod_iff.trans $ by simp

@[simp] lemma prod_eq_bot : s ×ˢ t = ⊥ ↔ s = ⊥ ∨ t = ⊥ :=
by { simp_rw set_like.ext'_iff, exact prod_eq_empty_iff }

@[simp] lemma disjoint_prod : disjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ disjoint s₁ s₂ ∨ disjoint t₁ t₂ :=
by simp_rw [disjoint_iff, prod_inf_prod, prod_eq_bot]

end lower_set

@[simp] lemma upper_closure_prod (s : set α) (t : set β) :
  upper_closure (s ×ˢ t) = upper_closure s ×ˢ upper_closure t :=
by { ext, simp [prod.le_def, and_and_and_comm _ (_ ∈ t)] }

@[simp] lemma lower_closure_prod (s : set α) (t : set β) :
  lower_closure (s ×ˢ t) = lower_closure s ×ˢ lower_closure t :=
by { ext, simp [prod.le_def, and_and_and_comm _ (_ ∈ t)] }

end preorder


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Scott Morrison

Case bashing:
* on `x ∈ A`, for `A : finset α` or `A : list α`, or
* on `x : A`, with `[fintype A]`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.tactic.norm_num
import Mathlib.PostPort

namespace Mathlib

namespace tactic

/-- Checks that the expression looks like `x ∈ A` for `A : finset α`, `multiset α` or `A : list α`,
    and returns the type α. -/
/--
`expr_list_to_list_expr` converts an `expr` of type `list α`
to a list of `expr`s each with type `α`.

TODO: this should be moved, and possibly duplicates an existing definition.
-/
/--
`fin_cases_at with_list e` performs case analysis on `e : α`, where `α` is a fintype.
The optional list of expressions `with_list` provides descriptions for the cases of `e`,
for example, to display nats as `n.succ` instead of `n+1`.
These should be defeq to and in the same order as the terms in the enumeration of `α`.
-/
namespace interactive

/--
`fin_cases h` performs case analysis on a hypothesis of the form
`h : A`, where `[fintype A]` is available, or
`h ∈ A`, where `A : finset X`, `A : multiset X` or `A : list X`.

`fin_cases *` performs case analysis on all suitable hypotheses.

As an example, in
```
example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *; simp,
  all_goals { assumption }
end
```
after `fin_cases p; simp`, there are three goals, `f 0`, `f 1`, and `f 2`.
-/
end interactive

end Mathlib


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad

! This file was ported from Lean 3 source module data.bool.basic
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Init.Data.Bool.Lemmas
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Function

/-!
# Booleans

This file proves various trivial lemmas about booleans and their
relation to decidable propositions.

## Tags
bool, boolean, Bool, De Morgan

-/

namespace Bool

theorem decide_True {h} : @decide True h = true :=
  decide_eq_true True.intro
#align bool.to_bool_true Bool.decide_True

theorem decide_False {h} : @decide False h = false :=
  decide_eq_false id
#align bool.to_bool_false Bool.decide_False

@[simp]
theorem decide_coe (b : Bool) {h} : @decide b h = b := by
  cases b
  · exact decide_eq_false $ λ j => by cases j
  · exact decide_eq_true $ rfl
#align bool.to_bool_coe Bool.decide_coe

theorem coe_decide (p : Prop) [d : Decidable p] : decide p ↔ p :=
  match d with
  | isTrue hp => ⟨λ _ => hp, λ _ => rfl⟩
  | isFalse hnp => ⟨λ h => Bool.noConfusion h, λ hp => (hnp hp).elim⟩
#align bool.coe_to_bool Bool.coe_decide

theorem of_decide_iff {p : Prop} [Decidable p] : decide p ↔ p :=
  coe_decide p
#align bool.of_to_bool_iff Bool.of_decide_iff

@[simp]
theorem true_eq_decide_iff {p : Prop} [Decidable p] : true = decide p ↔ p :=
  eq_comm.trans of_decide_iff
#align bool.tt_eq_to_bool_iff Bool.true_eq_decide_iff

@[simp]
theorem false_eq_decide_iff {p : Prop} [Decidable p] : false = decide p ↔ ¬p :=
  eq_comm.trans (decide_false_iff _)
#align bool.ff_eq_to_bool_iff Bool.false_eq_decide_iff

theorem decide_not (p : Prop) [Decidable p] : (decide ¬p) = !(decide p) := by
  by_cases p <;> simp [*]
#align bool.to_bool_not Bool.decide_not

@[simp]
theorem decide_and (p q : Prop) [Decidable p] [Decidable q] : decide (p ∧ q) = (p && q) := by
  by_cases p <;> by_cases q <;> simp [*]
#align bool.to_bool_and Bool.decide_and

@[simp]
theorem decide_or (p q : Prop) [Decidable p] [Decidable q] : decide (p ∨ q) = (p || q) := by
  by_cases p <;> by_cases q <;> simp [*]
#align bool.to_bool_or Bool.decide_or

#align bool.to_bool_eq decide_eq_decide

theorem not_false' : ¬false := fun.
#align bool.not_ff Bool.not_false'

-- Porting note: new theorem
theorem eq_iff_eq_true_iff {a b : Bool} : a = b ↔ ((a = true) ↔ (b = true)) :=
by cases a <;> cases b <;> simp

-- Porting note: new theorem
theorem beq_eq_decide_eq [DecidableEq α]
  (a b : α) : (a == b) = decide (a = b) := rfl

-- Porting note: new theorem
theorem beq_comm [BEq α] [LawfulBEq α] {a b : α} : (a == b) = (b == a) :=
  eq_iff_eq_true_iff.2 (by simp [@eq_comm α])

@[simp]
theorem default_bool : default = false :=
  rfl
#align bool.default_bool Bool.default_bool

theorem dichotomy (b : Bool) : b = false ∨ b = true := by cases b <;> simp
#align bool.dichotomy Bool.dichotomy

@[simp]
theorem forall_bool {p : Bool → Prop} : (∀ b, p b) ↔ p false ∧ p true :=
  ⟨fun h ↦ by simp [h], fun ⟨h₁, h₂⟩ b ↦ by cases b <;> assumption⟩
#align bool.forall_bool Bool.forall_bool

@[simp]
theorem exists_bool {p : Bool → Prop} : (∃ b, p b) ↔ p false ∨ p true :=
  ⟨fun ⟨b, h⟩ ↦ by cases b; exact Or.inl h; exact Or.inr h,
  fun h ↦ match h with
  | .inl h => ⟨_, h⟩
  | .inr h => ⟨_, h⟩ ⟩
#align bool.exists_bool Bool.exists_bool

/-- If `p b` is decidable for all `b : bool`, then `∀ b, p b` is decidable -/
instance decidableForallBool {p : Bool → Prop} [∀ b, Decidable (p b)] : Decidable (∀ b, p b) :=
  decidable_of_decidable_of_iff forall_bool.symm
#align bool.decidable_forall_bool Bool.decidableForallBool

/-- If `p b` is decidable for all `b : bool`, then `∃ b, p b` is decidable -/
instance decidableExistsBool {p : Bool → Prop} [∀ b, Decidable (p b)] : Decidable (∃ b, p b) :=
  decidable_of_decidable_of_iff exists_bool.symm
#align bool.decidable_exists_bool Bool.decidableExistsBool

theorem cond_eq_ite {α} (b : Bool) (t e : α) : cond b t e = if b then t else e := by
  cases b <;> simp
#align bool.cond_eq_ite Bool.cond_eq_ite

@[simp]
theorem cond_decide {α} (p : Prop) [Decidable p] (t e : α) :
    cond (decide p) t e = if p then t else e := by
  by_cases p <;> simp [*]
#align bool.cond_to_bool Bool.cond_decide

@[simp]
theorem cond_not {α} (b : Bool) (t e : α) : cond (!b) t e = cond b e t := by cases b <;> rfl
#align bool.cond_bnot Bool.cond_not

theorem not_ne_id : not ≠ id := fun h ↦ ff_ne_tt <| congrFun h true
#align bool.bnot_ne_id Bool.not_ne_id

theorem coe_bool_iff : ∀ {a b : Bool}, (a ↔ b) ↔ a = b := by decide
#align bool.coe_bool_iff Bool.coe_bool_iff

theorem eq_true_of_ne_false : ∀ {a : Bool}, a ≠ false → a = true := by decide
#align bool.eq_tt_of_ne_ff Bool.eq_true_of_ne_false

theorem eq_false_of_ne_true : ∀ {a : Bool}, a ≠ true → a = false := by decide
#align bool.eq_ff_of_ne_tt Bool.eq_false_of_ne_true

theorem or_comm : ∀ a b, (a || b) = (b || a) := by decide
#align bool.bor_comm Bool.or_comm

#align bool.bor_assoc Bool.or_assoc

theorem or_left_comm : ∀ a b c, (a || (b || c)) = (b || (a || c)) := by decide
#align bool.bor_left_comm Bool.or_left_comm

theorem or_inl {a b : Bool} (H : a) : a || b := by simp [H]
#align bool.bor_inl Bool.or_inl

theorem or_inr {a b : Bool} (H : b) : a || b := by cases a <;> simp [H]
#align bool.bor_inr Bool.or_inr

theorem and_comm : ∀ a b, (a && b) = (b && a) := by decide
#align bool.band_comm Bool.and_comm

#align bool.band_assoc Bool.and_assoc

theorem and_left_comm : ∀ a b c, (a && (b && c)) = (b && (a && c)) := by decide
#align bool.band_left_comm Bool.and_left_comm

theorem and_elim_left : ∀ {a b : Bool}, a && b → a := by decide
#align bool.band_elim_left Bool.and_elim_left

theorem and_intro : ∀ {a b : Bool}, a → b → a && b := by decide
#align bool.band_intro Bool.and_intro

theorem and_elim_right : ∀ {a b : Bool}, a && b → b := by decide
#align bool.band_elim_right Bool.and_elim_right

theorem and_or_distrib_left (a b c : Bool) : (a && (b || c)) = (a && b || a && c) := by
  cases a <;> simp
#align bool.band_bor_distrib_left Bool.and_or_distrib_left

theorem and_or_distrib_right (a b c : Bool) : ((a || b) && c) = (a && c || b && c) := by
  cases a <;> cases b <;> cases c <;> simp
#align bool.band_bor_distrib_right Bool.and_or_distrib_right

theorem or_and_distrib_left (a b c : Bool) : (a || b && c) = ((a || b) && (a || c)) := by
  cases a <;> simp
#align bool.bor_band_distrib_left Bool.or_and_distrib_left

theorem or_and_distrib_right (a b c : Bool) : (a && b || c) = ((a || c) && (b || c)) := by
  cases a <;> cases b <;> cases c <;> simp
#align bool.bor_band_distrib_right Bool.or_and_distrib_right

#align bool.bnot_ff Bool.not_false
#align bool.bnot_tt Bool.not_true

lemma eq_not_iff : ∀ {a b : Bool}, a = !b ↔ a ≠ b := by decide
#align bool.eq_bnot_iff Bool.eq_not_iff

lemma not_eq_iff : ∀ {a b : Bool}, !a = b ↔ a ≠ b := by decide
#align bool.bnot_eq_iff Bool.not_eq_iff

-- Porting note: this is a case where our naming scheme is less than ideal.
-- The two `not`s in this name are different.
-- For now we're going with consistency at the expense of ambiguity.
@[simp]
theorem not_eq_not : ∀ {a b : Bool}, ¬a = !b ↔ a = b := by decide
#align bool.not_eq_bnot Bool.not_eq_not

-- Porting note: and here again.
@[simp]
theorem not_not_eq : ∀ {a b : Bool}, ¬(!a) = b ↔ a = b := by decide
#align bool.bnot_not_eq Bool.not_not_eq

theorem ne_not {a b : Bool} : a ≠ !b ↔ a = b :=
  not_eq_not
#align bool.ne_bnot Bool.ne_not

theorem not_ne : ∀ {a b : Bool}, (!a) ≠ b ↔ a = b := not_not_eq
#align bool.bnot_ne Bool.not_ne

lemma not_ne_self : ∀ b : Bool, (!b) ≠ b := by decide
#align bool.bnot_ne_self Bool.not_ne_self

lemma self_ne_not : ∀ b : Bool, b ≠ !b := by decide
#align bool.self_ne_bnot Bool.self_ne_not

lemma eq_or_eq_not : ∀ a b, a = b ∨ a = !b := by decide
#align bool.eq_or_eq_bnot Bool.eq_or_eq_not

-- Porting note: naming issue again: these two `not` are different.
theorem not_iff_not : ∀ {b : Bool}, !b ↔ ¬b := by simp
#align bool.bnot_iff_not Bool.not_iff_not

theorem eq_true_of_not_eq_false' {a : Bool} : !a = false → a = true := by
  cases a <;> decide
#align bool.eq_tt_of_bnot_eq_ff Bool.eq_true_of_not_eq_false'

theorem eq_false_of_not_eq_true' {a : Bool} : !a = true → a = false := by
  cases a <;> decide
#align bool.eq_ff_of_bnot_eq_tt Bool.eq_false_of_not_eq_true'

@[simp]
theorem and_not_self : ∀ x, (x && !x) = false := by decide
#align bool.band_bnot_self Bool.and_not_self

@[simp]
theorem not_and_self : ∀ x, (!x && x) = false := by decide
#align bool.bnot_band_self Bool.not_and_self

@[simp]
theorem or_not_self : ∀ x, (x || !x) = true := by decide
#align bool.bor_bnot_self Bool.or_not_self

@[simp]
theorem not_or_self : ∀ x, (!x || x) = true := by decide
#align bool.bnot_bor_self Bool.not_or_self

theorem xor_comm : ∀ a b, xor a b = xor b a := by decide
#align bool.bxor_comm Bool.xor_comm

@[simp]
theorem xor_assoc : ∀ a b c, xor (xor a b) c = xor a (xor b c) := by decide
#align bool.bxor_assoc Bool.xor_assoc

theorem xor_left_comm : ∀ a b c, xor a (xor b c) = xor b (xor a c) := by decide
#align bool.bxor_left_comm Bool.xor_left_comm

@[simp]
theorem xor_not_left : ∀ a, xor (!a) a = true := by decide
#align bool.bxor_bnot_left Bool.xor_not_left

@[simp]
theorem xor_not_right : ∀ a, xor a (!a) = true := by decide
#align bool.bxor_bnot_right Bool.xor_not_right

@[simp]
theorem xor_not_not : ∀ a b, xor (!a) (!b) = xor a b := by decide
#align bool.bxor_bnot_bnot Bool.xor_not_not

@[simp]
theorem xor_false_left : ∀ a, xor false a = a := by decide
#align bool.bxor_ff_left Bool.xor_false_left

@[simp]
theorem xor_false_right : ∀ a, xor a false = a := by decide
#align bool.bxor_ff_right Bool.xor_false_right

theorem and_xor_distrib_left (a b c : Bool) : (a && xor b c) = xor (a && b) (a && c) := by
  cases a <;> simp
#align bool.band_bxor_distrib_left Bool.and_xor_distrib_left

theorem and_xor_distrib_right (a b c : Bool) : (xor a b && c) = xor (a && c) (b && c) := by
  cases a <;> cases b <;> cases c <;> simp
#align bool.band_bxor_distrib_right Bool.and_xor_distrib_right

theorem xor_iff_ne : ∀ {x y : Bool}, xor x y = true ↔ x ≠ y := by decide
#align bool.bxor_iff_ne Bool.xor_iff_ne

/-! ### De Morgan's laws for booleans-/

@[simp]
theorem not_and : ∀ a b : Bool, !(a && b) = (!a || !b) := by decide
#align bool.bnot_band Bool.not_and

@[simp]
theorem not_or : ∀ a b : Bool, !(a || b) = (!a && !b) := by decide
#align bool.bnot_bor Bool.not_or

theorem not_inj : ∀ {a b : Bool}, !a = !b → a = b := by decide
#align bool.bnot_inj Bool.not_inj

-- Porting note: having to unfold here is not pretty.
-- There is a discussion on zulip about this at
-- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/LinearOrder.20in.20mathlib3.2F4/near/308228493
instance linearOrder : LinearOrder Bool where
  le := fun a b ↦ a = false ∨ b = true
  le_refl := by unfold LE.le; decide
  le_trans := by unfold LE.le; decide
  le_antisymm := by unfold LE.le Preorder.toLE; decide
  le_total := by unfold LE.le Preorder.toLE PartialOrder.toPreorder; decide
  decidable_le := by unfold LE.le Preorder.toLE PartialOrder.toPreorder; exact inferInstance
  decidable_eq := inferInstance
  max := or
  max_def := λ a b => by cases a <;> cases b <;> decide
  min := and
  min_def := λ a b => by cases a <;> cases b <;> decide
#align bool.linear_order Bool.linearOrder

@[simp]
theorem false_le {x : Bool} : false ≤ x :=
  Or.intro_left _ rfl
#align bool.ff_le Bool.false_le

@[simp]
theorem le_true {x : Bool} : x ≤ true :=
  Or.intro_right _ rfl
#align bool.le_tt Bool.le_true

theorem lt_iff : ∀ {x y : Bool}, x < y ↔ x = false ∧ y = true := by decide
#align bool.lt_iff Bool.lt_iff

@[simp]
theorem false_lt_true : false < true :=
  lt_iff.2 ⟨rfl, rfl⟩
#align bool.ff_lt_tt Bool.false_lt_true

theorem le_iff_imp : ∀ {x y : Bool}, x ≤ y ↔ x → y := by decide
#align bool.le_iff_imp Bool.le_iff_imp

theorem and_le_left : ∀ x y : Bool, (x && y) ≤ x := by decide
#align bool.band_le_left Bool.and_le_left

theorem and_le_right : ∀ x y : Bool, (x && y) ≤ y := by decide
#align bool.band_le_right Bool.and_le_right

theorem le_and : ∀ {x y z : Bool}, x ≤ y → x ≤ z → x ≤ (y && z) := by decide
#align bool.le_band Bool.le_and

theorem left_le_or : ∀ x y : Bool, x ≤ (x || y) := by decide
#align bool.left_le_bor Bool.left_le_or

theorem right_le_or : ∀ x y : Bool, y ≤ (x || y) := by decide
#align bool.right_le_bor Bool.right_le_or

theorem or_le : ∀ {x y z}, x ≤ z → y ≤ z → (x || y) ≤ z := by decide
#align bool.bor_le Bool.or_le

/-- convert a `bool` to a `ℕ`, `false -> 0`, `true -> 1` -/
def toNat (b : Bool) : Nat :=
  cond b 1 0
#align bool.to_nat Bool.toNat

/-- convert a `ℕ` to a `bool`, `0 -> false`, everything else -> `true` -/
def ofNat (n : Nat) : Bool :=
  decide (n ≠ 0)
#align bool.of_nat Bool.ofNat

theorem ofNat_le_ofNat {n m : Nat} (h : n ≤ m) : ofNat n ≤ ofNat m := by
  simp only [ofNat, ne_eq, _root_.decide_not];
  cases Nat.decEq n 0 with
  | isTrue hn => rw [decide_eq_true hn]; exact false_le
  | isFalse hn =>
    cases Nat.decEq m 0 with
    | isFalse hm => rw [decide_eq_false hm]; exact le_true
    | isTrue hm => subst hm; have h := le_antisymm h (Nat.zero_le n); contradiction
#align bool.of_nat_le_of_nat Bool.ofNat_le_ofNat

theorem toNat_le_toNat {b₀ b₁ : Bool} (h : b₀ ≤ b₁) : toNat b₀ ≤ toNat b₁ := by
  cases h with
  | inl h => subst h; exact Nat.zero_le _
  | inr h => subst h; cases b₀ <;> simp;
#align bool.to_nat_le_to_nat Bool.toNat_le_toNat

theorem ofNat_toNat (b : Bool) : ofNat (toNat b) = b := by
  cases b <;> rfl
#align bool.of_nat_to_nat Bool.ofNat_toNat

@[simp]

/-- **Kaminski's Equation** -/
theorem apply_apply_apply (f : Bool → Bool) (x : Bool) : f (f (f x)) = f x := by
  cases x <;> cases h₁ : f true <;> cases h₂ : f false <;> simp only [h₁, h₂]
#align bool.apply_apply_apply Bool.apply_apply_apply

end Bool


-- Exercise 1
-- Go back to the exercises in Chapter 3 and Chapter 4 and redo as many as you can now with tactic proofs, using also rw and simp as appropriate.

-- Actually I'm already using tactics 😁

-- Use tactic combinators to obtain a one line proof of the following:
-- Exercise 2
example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by {split, left, assumption,
    split, right, left, assumption,
    right, right, assumption}

-- Alternatively,
example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by {split, left, assumption,
    split, repeat {right, {left, assumption} <|> {right, assumption}}}

-- Alternatively,
meta def left_middle_right : tactic unit :=
`[ repeat { {left, assumption} <|> right <|> assumption } ]

example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by {split, left_middle_right,
    split, repeat {left_middle_right}}