/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.coeff
import Mathlib.data.nat.with_bot
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

/-!
# Theory of univariate polynomials

The definitions include
`degree`, `monic`, `leading_coeff`

Results include
- `degree_mul` : The degree of the product is the sum of degrees
- `leading_coeff_add_of_degree_eq` and `leading_coeff_add_of_degree_lt` :
    The leading_coefficient of a sum is determined by the leading coefficients and degrees
-/

namespace polynomial

/-- `degree p` is the degree of the polynomial `p`, i.e. the largest `X`-exponent in `p`.
`degree p = some n` when `p ≠ 0` and `n` is the highest power of `X` that appears in `p`, otherwise
`degree 0 = ⊥`. -/
def degree {R : Type u} [semiring R] (p : polynomial R) : with_bot ℕ :=
  finset.sup (finsupp.support p) some

theorem degree_lt_wf {R : Type u} [semiring R] : well_founded fun (p q : polynomial R) => degree p < degree q :=
  inv_image.wf degree (with_bot.well_founded_lt nat.lt_wf)

protected instance has_well_founded {R : Type u} [semiring R] : has_well_founded (polynomial R) :=
  has_well_founded.mk (fun (p q : polynomial R) => degree p < degree q) degree_lt_wf

/-- `nat_degree p` forces `degree p` to ℕ, by defining nat_degree 0 = 0. -/
def nat_degree {R : Type u} [semiring R] (p : polynomial R) : ℕ :=
  option.get_or_else (degree p) 0

/-- `leading_coeff p` gives the coefficient of the highest power of `X` in `p`-/
def leading_coeff {R : Type u} [semiring R] (p : polynomial R) : R :=
  coeff p (nat_degree p)

/-- a polynomial is `monic` if its leading coefficient is 1 -/
def monic {R : Type u} [semiring R] (p : polynomial R) :=
  leading_coeff p = 1

theorem monic_of_subsingleton {R : Type u} [semiring R] [subsingleton R] (p : polynomial R) : monic p :=
  subsingleton.elim (leading_coeff p) 1

theorem monic.def {R : Type u} [semiring R] {p : polynomial R} : monic p ↔ leading_coeff p = 1 :=
  iff.rfl

protected instance monic.decidable {R : Type u} [semiring R] {p : polynomial R} [DecidableEq R] : Decidable (monic p) :=
  eq.mpr sorry (_inst_2 (leading_coeff p) 1)

@[simp] theorem monic.leading_coeff {R : Type u} [semiring R] {p : polynomial R} (hp : monic p) : leading_coeff p = 1 :=
  hp

theorem monic.coeff_nat_degree {R : Type u} [semiring R] {p : polynomial R} (hp : monic p) : coeff p (nat_degree p) = 1 :=
  hp

@[simp] theorem degree_zero {R : Type u} [semiring R] : degree 0 = ⊥ :=
  rfl

@[simp] theorem nat_degree_zero {R : Type u} [semiring R] : nat_degree 0 = 0 :=
  rfl

@[simp] theorem coeff_nat_degree {R : Type u} [semiring R] {p : polynomial R} : coeff p (nat_degree p) = leading_coeff p :=
  rfl

theorem degree_eq_bot {R : Type u} [semiring R] {p : polynomial R} : degree p = ⊥ ↔ p = 0 := sorry

theorem degree_of_subsingleton {R : Type u} [semiring R] {p : polynomial R} [subsingleton R] : degree p = ⊥ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (degree p = ⊥)) (subsingleton.elim p 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (degree 0 = ⊥)) degree_zero)) (Eq.refl ⊥))

theorem nat_degree_of_subsingleton {R : Type u} [semiring R] {p : polynomial R} [subsingleton R] : nat_degree p = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree p = 0)) (subsingleton.elim p 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree 0 = 0)) nat_degree_zero)) (Eq.refl 0))

theorem degree_eq_nat_degree {R : Type u} [semiring R] {p : polynomial R} (hp : p ≠ 0) : degree p = ↑(nat_degree p) := sorry

theorem degree_eq_iff_nat_degree_eq {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (hp : p ≠ 0) : degree p = ↑n ↔ nat_degree p = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (degree p = ↑n ↔ nat_degree p = n)) (degree_eq_nat_degree hp)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(nat_degree p) = ↑n ↔ nat_degree p = n)) (propext with_bot.coe_eq_coe)))
      (iff.refl (nat_degree p = n)))

theorem degree_eq_iff_nat_degree_eq_of_pos {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (hn : 0 < n) : degree p = ↑n ↔ nat_degree p = n := sorry

theorem nat_degree_eq_of_degree_eq_some {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (h : degree p = ↑n) : nat_degree p = n := sorry

@[simp] theorem degree_le_nat_degree {R : Type u} [semiring R] {p : polynomial R} : degree p ≤ ↑(nat_degree p) :=
  galois_connection.le_u_l (galois_insertion.gc with_bot.gi_get_or_else_bot) (degree p)

theorem nat_degree_eq_of_degree_eq {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] {q : polynomial S} (h : degree p = degree q) : nat_degree p = nat_degree q := sorry

theorem le_degree_of_ne_zero {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} (h : coeff p n ≠ 0) : ↑n ≤ degree p :=
  (fun (this : some n ≤ finset.sup (finsupp.support p) some) => this) (finset.le_sup (iff.mpr finsupp.mem_support_iff h))

theorem le_nat_degree_of_ne_zero {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} (h : coeff p n ≠ 0) : n ≤ nat_degree p := sorry

theorem le_nat_degree_of_mem_supp {R : Type u} [semiring R] {p : polynomial R} (a : ℕ) : a ∈ finsupp.support p → a ≤ nat_degree p :=
  le_nat_degree_of_ne_zero ∘ iff.mp mem_support_iff_coeff_ne_zero

theorem supp_subset_range {R : Type u} {m : ℕ} [semiring R] {p : polynomial R} (h : nat_degree p < m) : finsupp.support p ⊆ finset.range m :=
  fun (n : ℕ) (hn : n ∈ finsupp.support p) =>
    iff.mpr finset.mem_range (has_le.le.trans_lt (le_nat_degree_of_mem_supp n hn) h)

theorem supp_subset_range_nat_degree_succ {R : Type u} [semiring R] {p : polynomial R} : finsupp.support p ⊆ finset.range (nat_degree p + 1) :=
  supp_subset_range (nat.lt_succ_self (nat_degree p))

theorem degree_le_degree {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : coeff q (nat_degree p) ≠ 0) : degree p ≤ degree q :=
  dite (p = 0) (fun (hp : p = 0) => eq.mpr (id (Eq._oldrec (Eq.refl (degree p ≤ degree q)) hp)) bot_le)
    fun (hp : ¬p = 0) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (degree p ≤ degree q)) (degree_eq_nat_degree hp))) (le_degree_of_ne_zero h)

theorem degree_ne_of_nat_degree_ne {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} : nat_degree p ≠ n → degree p ≠ ↑n := sorry

theorem nat_degree_le_iff_degree_le {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} : nat_degree p ≤ n ↔ degree p ≤ ↑n :=
  with_bot.get_or_else_bot_le_iff

theorem degree_le_of_nat_degree_le {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} : nat_degree p ≤ n → degree p ≤ ↑n :=
  iff.mp nat_degree_le_iff_degree_le

theorem nat_degree_le_nat_degree {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hpq : degree p ≤ degree q) : nat_degree p ≤ nat_degree q :=
  galois_connection.monotone_l (galois_insertion.gc with_bot.gi_get_or_else_bot) hpq

@[simp] theorem degree_C {R : Type u} {a : R} [semiring R] (ha : a ≠ 0) : degree (coe_fn C a) = 0 :=
  (fun (this : finset.sup (ite (a = 0) ∅ (singleton 0)) some = 0) => this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (finset.sup (ite (a = 0) ∅ (singleton 0)) some = 0)) (if_neg ha)))
      (Eq.refl (finset.sup (singleton 0) some)))

theorem degree_C_le {R : Type u} {a : R} [semiring R] : degree (coe_fn C a) ≤ 0 := sorry

theorem degree_one_le {R : Type u} [semiring R] : degree 1 ≤ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (degree 1 ≤ 0)) (Eq.symm C_1))) degree_C_le

@[simp] theorem nat_degree_C {R : Type u} [semiring R] (a : R) : nat_degree (coe_fn C a) = 0 := sorry

@[simp] theorem nat_degree_one {R : Type u} [semiring R] : nat_degree 1 = 0 :=
  nat_degree_C 1

@[simp] theorem nat_degree_nat_cast {R : Type u} [semiring R] (n : ℕ) : nat_degree ↑n = 0 := sorry

@[simp] theorem degree_monomial {R : Type u} {a : R} [semiring R] (n : ℕ) (ha : a ≠ 0) : degree (coe_fn (monomial n) a) = ↑n := sorry

@[simp] theorem degree_C_mul_X_pow {R : Type u} {a : R} [semiring R] (n : ℕ) (ha : a ≠ 0) : degree (coe_fn C a * X ^ n) = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (degree (coe_fn C a * X ^ n) = ↑n)) (Eq.symm single_eq_C_mul_X)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (degree (coe_fn (monomial n) a) = ↑n)) (degree_monomial n ha))) (Eq.refl ↑n))

theorem degree_monomial_le {R : Type u} [semiring R] (n : ℕ) (a : R) : degree (coe_fn (monomial n) a) ≤ ↑n := sorry

theorem degree_C_mul_X_pow_le {R : Type u} [semiring R] (n : ℕ) (a : R) : degree (coe_fn C a * X ^ n) ≤ ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (degree (coe_fn C a * X ^ n) ≤ ↑n)) (C_mul_X_pow_eq_monomial a n)))
    (degree_monomial_le n a)

@[simp] theorem nat_degree_C_mul_X_pow {R : Type u} [semiring R] (n : ℕ) (a : R) (ha : a ≠ 0) : nat_degree (coe_fn C a * X ^ n) = n :=
  nat_degree_eq_of_degree_eq_some (degree_C_mul_X_pow n ha)

@[simp] theorem nat_degree_C_mul_X {R : Type u} [semiring R] (a : R) (ha : a ≠ 0) : nat_degree (coe_fn C a * X) = 1 := sorry

@[simp] theorem nat_degree_monomial {R : Type u} [semiring R] (i : ℕ) (r : R) (hr : r ≠ 0) : nat_degree (coe_fn (monomial i) r) = i :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree (coe_fn (monomial i) r) = i)) (Eq.symm (C_mul_X_pow_eq_monomial r i))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree (coe_fn C r * X ^ i) = i)) (nat_degree_C_mul_X_pow i r hr))) (Eq.refl i))

theorem coeff_eq_zero_of_degree_lt {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} (h : degree p < ↑n) : coeff p n = 0 :=
  iff.mp not_not (mt le_degree_of_ne_zero (not_le_of_gt h))

theorem coeff_eq_zero_of_nat_degree_lt {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (h : nat_degree p < n) : coeff p n = 0 := sorry

@[simp] theorem coeff_nat_degree_succ_eq_zero {R : Type u} [semiring R] {p : polynomial R} : coeff p (nat_degree p + 1) = 0 :=
  coeff_eq_zero_of_nat_degree_lt (lt_add_one (nat_degree p))

-- We need the explicit `decidable` argument here because an exotic one shows up in a moment!

theorem ite_le_nat_degree_coeff {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) (I : Decidable (n < 1 + nat_degree p)) : ite (n < 1 + nat_degree p) (coeff p n) 0 = coeff p n := sorry

theorem as_sum_support {R : Type u} [semiring R] (p : polynomial R) : p = finset.sum (finsupp.support p) fun (i : ℕ) => coe_fn (monomial i) (coeff p i) :=
  Eq.symm (finsupp.sum_single p)

theorem as_sum_support_C_mul_X_pow {R : Type u} [semiring R] (p : polynomial R) : p = finset.sum (finsupp.support p) fun (i : ℕ) => coe_fn C (coeff p i) * X ^ i := sorry

/--
We can reexpress a sum over `p.support` as a sum over `range n`,
for any `n` satisfying `p.nat_degree < n`.
-/
theorem sum_over_range' {R : Type u} {S : Type v} [semiring R] [add_comm_monoid S] (p : polynomial R) {f : ℕ → R → S} (h : ∀ (n : ℕ), f n 0 = 0) (n : ℕ) (w : nat_degree p < n) : finsupp.sum p f = finset.sum (finset.range n) fun (a : ℕ) => f a (coeff p a) :=
  finsupp.sum_of_support_subset p (supp_subset_range w) f fun (n_1 : ℕ) (hn : n_1 ∈ finset.range n) => h n_1

/--
We can reexpress a sum over `p.support` as a sum over `range (p.nat_degree + 1)`.
-/
theorem sum_over_range {R : Type u} {S : Type v} [semiring R] [add_comm_monoid S] (p : polynomial R) {f : ℕ → R → S} (h : ∀ (n : ℕ), f n 0 = 0) : finsupp.sum p f = finset.sum (finset.range (nat_degree p + 1)) fun (a : ℕ) => f a (coeff p a) :=
  sum_over_range' p h (nat_degree p + 1) (lt_add_one (nat_degree p))

theorem as_sum_range' {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) (w : nat_degree p < n) : p = finset.sum (finset.range n) fun (i : ℕ) => coe_fn (monomial i) (coeff p i) :=
  Eq.trans (Eq.symm (finsupp.sum_single p)) (sum_over_range' p (fun (n : ℕ) => finsupp.single_zero) n w)

theorem as_sum_range {R : Type u} [semiring R] (p : polynomial R) : p = finset.sum (finset.range (nat_degree p + 1)) fun (i : ℕ) => coe_fn (monomial i) (coeff p i) :=
  Eq.trans (Eq.symm (finsupp.sum_single p)) (sum_over_range p fun (n : ℕ) => finsupp.single_zero)

theorem as_sum_range_C_mul_X_pow {R : Type u} [semiring R] (p : polynomial R) : p = finset.sum (finset.range (nat_degree p + 1)) fun (i : ℕ) => coe_fn C (coeff p i) * X ^ i := sorry

theorem coeff_ne_zero_of_eq_degree {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} (hn : degree p = ↑n) : coeff p n ≠ 0 :=
  fun (h : coeff p n = 0) => iff.mp finsupp.mem_support_iff (finset.mem_of_max hn) h

theorem eq_X_add_C_of_degree_le_one {R : Type u} [semiring R] {p : polynomial R} (h : degree p ≤ 1) : p = coe_fn C (coeff p 1) * X + coe_fn C (coeff p 0) := sorry

theorem eq_X_add_C_of_degree_eq_one {R : Type u} [semiring R] {p : polynomial R} (h : degree p = 1) : p = coe_fn C (leading_coeff p) * X + coe_fn C (coeff p 0) := sorry

theorem eq_X_add_C_of_nat_degree_le_one {R : Type u} [semiring R] {p : polynomial R} (h : nat_degree p ≤ 1) : p = coe_fn C (coeff p 1) * X + coe_fn C (coeff p 0) :=
  eq_X_add_C_of_degree_le_one (degree_le_of_nat_degree_le h)

theorem exists_eq_X_add_C_of_nat_degree_le_one {R : Type u} [semiring R] {p : polynomial R} (h : nat_degree p ≤ 1) : ∃ (a : R), ∃ (b : R), p = coe_fn C a * X + coe_fn C b :=
  Exists.intro (coeff p 1) (Exists.intro (coeff p 0) (eq_X_add_C_of_nat_degree_le_one h))

theorem degree_X_pow_le {R : Type u} [semiring R] (n : ℕ) : degree (X ^ n) ≤ ↑n := sorry

theorem degree_X_le {R : Type u} [semiring R] : degree X ≤ 1 :=
  degree_monomial_le 1 1

theorem nat_degree_X_le {R : Type u} [semiring R] : nat_degree X ≤ 1 :=
  nat_degree_le_of_degree_le degree_X_le

theorem support_C_mul_X_pow {R : Type u} [semiring R] (c : R) (n : ℕ) : finsupp.support (coe_fn C c * X ^ n) ⊆ singleton n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (finsupp.support (coe_fn C c * X ^ n) ⊆ singleton n)) (C_mul_X_pow_eq_monomial c n)))
    finsupp.support_single_subset

theorem mem_support_C_mul_X_pow {R : Type u} [semiring R] {n : ℕ} {a : ℕ} {c : R} (h : a ∈ finsupp.support (coe_fn C c * X ^ n)) : a = n :=
  iff.mp finset.mem_singleton (support_C_mul_X_pow c n h)

theorem card_support_C_mul_X_pow_le_one {R : Type u} [semiring R] {c : R} {n : ℕ} : finset.card (finsupp.support (coe_fn C c * X ^ n)) ≤ 1 := sorry

theorem card_supp_le_succ_nat_degree {R : Type u} [semiring R] (p : polynomial R) : finset.card (finsupp.support p) ≤ nat_degree p + 1 := sorry

theorem le_degree_of_mem_supp {R : Type u} [semiring R] {p : polynomial R} (a : ℕ) : a ∈ finsupp.support p → ↑a ≤ degree p :=
  le_degree_of_ne_zero ∘ iff.mp mem_support_iff_coeff_ne_zero

theorem nonempty_support_iff {R : Type u} [semiring R] {p : polynomial R} : finset.nonempty (finsupp.support p) ↔ p ≠ 0 := sorry

theorem support_C_mul_X_pow_nonzero {R : Type u} [semiring R] {c : R} {n : ℕ} (h : c ≠ 0) : finsupp.support (coe_fn C c * X ^ n) = singleton n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (finsupp.support (coe_fn C c * X ^ n) = singleton n)) (C_mul_X_pow_eq_monomial c n)))
    (finsupp.support_single_ne_zero h)

@[simp] theorem degree_one {R : Type u} [semiring R] [nontrivial R] : degree 1 = 0 :=
  degree_C ((fun (this : 1 ≠ 0) => this) (ne.symm zero_ne_one))

@[simp] theorem degree_X {R : Type u} [semiring R] [nontrivial R] : degree X = 1 :=
  degree_monomial 1 one_ne_zero

@[simp] theorem nat_degree_X {R : Type u} [semiring R] [nontrivial R] : nat_degree X = 1 :=
  nat_degree_eq_of_degree_eq_some degree_X

theorem coeff_mul_X_sub_C {R : Type u} [ring R] {p : polynomial R} {r : R} {a : ℕ} : coeff (p * (X - coe_fn C r)) (a + 1) = coeff p a - coeff p (a + 1) * r := sorry

theorem C_eq_int_cast {R : Type u} [ring R] (n : ℤ) : coe_fn C ↑n = ↑n :=
  ring_hom.map_int_cast C n

@[simp] theorem degree_neg {R : Type u} [ring R] (p : polynomial R) : degree (-p) = degree p := sorry

@[simp] theorem nat_degree_neg {R : Type u} [ring R] (p : polynomial R) : nat_degree (-p) = nat_degree p := sorry

@[simp] theorem nat_degree_int_cast {R : Type u} [ring R] (n : ℤ) : nat_degree ↑n = 0 := sorry

/-- The second-highest coefficient, or 0 for constants -/
def next_coeff {R : Type u} [semiring R] (p : polynomial R) : R :=
  ite (nat_degree p = 0) 0 (coeff p (nat_degree p - 1))

@[simp] theorem next_coeff_C_eq_zero {R : Type u} [semiring R] (c : R) : next_coeff (coe_fn C c) = 0 := sorry

theorem next_coeff_of_pos_nat_degree {R : Type u} [semiring R] (p : polynomial R) (hp : 0 < nat_degree p) : next_coeff p = coeff p (nat_degree p - 1) := sorry

theorem coeff_nat_degree_eq_zero_of_degree_lt {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : degree p < degree q) : coeff p (nat_degree q) = 0 :=
  coeff_eq_zero_of_degree_lt (lt_of_lt_of_le h degree_le_nat_degree)

theorem ne_zero_of_degree_gt {R : Type u} [semiring R] {p : polynomial R} {n : with_bot ℕ} (h : n < degree p) : p ≠ 0 :=
  mt (iff.mpr degree_eq_bot) (ne.symm (ne_of_lt (lt_of_le_of_lt bot_le h)))

theorem eq_C_of_degree_le_zero {R : Type u} [semiring R] {p : polynomial R} (h : degree p ≤ 0) : p = coe_fn C (coeff p 0) := sorry

theorem eq_C_of_degree_eq_zero {R : Type u} [semiring R] {p : polynomial R} (h : degree p = 0) : p = coe_fn C (coeff p 0) :=
  eq_C_of_degree_le_zero (h ▸ le_refl (degree p))

theorem degree_le_zero_iff {R : Type u} [semiring R] {p : polynomial R} : degree p ≤ 0 ↔ p = coe_fn C (coeff p 0) :=
  { mp := eq_C_of_degree_le_zero, mpr := fun (h : p = coe_fn C (coeff p 0)) => Eq.symm h ▸ degree_C_le }

theorem degree_add_le {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) : degree (p + q) ≤ max (degree p) (degree q) := sorry

@[simp] theorem leading_coeff_zero {R : Type u} [semiring R] : leading_coeff 0 = 0 :=
  rfl

@[simp] theorem leading_coeff_eq_zero {R : Type u} [semiring R] {p : polynomial R} : leading_coeff p = 0 ↔ p = 0 := sorry

theorem leading_coeff_eq_zero_iff_deg_eq_bot {R : Type u} [semiring R] {p : polynomial R} : leading_coeff p = 0 ↔ degree p = ⊥ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (leading_coeff p = 0 ↔ degree p = ⊥)) (propext leading_coeff_eq_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (p = 0 ↔ degree p = ⊥)) (propext degree_eq_bot))) (iff.refl (p = 0)))

theorem nat_degree_mem_support_of_nonzero {R : Type u} [semiring R] {p : polynomial R} (H : p ≠ 0) : nat_degree p ∈ finsupp.support p :=
  iff.mpr (finsupp.mem_support_to_fun p (nat_degree p)) (iff.mpr (not_congr leading_coeff_eq_zero) H)

theorem nat_degree_eq_support_max' {R : Type u} [semiring R] {p : polynomial R} (h : p ≠ 0) : nat_degree p = finset.max' (finsupp.support p) (iff.mpr nonempty_support_iff h) := sorry

theorem nat_degree_C_mul_X_pow_le {R : Type u} [semiring R] (a : R) (n : ℕ) : nat_degree (coe_fn C a * X ^ n) ≤ n :=
  iff.mpr nat_degree_le_iff_degree_le (degree_C_mul_X_pow_le n a)

theorem degree_add_eq_left_of_degree_lt {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : degree q < degree p) : degree (p + q) = degree p := sorry

theorem degree_add_eq_right_of_degree_lt {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : degree p < degree q) : degree (p + q) = degree q :=
  eq.mpr (id (Eq._oldrec (Eq.refl (degree (p + q) = degree q)) (add_comm p q)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (degree (q + p) = degree q)) (degree_add_eq_left_of_degree_lt h)))
      (Eq.refl (degree q)))

theorem degree_add_C {R : Type u} {a : R} [semiring R] {p : polynomial R} (hp : 0 < degree p) : degree (p + coe_fn C a) = degree p :=
  Eq.subst (add_comm (coe_fn C a) p) degree_add_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hp)

theorem degree_add_eq_of_leading_coeff_add_ne_zero {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : leading_coeff p + leading_coeff q ≠ 0) : degree (p + q) = max (degree p) (degree q) := sorry

theorem degree_erase_le {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) : degree (finsupp.erase n p) ≤ degree p := sorry

theorem degree_erase_lt {R : Type u} [semiring R] {p : polynomial R} (hp : p ≠ 0) : degree (finsupp.erase (nat_degree p) p) < degree p := sorry

theorem degree_sum_le {R : Type u} [semiring R] {ι : Type u_1} (s : finset ι) (f : ι → polynomial R) : degree (finset.sum s fun (i : ι) => f i) ≤ finset.sup s fun (b : ι) => degree (f b) := sorry

theorem degree_mul_le {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) : degree (p * q) ≤ degree p + degree q := sorry

theorem degree_pow_le {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) : degree (p ^ n) ≤ n •ℕ degree p := sorry

@[simp] theorem leading_coeff_monomial {R : Type u} [semiring R] (a : R) (n : ℕ) : leading_coeff (coe_fn (monomial n) a) = a := sorry

theorem leading_coeff_C_mul_X_pow {R : Type u} [semiring R] (a : R) (n : ℕ) : leading_coeff (coe_fn C a * X ^ n) = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (leading_coeff (coe_fn C a * X ^ n) = a)) (C_mul_X_pow_eq_monomial a n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (leading_coeff (coe_fn (monomial n) a) = a)) (leading_coeff_monomial a n)))
      (Eq.refl a))

@[simp] theorem leading_coeff_C {R : Type u} [semiring R] (a : R) : leading_coeff (coe_fn C a) = a :=
  leading_coeff_monomial a 0

@[simp] theorem leading_coeff_X_pow {R : Type u} [semiring R] (n : ℕ) : leading_coeff (X ^ n) = 1 := sorry

@[simp] theorem leading_coeff_X {R : Type u} [semiring R] : leading_coeff X = 1 := sorry

@[simp] theorem monic_X_pow {R : Type u} [semiring R] (n : ℕ) : monic (X ^ n) :=
  leading_coeff_X_pow n

@[simp] theorem monic_X {R : Type u} [semiring R] : monic X :=
  leading_coeff_X

@[simp] theorem leading_coeff_one {R : Type u} [semiring R] : leading_coeff 1 = 1 :=
  leading_coeff_C 1

@[simp] theorem monic_one {R : Type u} [semiring R] : monic 1 :=
  leading_coeff_C 1

theorem monic.ne_zero {R : Type u_1} [semiring R] [nontrivial R] {p : polynomial R} (hp : monic p) : p ≠ 0 := sorry

theorem monic.ne_zero_of_ne {R : Type u} [semiring R] (h : 0 ≠ 1) {p : polynomial R} (hp : monic p) : p ≠ 0 :=
  monic.ne_zero hp

theorem monic.ne_zero_of_polynomial_ne {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} {r : polynomial R} (hp : monic p) (hne : q ≠ r) : p ≠ 0 :=
  monic.ne_zero hp

theorem leading_coeff_add_of_degree_lt {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : degree p < degree q) : leading_coeff (p + q) = leading_coeff q := sorry

theorem leading_coeff_add_of_degree_eq {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : degree p = degree q) (hlc : leading_coeff p + leading_coeff q ≠ 0) : leading_coeff (p + q) = leading_coeff p + leading_coeff q := sorry

@[simp] theorem coeff_mul_degree_add_degree {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) : coeff (p * q) (nat_degree p + nat_degree q) = leading_coeff p * leading_coeff q := sorry

theorem degree_mul' {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : leading_coeff p * leading_coeff q ≠ 0) : degree (p * q) = degree p + degree q := sorry

theorem degree_mul_monic {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hq : monic q) : degree (p * q) = degree p + degree q := sorry

theorem nat_degree_mul' {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : leading_coeff p * leading_coeff q ≠ 0) : nat_degree (p * q) = nat_degree p + nat_degree q := sorry

theorem leading_coeff_mul' {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : leading_coeff p * leading_coeff q ≠ 0) : leading_coeff (p * q) = leading_coeff p * leading_coeff q := sorry

theorem leading_coeff_pow' {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} : leading_coeff p ^ n ≠ 0 → leading_coeff (p ^ n) = leading_coeff p ^ n := sorry

theorem degree_pow' {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} : leading_coeff p ^ n ≠ 0 → degree (p ^ n) = n •ℕ degree p := sorry

theorem nat_degree_pow' {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (h : leading_coeff p ^ n ≠ 0) : nat_degree (p ^ n) = n * nat_degree p := sorry

theorem leading_coeff_mul_monic {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (hq : monic q) : leading_coeff (p * q) = leading_coeff p := sorry

@[simp] theorem leading_coeff_mul_X_pow {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} : leading_coeff (p * X ^ n) = leading_coeff p :=
  leading_coeff_mul_monic (monic_X_pow n)

@[simp] theorem leading_coeff_mul_X {R : Type u} [semiring R] {p : polynomial R} : leading_coeff (p * X) = leading_coeff p :=
  leading_coeff_mul_monic monic_X

theorem nat_degree_mul_le {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} : nat_degree (p * q) ≤ nat_degree p + nat_degree q := sorry

theorem subsingleton_of_monic_zero {R : Type u} [semiring R] (h : monic 0) : (∀ (p q : polynomial R), p = q) ∧ ∀ (a b : R), a = b := sorry

theorem zero_le_degree_iff {R : Type u} [semiring R] {p : polynomial R} : 0 ≤ degree p ↔ p ≠ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ degree p ↔ p ≠ 0)) (ne.def p 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ degree p ↔ ¬p = 0)) (Eq.symm (propext degree_eq_bot))))
      (option.cases_on (degree p) (of_as_true trivial) fun (val : ℕ) => of_as_true trivial))

theorem degree_nonneg_iff_ne_zero {R : Type u} [semiring R] {p : polynomial R} : 0 ≤ degree p ↔ p ≠ 0 := sorry

theorem nat_degree_eq_zero_iff_degree_le_zero {R : Type u} [semiring R] {p : polynomial R} : nat_degree p = 0 ↔ degree p ≤ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree p = 0 ↔ degree p ≤ 0)) (Eq.symm (propext nonpos_iff_eq_zero))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree p ≤ 0 ↔ degree p ≤ 0)) (propext nat_degree_le_iff_degree_le)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (degree p ≤ ↑0 ↔ degree p ≤ 0)) with_bot.coe_zero)) (iff.refl (degree p ≤ 0))))

theorem degree_le_iff_coeff_zero {R : Type u} [semiring R] (f : polynomial R) (n : with_bot ℕ) : degree f ≤ n ↔ ∀ (m : ℕ), n < ↑m → coeff f m = 0 := sorry

theorem degree_lt_iff_coeff_zero {R : Type u} [semiring R] (f : polynomial R) (n : ℕ) : degree f < ↑n ↔ ∀ (m : ℕ), n ≤ m → coeff f m = 0 := sorry

theorem degree_lt_degree_mul_X {R : Type u} [semiring R] {p : polynomial R} (hp : p ≠ 0) : degree p < degree (p * X) := sorry

theorem nat_degree_pos_iff_degree_pos {R : Type u} [semiring R] {p : polynomial R} : 0 < nat_degree p ↔ 0 < degree p :=
  lt_iff_lt_of_le_iff_le nat_degree_le_iff_degree_le

theorem eq_C_of_nat_degree_le_zero {R : Type u} [semiring R] {p : polynomial R} (h : nat_degree p ≤ 0) : p = coe_fn C (coeff p 0) :=
  eq_C_of_degree_le_zero (degree_le_of_nat_degree_le h)

theorem eq_C_of_nat_degree_eq_zero {R : Type u} [semiring R] {p : polynomial R} (h : nat_degree p = 0) : p = coe_fn C (coeff p 0) :=
  eq_C_of_nat_degree_le_zero (eq.le h)

@[simp] theorem degree_X_pow {R : Type u} [semiring R] [nontrivial R] (n : ℕ) : degree (X ^ n) = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (degree (X ^ n) = ↑n)) (X_pow_eq_monomial n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (degree (coe_fn (monomial n) 1) = ↑n)) (degree_monomial n one_ne_zero)))
      (Eq.refl ↑n))

@[simp] theorem nat_degree_X_pow {R : Type u} [semiring R] [nontrivial R] (n : ℕ) : nat_degree (X ^ n) = n :=
  nat_degree_eq_of_degree_eq_some (degree_X_pow n)

theorem not_is_unit_X {R : Type u} [semiring R] [nontrivial R] : ¬is_unit X := sorry

@[simp] theorem degree_mul_X {R : Type u} [semiring R] [nontrivial R] {p : polynomial R} : degree (p * X) = degree p + 1 := sorry

@[simp] theorem degree_mul_X_pow {R : Type u} {n : ℕ} [semiring R] [nontrivial R] {p : polynomial R} : degree (p * X ^ n) = degree p + ↑n := sorry

theorem degree_sub_le {R : Type u} [ring R] (p : polynomial R) (q : polynomial R) : degree (p - q) ≤ max (degree p) (degree q) := sorry

theorem degree_sub_lt {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} (hd : degree p = degree q) (hp0 : p ≠ 0) (hlc : leading_coeff p = leading_coeff q) : degree (p - q) < degree p := sorry

theorem nat_degree_X_sub_C_le {R : Type u} [ring R] {r : R} : nat_degree (X - coe_fn C r) ≤ 1 :=
  iff.mpr nat_degree_le_iff_degree_le
    (le_trans (degree_sub_le X (coe_fn C r))
      (max_le degree_X_le (le_trans degree_C_le (iff.mpr with_bot.coe_le_coe zero_le_one))))

theorem degree_sum_fin_lt {R : Type u} [ring R] {n : ℕ} (f : fin n → R) : degree (finset.sum finset.univ fun (i : fin n) => coe_fn C (f i) * X ^ ↑i) < ↑n := sorry

theorem degree_sub_eq_left_of_degree_lt {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} (h : degree q < degree p) : degree (p - q) = degree p := sorry

theorem degree_sub_eq_right_of_degree_lt {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} (h : degree p < degree q) : degree (p - q) = degree q := sorry

@[simp] theorem degree_X_sub_C {R : Type u} [nontrivial R] [ring R] (a : R) : degree (X - coe_fn C a) = 1 := sorry

@[simp] theorem nat_degree_X_sub_C {R : Type u} [nontrivial R] [ring R] (x : R) : nat_degree (X - coe_fn C x) = 1 :=
  nat_degree_eq_of_degree_eq_some (degree_X_sub_C x)

@[simp] theorem next_coeff_X_sub_C {R : Type u} [nontrivial R] [ring R] (c : R) : next_coeff (X - coe_fn C c) = -c := sorry

theorem degree_X_pow_sub_C {R : Type u} [nontrivial R] [ring R] {n : ℕ} (hn : 0 < n) (a : R) : degree (X ^ n - coe_fn C a) = ↑n := sorry

theorem X_pow_sub_C_ne_zero {R : Type u} [nontrivial R] [ring R] {n : ℕ} (hn : 0 < n) (a : R) : X ^ n - coe_fn C a ≠ 0 := sorry

theorem X_sub_C_ne_zero {R : Type u} [nontrivial R] [ring R] (r : R) : X - coe_fn C r ≠ 0 :=
  pow_one X ▸ X_pow_sub_C_ne_zero zero_lt_one r

theorem nat_degree_X_pow_sub_C {R : Type u} [nontrivial R] [ring R] {n : ℕ} (hn : 0 < n) {r : R} : nat_degree (X ^ n - coe_fn C r) = n := sorry

@[simp] theorem degree_mul {R : Type u} [comm_semiring R] [no_zero_divisors R] {p : polynomial R} {q : polynomial R} : degree (p * q) = degree p + degree q := sorry

@[simp] theorem degree_pow {R : Type u} [comm_semiring R] [no_zero_divisors R] [nontrivial R] (p : polynomial R) (n : ℕ) : degree (p ^ n) = n •ℕ degree p := sorry

@[simp] theorem leading_coeff_mul {R : Type u} [comm_semiring R] [no_zero_divisors R] (p : polynomial R) (q : polynomial R) : leading_coeff (p * q) = leading_coeff p * leading_coeff q := sorry

@[simp] theorem leading_coeff_X_add_C {R : Type u} [comm_semiring R] [no_zero_divisors R] [nontrivial R] (a : R) (b : R) (ha : a ≠ 0) : leading_coeff (coe_fn C a * X + coe_fn C b) = a := sorry

/-- `polynomial.leading_coeff` bundled as a `monoid_hom` when `R` has `no_zero_divisors`, and thus
  `leading_coeff` is multiplicative -/
def leading_coeff_hom {R : Type u} [comm_semiring R] [no_zero_divisors R] : polynomial R →* R :=
  monoid_hom.mk leading_coeff sorry leading_coeff_mul

@[simp] theorem leading_coeff_hom_apply {R : Type u} [comm_semiring R] [no_zero_divisors R] (p : polynomial R) : coe_fn leading_coeff_hom p = leading_coeff p :=
  rfl

@[simp] theorem leading_coeff_pow {R : Type u} [comm_semiring R] [no_zero_divisors R] (p : polynomial R) (n : ℕ) : leading_coeff (p ^ n) = leading_coeff p ^ n :=
  monoid_hom.map_pow leading_coeff_hom p n


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import topology.compact_open
import topology.uniform_space.uniform_convergence

/-!
# Compact convergence (uniform convergence on compact sets)

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

Given a topological space `α` and a uniform space `β` (e.g., a metric space or a topological group),
the space of continuous maps `C(α, β)` carries a natural uniform space structure. We define this
uniform space structure in this file and also prove the following properties of the topology it
induces on `C(α, β)`:

 1. Given a sequence of continuous functions `Fₙ : α → β` together with some continuous `f : α → β`,
    then `Fₙ` converges to `f` as a sequence in `C(α, β)` iff `Fₙ` converges to `f` uniformly on
    each compact subset `K` of `α`.
 2. Given `Fₙ` and `f` as above and suppose `α` is locally compact, then `Fₙ` converges to `f` iff
    `Fₙ` converges to `f` locally uniformly.
 3. The topology coincides with the compact-open topology.

Property 1 is essentially true by definition, 2 follows from basic results about uniform
convergence, but 3 requires a little work and uses the Lebesgue number lemma.

## The uniform space structure

Given subsets `K ⊆ α` and `V ⊆ β × β`, let `E(K, V) ⊆ C(α, β) × C(α, β)` be the set of pairs of
continuous functions `α → β` which are `V`-close on `K`:
$$
  E(K, V) = \{ (f, g) | ∀ (x ∈ K), (f x, g x) ∈ V \}.
$$
Fixing some `f ∈ C(α, β)`, let `N(K, V, f) ⊆ C(α, β)` be the set of continuous functions `α → β`
which are `V`-close to `f` on `K`:
$$
  N(K, V, f) = \{ g | ∀ (x ∈ K), (f x, g x) ∈ V \}.
$$
Using this notation we can describe the uniform space structure and the topology it induces.
Specifically:
 *  A subset `X ⊆ C(α, β) × C(α, β)` is an entourage for the uniform space structure on `C(α, β)`
    iff there exists a compact `K` and entourage `V` such that `E(K, V) ⊆ X`.
 *  A subset `Y ⊆ C(α, β)` is a neighbourhood of `f` iff there exists a compact `K` and entourage
    `V` such that `N(K, V, f) ⊆ Y`.

The topology on `C(α, β)` thus has a natural subbasis (the compact-open subbasis) and a natural
neighbourhood basis (the compact-convergence neighbourhood basis).

## Main definitions / results

 * `compact_open_eq_compact_convergence`: the compact-open topology is equal to the
   compact-convergence topology.
 * `compact_convergence_uniform_space`: the uniform space structure on `C(α, β)`.
 * `mem_compact_convergence_entourage_iff`: a characterisation of the entourages of `C(α, β)`.
 * `tendsto_iff_forall_compact_tendsto_uniformly_on`: a sequence of functions `Fₙ` in `C(α, β)`
   converges to some `f` iff `Fₙ` converges to `f` uniformly on each compact subset `K` of `α`.
 * `tendsto_iff_tendsto_locally_uniformly`: on a locally compact space, a sequence of functions
   `Fₙ` in `C(α, β)` converges to some `f` iff `Fₙ` converges to `f` locally uniformly.
 * `tendsto_iff_tendsto_uniformly`: on a compact space, a sequence of functions `Fₙ` in `C(α, β)`
   converges to some `f` iff `Fₙ` converges to `f` uniformly.

## Implementation details

We use the forgetful inheritance pattern (see Note [forgetful inheritance]) to make the topology
of the uniform space structure on `C(α, β)` definitionally equal to the compact-open topology.

## TODO

 * When `β` is a metric space, there is natural basis for the compact-convergence topology
   parameterised by triples `(K, ε, f)` for a real number `ε > 0`.
 * When `α` is compact and `β` is a metric space, the compact-convergence topology (and thus also
   the compact-open topology) is metrisable.
 * Results about uniformly continuous functions `γ → C(α, β)` and uniform limits of sequences
   `ι → γ → C(α, β)`.
-/

universes u₁ u₂ u₃

open_locale filter uniformity topology
open uniform_space set filter

variables {α : Type u₁} {β : Type u₂} [topological_space α] [uniform_space β]
variables (K : set α) (V : set (β × β)) (f : C(α, β))

namespace continuous_map

/-- Given `K ⊆ α`, `V ⊆ β × β`, and `f : C(α, β)`, we define `compact_conv_nhd K V f` to be the set
of `g : C(α, β)` that are `V`-close to `f` on `K`. -/
def compact_conv_nhd : set C(α, β) := { g | ∀ (x ∈ K), (f x, g x) ∈ V }

variables {K V}

lemma self_mem_compact_conv_nhd (hV : V ∈ 𝓤 β) : f ∈ compact_conv_nhd K V f :=
λ x hx, refl_mem_uniformity hV

@[mono] lemma compact_conv_nhd_mono {V' : set (β × β)} (hV' : V' ⊆ V) :
  compact_conv_nhd K V' f ⊆ compact_conv_nhd K V f :=
λ x hx a ha, hV' (hx a ha)

lemma compact_conv_nhd_mem_comp {g₁ g₂ : C(α, β)} {V' : set (β × β)}
  (hg₁ : g₁ ∈ compact_conv_nhd K V f) (hg₂ : g₂ ∈ compact_conv_nhd K V' g₁) :
  g₂ ∈ compact_conv_nhd K (V ○ V') f :=
λ x hx, ⟨g₁ x, hg₁ x hx, hg₂ x hx⟩

/-- A key property of `compact_conv_nhd`. It allows us to apply
`topological_space.nhds_mk_of_nhds_filter_basis` below. -/
lemma compact_conv_nhd_nhd_basis (hV : V ∈ 𝓤 β) :
  ∃ (V' ∈ 𝓤 β), V' ⊆ V ∧ ∀ (g ∈ compact_conv_nhd K V' f),
    compact_conv_nhd K V' g ⊆ compact_conv_nhd K V f :=
begin
  obtain ⟨V', h₁, h₂⟩ := comp_mem_uniformity_sets hV,
  exact ⟨V', h₁, subset.trans (subset_comp_self_of_mem_uniformity h₁) h₂, λ g hg g' hg',
    compact_conv_nhd_mono f h₂ (compact_conv_nhd_mem_comp f hg hg')⟩,
end

lemma compact_conv_nhd_subset_inter (K₁ K₂ : set α) (V₁ V₂ : set (β × β)) :
  compact_conv_nhd (K₁ ∪ K₂) (V₁ ∩ V₂) f ⊆
  compact_conv_nhd K₁ V₁ f ∩ compact_conv_nhd K₂ V₂ f :=
λ g hg, ⟨λ x hx, mem_of_mem_inter_left (hg x (mem_union_left K₂ hx)),
         λ x hx, mem_of_mem_inter_right (hg x (mem_union_right K₁ hx))⟩

lemma compact_conv_nhd_compact_entourage_nonempty :
  { KV : set α × set (β × β) | is_compact KV.1 ∧ KV.2 ∈ 𝓤 β }.nonempty :=
⟨⟨∅, univ⟩, is_compact_empty, filter.univ_mem⟩

lemma compact_conv_nhd_filter_is_basis : filter.is_basis
  (λ (KV : set α × set (β × β)), is_compact KV.1 ∧ KV.2 ∈ 𝓤 β)
  (λ KV, compact_conv_nhd KV.1 KV.2 f) :=
{ nonempty := compact_conv_nhd_compact_entourage_nonempty,
  inter    :=
    begin
      rintros ⟨K₁, V₁⟩ ⟨K₂, V₂⟩ ⟨hK₁, hV₁⟩ ⟨hK₂, hV₂⟩,
      exact ⟨⟨K₁ ∪ K₂, V₁ ∩ V₂⟩, ⟨hK₁.union hK₂, filter.inter_mem hV₁ hV₂⟩,
        compact_conv_nhd_subset_inter f K₁ K₂ V₁ V₂⟩,
    end, }

/-- A filter basis for the neighbourhood filter of a point in the compact-convergence topology. -/
def compact_convergence_filter_basis (f : C(α, β)) : filter_basis C(α, β) :=
(compact_conv_nhd_filter_is_basis f).filter_basis

lemma mem_compact_convergence_nhd_filter (Y : set C(α, β)) :
  Y ∈ (compact_convergence_filter_basis f).filter ↔
  ∃ (K : set α) (V : set (β × β)) (hK : is_compact K) (hV : V ∈ 𝓤 β), compact_conv_nhd K V f ⊆ Y :=
begin
  split,
  { rintros ⟨X, ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩, hY⟩,
    exact ⟨K, V, hK, hV, hY⟩, },
  { rintros ⟨K, V, hK, hV, hY⟩,
    exact ⟨compact_conv_nhd K V f, ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩, hY⟩, },
end

/-- The compact-convergence topology. In fact, see `compact_open_eq_compact_convergence` this is
the same as the compact-open topology. This definition is thus an auxiliary convenience definition
and is unlikely to be of direct use. -/
def compact_convergence_topology : topological_space C(α, β) :=
topological_space.mk_of_nhds $ λ f, (compact_convergence_filter_basis f).filter

lemma nhds_compact_convergence :
  @nhds _ compact_convergence_topology f = (compact_convergence_filter_basis f).filter :=
begin
  rw topological_space.nhds_mk_of_nhds_filter_basis;
  rintros g - ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩,
  { exact self_mem_compact_conv_nhd g hV, },
  { obtain ⟨V', hV', h₁, h₂⟩ := compact_conv_nhd_nhd_basis g hV,
    exact ⟨compact_conv_nhd K V' g, ⟨⟨K, V'⟩, ⟨hK, hV'⟩, rfl⟩, compact_conv_nhd_mono g h₁,
      λ g' hg', ⟨compact_conv_nhd K V' g', ⟨⟨K, V'⟩, ⟨hK, hV'⟩, rfl⟩, h₂ g' hg'⟩⟩, },
end

lemma has_basis_nhds_compact_convergence :
  has_basis (@nhds _ compact_convergence_topology f)
  (λ (p : set α × set (β × β)), is_compact p.1 ∧ p.2 ∈ 𝓤 β) (λ p, compact_conv_nhd p.1 p.2 f) :=
(nhds_compact_convergence f).symm ▸ (compact_conv_nhd_filter_is_basis f).has_basis

/-- This is an auxiliary lemma and is unlikely to be of direct use outside of this file. See
`tendsto_iff_forall_compact_tendsto_uniformly_on` below for the useful version where the topology
is picked up via typeclass inference. -/
lemma tendsto_iff_forall_compact_tendsto_uniformly_on'
  {ι : Type u₃} {p : filter ι} {F : ι → C(α, β)} :
  filter.tendsto F p (@nhds _ compact_convergence_topology f) ↔
  ∀ K, is_compact K → tendsto_uniformly_on (λ i a, F i a) f p K :=
begin
  simp only [(has_basis_nhds_compact_convergence f).tendsto_right_iff, tendsto_uniformly_on,
    and_imp, prod.forall],
  refine forall_congr (λ K, _),
  rw forall_swap,
  exact forall₃_congr (λ hK V hV, iff.rfl),
end

/-- Any point of `compact_open.gen K U` is also an interior point wrt the topology of compact
convergence.

The topology of compact convergence is thus at least as fine as the compact-open topology. -/
lemma compact_conv_nhd_subset_compact_open (hK : is_compact K) {U : set β} (hU : is_open U)
  (hf : f ∈ compact_open.gen K U) :
  ∃ (V ∈ 𝓤 β), is_open V ∧ compact_conv_nhd K V f ⊆ compact_open.gen K U :=
begin
  obtain ⟨V, hV₁, hV₂, hV₃⟩ := lebesgue_number_of_compact_open (hK.image f.continuous) hU hf,
  refine ⟨V, hV₁, hV₂, _⟩,
  rintros g hg _ ⟨x, hx, rfl⟩,
  exact hV₃ (f x) ⟨x, hx, rfl⟩ (hg x hx),
end

/-- The point `f` in `compact_conv_nhd K V f` is also an interior point wrt the compact-open
topology.

Since `compact_conv_nhd K V f` are a neighbourhood basis at `f` for each `f`, it follows that
the compact-open topology is at least as fine as the topology of compact convergence. -/
lemma Inter_compact_open_gen_subset_compact_conv_nhd (hK : is_compact K) (hV : V ∈ 𝓤 β) :
  ∃ (ι : Sort (u₁ + 1)) [fintype ι]
  (C : ι → set α) (hC : ∀ i, is_compact (C i))
  (U : ι → set β) (hU : ∀ i, is_open (U i)),
  (f ∈ ⋂ i, compact_open.gen (C i) (U i)) ∧
  (⋂ i, compact_open.gen (C i) (U i)) ⊆ compact_conv_nhd K V f :=
begin
  obtain ⟨W, hW₁, hW₄, hW₂, hW₃⟩ := comp_open_symm_mem_uniformity_sets hV,
  obtain ⟨Z, hZ₁, hZ₄, hZ₂, hZ₃⟩ := comp_open_symm_mem_uniformity_sets hW₁,
  let U : α → set α := λ x, f⁻¹' (ball (f x) Z),
  have hU : ∀ x, is_open (U x) := λ x, f.continuous.is_open_preimage _ (is_open_ball _ hZ₄),
  have hUK : K ⊆ ⋃ (x : K), U (x : K),
  { intros x hx,
    simp only [exists_prop, mem_Union, Union_coe_set, mem_preimage],
    exact ⟨(⟨x, hx⟩ : K), by simp [hx, mem_ball_self (f x) hZ₁]⟩, },
  obtain ⟨t, ht⟩ := hK.elim_finite_subcover _ (λ (x : K), hU x.val) hUK,
  let C : t → set α := λ i, K ∩ closure (U ((i : K) : α)),
  have hC : K ⊆ ⋃ i, C i,
  { rw [← K.inter_Union, subset_inter_iff],
    refine ⟨subset.rfl, ht.trans _⟩,
    simp only [set_coe.forall, subtype.coe_mk, Union_subset_iff],
    exact λ x hx₁ hx₂, subset_Union_of_subset (⟨_, hx₂⟩ : t) (by simp [subset_closure]) },
  have hfC : ∀ (i : t), C i ⊆ f ⁻¹' ball (f ((i : K) : α)) W,
  { simp only [← image_subset_iff, ← mem_preimage],
    rintros ⟨⟨x, hx₁⟩, hx₂⟩,
    have hZW : closure (ball (f x) Z) ⊆ ball (f x) W,
    { intros y hy,
      obtain ⟨z, hz₁, hz₂⟩ := uniform_space.mem_closure_iff_ball.mp hy hZ₁,
      exact ball_mono hZ₃ _ (mem_ball_comp hz₂ ((mem_ball_symmetry hZ₂).mp hz₁)), },
    calc f '' (K ∩ closure (U x)) ⊆ f '' (closure (U x)) : image_subset _ (inter_subset_right _ _)
                              ... ⊆ closure (f '' (U x)) : f.continuous.continuous_on.image_closure
                              ... ⊆ closure (ball (f x) Z) : by { apply closure_mono, simp, }
                              ... ⊆ ball (f x) W : hZW, },
  refine ⟨t, t.fintype_coe_sort, C,
          λ i, hK.inter_right is_closed_closure,
          λ i, ball (f ((i : K) : α)) W,
          λ i, is_open_ball _ hW₄,
          by simp [compact_open.gen, hfC],
          λ g hg x hx, hW₃ (mem_comp_rel.mpr _)⟩,
  simp only [mem_Inter, compact_open.gen, mem_set_of_eq, image_subset_iff] at hg,
  obtain ⟨y, hy⟩ := mem_Union.mp (hC hx),
  exact ⟨f y, (mem_ball_symmetry hW₂).mp (hfC y hy), mem_preimage.mp (hg y hy)⟩,
end

/-- The compact-open topology is equal to the compact-convergence topology. -/
lemma compact_open_eq_compact_convergence :
  continuous_map.compact_open = (compact_convergence_topology : topological_space C(α, β)) :=
begin
  rw [compact_convergence_topology, continuous_map.compact_open],
  refine le_antisymm _ _,
  { refine λ X hX, is_open_iff_forall_mem_open.mpr (λ f hf, _),
    have hXf : X ∈ (compact_convergence_filter_basis f).filter,
    { rw ← nhds_compact_convergence,
      exact @is_open.mem_nhds C(α, β) compact_convergence_topology _ _ hX hf, },
    obtain ⟨-, ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩, hXf⟩ := hXf,
    obtain ⟨ι, hι, C, hC, U, hU, h₁, h₂⟩ := Inter_compact_open_gen_subset_compact_conv_nhd f hK hV,
    haveI := hι,
    exact ⟨⋂ i, compact_open.gen (C i) (U i), h₂.trans hXf,
      is_open_Inter (λ i, continuous_map.is_open_gen (hC i) (hU i)), h₁⟩, },
  { simp only [topological_space.le_generate_from_iff_subset_is_open, and_imp, exists_prop,
      forall_exists_index, set_of_subset_set_of],
    rintros - K hK U hU rfl f hf,
    obtain ⟨V, hV, hV', hVf⟩ := compact_conv_nhd_subset_compact_open f hK hU hf,
    exact filter.mem_of_superset (filter_basis.mem_filter_of_mem _ ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩) hVf, },
end

/-- The filter on `C(α, β) × C(α, β)` which underlies the uniform space structure on `C(α, β)`. -/
def compact_convergence_uniformity : filter (C(α, β) × C(α, β)) :=
⨅ KV ∈ { KV : set α × set (β × β) | is_compact KV.1 ∧ KV.2 ∈ 𝓤 β },
𝓟 { fg : C(α, β) × C(α, β) | ∀ (x : α), x ∈ KV.1 → (fg.1 x, fg.2 x) ∈ KV.2 }

lemma has_basis_compact_convergence_uniformity_aux :
  has_basis (@compact_convergence_uniformity α β _ _)
    (λ p : set α × set (β × β), is_compact p.1 ∧ p.2 ∈ 𝓤 β)
    (λ p, { fg : C(α, β) × C(α, β) | ∀ x ∈ p.1, (fg.1 x, fg.2 x) ∈ p.2 }) :=
begin
  refine filter.has_basis_binfi_principal _ compact_conv_nhd_compact_entourage_nonempty,
  rintros ⟨K₁, V₁⟩ ⟨hK₁, hV₁⟩ ⟨K₂, V₂⟩ ⟨hK₂, hV₂⟩,
  refine ⟨⟨K₁ ∪ K₂, V₁ ∩ V₂⟩, ⟨hK₁.union hK₂, filter.inter_mem hV₁ hV₂⟩, _⟩,
  simp only [le_eq_subset, prod.forall, set_of_subset_set_of, ge_iff_le, order.preimage,
      ← forall_and_distrib, mem_inter_iff, mem_union],
  exact λ f g, forall_imp (λ x, by tauto!),
end

/-- An intermediate lemma. Usually `mem_compact_convergence_entourage_iff` is more useful. -/
lemma mem_compact_convergence_uniformity (X : set (C(α, β) × C(α, β))) :
  X ∈ @compact_convergence_uniformity α β _ _ ↔
  ∃ (K : set α) (V : set (β × β)) (hK : is_compact K) (hV : V ∈ 𝓤 β),
    { fg : C(α, β) × C(α, β) | ∀ x ∈ K, (fg.1 x, fg.2 x) ∈ V } ⊆ X :=
by simp only [has_basis_compact_convergence_uniformity_aux.mem_iff, exists_prop, prod.exists,
  and_assoc]

/-- Note that we ensure the induced topology is definitionally the compact-open topology. -/
instance compact_convergence_uniform_space : uniform_space C(α, β) :=
{ uniformity := compact_convergence_uniformity,
  refl :=
    begin
      simp only [compact_convergence_uniformity, and_imp, filter.le_principal_iff, prod.forall,
        filter.mem_principal, mem_set_of_eq, le_infi_iff, id_rel_subset],
      exact λ K V hK hV f x hx, refl_mem_uniformity hV,
    end,
  symm :=
    begin
      simp only [compact_convergence_uniformity, and_imp, prod.forall, mem_set_of_eq, prod.fst_swap,
        filter.tendsto_principal, prod.snd_swap, filter.tendsto_infi],
      intros K V hK hV,
      obtain ⟨V', hV', hsymm, hsub⟩ := symm_of_uniformity hV,
      let X := { fg : C(α, β) × C(α, β) | ∀ (x : α), x ∈ K → (fg.1 x, fg.2 x) ∈ V' },
      have hX : X ∈ compact_convergence_uniformity :=
        (mem_compact_convergence_uniformity X).mpr ⟨K, V', hK, hV', by simp⟩,
      exact filter.eventually_of_mem hX (λ fg hfg x hx, hsub (hsymm _ _ (hfg x hx))),
    end,
  comp := λ X hX,
    begin
      obtain ⟨K, V, hK, hV, hX⟩ := (mem_compact_convergence_uniformity X).mp hX,
      obtain ⟨V', hV', hcomp⟩ := comp_mem_uniformity_sets hV,
      let h := λ (s : set (C(α, β) × C(α, β))), s ○ s,
      suffices : h {fg : C(α, β) × C(α, β) | ∀ (x ∈ K), (fg.1 x, fg.2 x) ∈ V'} ∈
                 compact_convergence_uniformity.lift' h,
      { apply filter.mem_of_superset this,
        rintros ⟨f, g⟩ ⟨z, hz₁, hz₂⟩,
        refine hX (λ x hx, hcomp _),
        exact ⟨z x, hz₁ x hx, hz₂ x hx⟩, },
      apply filter.mem_lift',
      exact (mem_compact_convergence_uniformity _).mpr ⟨K, V', hK, hV', subset.refl _⟩,
    end,
  is_open_uniformity :=
    begin
      rw compact_open_eq_compact_convergence,
      refine λ Y, forall₂_congr (λ f hf, _),
      simp only [mem_compact_convergence_nhd_filter, mem_compact_convergence_uniformity,
        prod.forall, set_of_subset_set_of, compact_conv_nhd],
      refine exists₄_congr (λ K V hK hV, ⟨_, λ hY g hg, hY f g hg rfl⟩),
      rintros hY g₁ g₂ hg₁ rfl,
      exact hY hg₁,
    end }

lemma mem_compact_convergence_entourage_iff (X : set (C(α, β) × C(α, β))) :
  X ∈ 𝓤 C(α, β) ↔ ∃ (K : set α) (V : set (β × β)) (hK : is_compact K) (hV : V ∈ 𝓤 β),
    { fg : C(α, β) × C(α, β) | ∀ x ∈ K, (fg.1 x, fg.2 x) ∈ V } ⊆ X :=
mem_compact_convergence_uniformity X

lemma has_basis_compact_convergence_uniformity :
  has_basis (𝓤 C(α, β)) (λ p : set α × set (β × β), is_compact p.1 ∧ p.2 ∈ 𝓤 β)
            (λ p, { fg : C(α, β) × C(α, β) | ∀ x ∈ p.1, (fg.1 x, fg.2 x) ∈ p.2 }) :=
has_basis_compact_convergence_uniformity_aux

lemma _root_.filter.has_basis.compact_convergence_uniformity {ι : Type*} {pi : ι → Prop}
  {s : ι → set (β × β)} (h : (𝓤 β).has_basis pi s) :
  has_basis (𝓤 C(α, β)) (λ p : set α × ι, is_compact p.1 ∧ pi p.2)
    (λ p, { fg : C(α, β) × C(α, β) | ∀ x ∈ p.1, (fg.1 x, fg.2 x) ∈ s p.2 }) :=
begin
  refine has_basis_compact_convergence_uniformity.to_has_basis _ _,
  { rintro ⟨t₁, t₂⟩ ⟨h₁, h₂⟩,
    rcases h.mem_iff.1 h₂ with ⟨i, hpi, hi⟩,
    exact ⟨(t₁, i), ⟨h₁, hpi⟩, λ fg hfg x hx, hi (hfg _ hx)⟩ },
  { rintro ⟨t, i⟩ ⟨ht, hi⟩,
    exact ⟨(t, s i), ⟨ht, h.mem_of_mem hi⟩, subset.rfl⟩ }
end

variables {ι : Type u₃} {p : filter ι} {F : ι → C(α, β)} {f}

lemma tendsto_iff_forall_compact_tendsto_uniformly_on :
  tendsto F p (𝓝 f) ↔ ∀ K, is_compact K → tendsto_uniformly_on (λ i a, F i a) f p K :=
by rw [compact_open_eq_compact_convergence, tendsto_iff_forall_compact_tendsto_uniformly_on']

/-- Locally uniform convergence implies convergence in the compact-open topology. -/
lemma tendsto_of_tendsto_locally_uniformly
  (h : tendsto_locally_uniformly (λ i a, F i a) f p) : tendsto F p (𝓝 f) :=
begin
  rw tendsto_iff_forall_compact_tendsto_uniformly_on,
  intros K hK,
  rw ← tendsto_locally_uniformly_on_iff_tendsto_uniformly_on_of_compact hK,
  exact h.tendsto_locally_uniformly_on,
end

/-- If every point has a compact neighbourhood, then convergence in the compact-open topology
implies locally uniform convergence.

See also `tendsto_iff_tendsto_locally_uniformly`, especially for T2 spaces. -/
lemma tendsto_locally_uniformly_of_tendsto
  (hα : ∀ x : α, ∃ n, is_compact n ∧ n ∈ 𝓝 x) (h : tendsto F p (𝓝 f)) :
  tendsto_locally_uniformly (λ i a, F i a) f p :=
begin
  rw tendsto_iff_forall_compact_tendsto_uniformly_on at h,
  intros V hV x,
  obtain ⟨n, hn₁, hn₂⟩ := hα x,
  exact ⟨n, hn₂, h n hn₁ V hV⟩,
end

/-- Convergence in the compact-open topology is the same as locally uniform convergence on a locally
compact space.

For non-T2 spaces, the assumption `locally_compact_space α` is stronger than we need and in fact
the `←` direction is true unconditionally. See `tendsto_locally_uniformly_of_tendsto` and
`tendsto_of_tendsto_locally_uniformly` for versions requiring weaker hypotheses. -/
lemma tendsto_iff_tendsto_locally_uniformly [locally_compact_space α] :
  tendsto F p (𝓝 f) ↔ tendsto_locally_uniformly (λ i a, F i a) f p :=
⟨tendsto_locally_uniformly_of_tendsto exists_compact_mem_nhds, tendsto_of_tendsto_locally_uniformly⟩

section compact_domain

variables [compact_space α]

lemma has_basis_compact_convergence_uniformity_of_compact :
  has_basis (𝓤 C(α, β)) (λ V : set (β × β), V ∈ 𝓤 β)
            (λ V, { fg : C(α, β) × C(α, β) | ∀ x, (fg.1 x, fg.2 x) ∈ V }) :=
has_basis_compact_convergence_uniformity.to_has_basis
  (λ p hp, ⟨p.2, hp.2, λ fg hfg x hx, hfg x⟩)
  (λ V hV, ⟨⟨univ, V⟩, ⟨is_compact_univ, hV⟩, λ fg hfg x, hfg x (mem_univ x)⟩)

/-- Convergence in the compact-open topology is the same as uniform convergence for sequences of
continuous functions on a compact space. -/
lemma tendsto_iff_tendsto_uniformly :
  tendsto F p (𝓝 f) ↔ tendsto_uniformly (λ i a, F i a) f p :=
begin
  rw [tendsto_iff_forall_compact_tendsto_uniformly_on, ← tendsto_uniformly_on_univ],
  exact ⟨λ h, h univ is_compact_univ, λ h K hK, h.mono (subset_univ K)⟩,
end

end compact_domain

end continuous_map


/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import model_theory.semantics

/-!
# Ordered First-Ordered Structures
This file defines ordered first-order languages and structures, as well as their theories.

## Main Definitions
* `first_order.language.order` is the language consisting of a single relation representing `≤`.
* `first_order.language.order_Structure` is the structure on an ordered type, assigning the symbol
representing `≤` to the actual relation `≤`.
* `first_order.language.is_ordered` points out a specific symbol in a language as representing `≤`.
* `first_order.language.is_ordered_structure` indicates that a structure over a
* `first_order.language.Theory.linear_order` and similar define the theories of preorders,
partial orders, and linear orders.
* `first_order.language.Theory.DLO` defines the theory of dense linear orders without endpoints, a
particularly useful example in model theory.

## Main Results
* `partial_order`s model the theory of partial orders, `linear_order`s model the theory of
linear orders, and dense linear orders without endpoints model `Theory.DLO`.

-/

universes u v w w'

namespace first_order
namespace language
open_locale first_order
open Structure

variables {L : language.{u v}} {α : Type w} {M : Type w'} {n : ℕ}

/-- The language consisting of a single relation representing `≤`. -/
protected def order : language :=
language.mk₂ empty empty empty empty unit

namespace order

instance Structure [has_le M] : language.order.Structure M :=
Structure.mk₂ empty.elim empty.elim empty.elim empty.elim (λ _, (≤))

instance : is_relational (language.order) := language.is_relational_mk₂

instance : subsingleton (language.order.relations n) :=
language.subsingleton_mk₂_relations

end order

/-- A language is ordered if it has a symbol representing `≤`. -/
class is_ordered (L : language.{u v}) := (le_symb : L.relations 2)

export is_ordered (le_symb)

section is_ordered

variables [is_ordered L]

/-- Joins two terms `t₁, t₂` in a formula representing `t₁ ≤ t₂`. -/
def term.le (t₁ t₂ : L.term (α ⊕ fin n)) : L.bounded_formula α n :=
le_symb.bounded_formula₂ t₁ t₂

/-- Joins two terms `t₁, t₂` in a formula representing `t₁ < t₂`. -/
def term.lt (t₁ t₂ : L.term (α ⊕ fin n)) : L.bounded_formula α n :=
(t₁.le t₂) ⊓ ∼ (t₂.le t₁)

variable (L)

/-- The language homomorphism sending the unique symbol `≤` of `language.order` to `≤` in an ordered
 language. -/
def order_Lhom : language.order →ᴸ L :=
Lhom.mk₂ empty.elim empty.elim empty.elim empty.elim (λ _, le_symb)

end is_ordered

instance : is_ordered language.order := ⟨unit.star⟩

@[simp] lemma order_Lhom_le_symb [L.is_ordered] :
  (order_Lhom L).on_relation le_symb = (le_symb : L.relations 2) := rfl

@[simp]
lemma order_Lhom_order : order_Lhom language.order = Lhom.id language.order :=
Lhom.funext (subsingleton.elim _ _) (subsingleton.elim _ _)

instance : is_ordered (L.sum language.order) := ⟨sum.inr is_ordered.le_symb⟩

/-- The theory of preorders. -/
protected def Theory.preorder : language.order.Theory :=
{le_symb.reflexive, le_symb.transitive}

/-- The theory of partial orders. -/
protected def Theory.partial_order : language.order.Theory :=
{le_symb.reflexive, le_symb.antisymmetric, le_symb.transitive}

/-- The theory of linear orders. -/
protected def Theory.linear_order : language.order.Theory :=
{le_symb.reflexive, le_symb.antisymmetric, le_symb.transitive, le_symb.total}

/-- A sentence indicating that an order has no top element:
$\forall x, \exists y, \neg y \le x$.   -/
protected def sentence.no_top_order : language.order.sentence := ∀' ∃' ∼ ((&1).le &0)

/-- A sentence indicating that an order has no bottom element:
$\forall x, \exists y, \neg x \le y$. -/
protected def sentence.no_bot_order : language.order.sentence := ∀' ∃' ∼ ((&0).le &1)

/-- A sentence indicating that an order is dense:
$\forall x, \forall y, x < y \to \exists z, x < z \wedge z < y$. -/
protected def sentence.densely_ordered : language.order.sentence :=
∀' ∀' (((&0).lt &1) ⟹ (∃' (((&0).lt &2) ⊓ ((&2).lt &1))))

/-- The theory of dense linear orders without endpoints. -/
protected def Theory.DLO : language.order.Theory :=
Theory.linear_order ∪ {sentence.no_top_order, sentence.no_bot_order, sentence.densely_ordered}

variables (L M)

/-- A structure is ordered if its language has a `≤` symbol whose interpretation is -/
abbreviation is_ordered_structure [is_ordered L] [has_le M] [L.Structure M] : Prop :=
Lhom.is_expansion_on (order_Lhom L) M

variables {L M}

@[simp] lemma is_ordered_structure_iff [is_ordered L] [has_le M] [L.Structure M] :
  L.is_ordered_structure M ↔ Lhom.is_expansion_on (order_Lhom L) M := iff.rfl

instance is_ordered_structure_has_le [has_le M] :
  is_ordered_structure language.order M :=
begin
  rw [is_ordered_structure_iff, order_Lhom_order],
  exact Lhom.id_is_expansion_on M,
end

instance model_preorder [preorder M] :
  M ⊨ Theory.preorder :=
begin
  simp only [Theory.preorder, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
    forall_eq_or_imp, relations.realize_reflexive, rel_map_apply₂, forall_eq,
    relations.realize_transitive],
  exact ⟨le_refl, λ _ _ _, le_trans⟩
end

instance model_partial_order [partial_order M] :
  M ⊨ Theory.partial_order :=
begin
  simp only [Theory.partial_order, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
    forall_eq_or_imp, relations.realize_reflexive, rel_map_apply₂, relations.realize_antisymmetric,
    forall_eq, relations.realize_transitive],
  exact ⟨le_refl, λ _ _, le_antisymm, λ _ _ _, le_trans⟩,
end

instance model_linear_order [linear_order M] :
  M ⊨ Theory.linear_order :=
begin
  simp only [Theory.linear_order, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
    forall_eq_or_imp, relations.realize_reflexive, rel_map_apply₂, relations.realize_antisymmetric,
    relations.realize_transitive, forall_eq, relations.realize_total],
  exact ⟨le_refl, λ _ _, le_antisymm, λ _ _ _, le_trans, le_total⟩,
end

section is_ordered_structure
variables [is_ordered L] [L.Structure M]

@[simp] lemma rel_map_le_symb [has_le M] [L.is_ordered_structure M] {a b : M} :
  rel_map (le_symb : L.relations 2) ![a, b] ↔ a ≤ b :=
begin
  rw [← order_Lhom_le_symb, Lhom.is_expansion_on.map_on_relation],
  refl,
end

@[simp] lemma term.realize_le [has_le M] [L.is_ordered_structure M]
  {t₁ t₂ : L.term (α ⊕ fin n)} {v : α → M} {xs : fin n → M} :
  (t₁.le t₂).realize v xs ↔ t₁.realize (sum.elim v xs) ≤ t₂.realize (sum.elim v xs) :=
by simp [term.le]

@[simp] lemma term.realize_lt [preorder M] [L.is_ordered_structure M]
  {t₁ t₂ : L.term (α ⊕ fin n)} {v : α → M} {xs : fin n → M} :
  (t₁.lt t₂).realize v xs ↔ t₁.realize (sum.elim v xs) < t₂.realize (sum.elim v xs) :=
by simp [term.lt, lt_iff_le_not_le]

end is_ordered_structure

section has_le
variables [has_le M]

theorem realize_no_top_order_iff : M ⊨ sentence.no_top_order ↔ no_top_order M :=
begin
  simp only [sentence.no_top_order, sentence.realize, formula.realize, bounded_formula.realize_all,
    bounded_formula.realize_ex, bounded_formula.realize_not, realize, term.realize_le,
    sum.elim_inr],
  refine ⟨λ h, ⟨λ a, h a⟩, _⟩,
  introsI h a,
  exact exists_not_le a,
end

@[simp] lemma realize_no_top_order [h : no_top_order M] : M ⊨ sentence.no_top_order :=
realize_no_top_order_iff.2 h

theorem realize_no_bot_order_iff : M ⊨ sentence.no_bot_order ↔ no_bot_order M :=
begin
  simp only [sentence.no_bot_order, sentence.realize, formula.realize, bounded_formula.realize_all,
    bounded_formula.realize_ex, bounded_formula.realize_not, realize, term.realize_le,
    sum.elim_inr],
  refine ⟨λ h, ⟨λ a, h a⟩, _⟩,
  introsI h a,
  exact exists_not_ge a,
end

@[simp] lemma realize_no_bot_order [h : no_bot_order M] : M ⊨ sentence.no_bot_order :=
realize_no_bot_order_iff.2 h

end has_le

theorem realize_densely_ordered_iff [preorder M] :
  M ⊨ sentence.densely_ordered ↔ densely_ordered M :=
begin
  simp only [sentence.densely_ordered, sentence.realize, formula.realize,
    bounded_formula.realize_imp, bounded_formula.realize_all, realize, term.realize_lt,
    sum.elim_inr, bounded_formula.realize_ex, bounded_formula.realize_inf],
  refine ⟨λ h, ⟨λ a b ab, h a b ab⟩, _⟩,
  introsI h a b ab,
  exact exists_between ab,
end

@[simp] lemma realize_densely_ordered [preorder M] [h : densely_ordered M] :
  M ⊨ sentence.densely_ordered :=
realize_densely_ordered_iff.2 h

instance model_DLO [linear_order M] [densely_ordered M] [no_top_order M] [no_bot_order M] :
  M ⊨ Theory.DLO :=
begin
  simp only [Theory.DLO, set.union_insert, set.union_singleton, Theory.model_iff,
    set.mem_insert_iff, forall_eq_or_imp, realize_no_top_order, realize_no_bot_order,
    realize_densely_ordered, true_and],
  rw ← Theory.model_iff,
  apply_instance,
end

end language
end first_order


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

import field_theory.primitive_element
import linear_algebra.determinant
import linear_algebra.finite_dimensional
import linear_algebra.matrix.charpoly.minpoly
import linear_algebra.matrix.to_linear_equiv
import field_theory.is_alg_closed.algebraic_closure
import field_theory.galois

/-!
# Norm for (finite) ring extensions

Suppose we have an `R`-algebra `S` with a finite basis. For each `s : S`,
the determinant of the linear map given by multiplying by `s` gives information
about the roots of the minimal polynomial of `s` over `R`.

## Implementation notes

Typically, the norm is defined specifically for finite field extensions.
The current definition is as general as possible and the assumption that we have
fields or that the extension is finite is added to the lemmas as needed.

We only define the norm for left multiplication (`algebra.left_mul_matrix`,
i.e. `algebra.lmul_left`).
For now, the definitions assume `S` is commutative, so the choice doesn't
matter anyway.

See also `algebra.trace`, which is defined similarly as the trace of
`algebra.left_mul_matrix`.

## References

 * https://en.wikipedia.org/wiki/Field_norm

-/

universes u v w

variables {R S T : Type*} [comm_ring R] [comm_ring S]
variables [algebra R S]
variables {K L F : Type*} [field K] [field L] [field F]
variables [algebra K L] [algebra K F]
variables {ι : Type w} [fintype ι]

open finite_dimensional
open linear_map
open matrix polynomial

open_locale big_operators
open_locale matrix

namespace algebra

variables (R)

/-- The norm of an element `s` of an `R`-algebra is the determinant of `(*) s`. -/
noncomputable def norm : S →* R :=
linear_map.det.comp (lmul R S).to_ring_hom.to_monoid_hom

lemma norm_apply (x : S) : norm R x = linear_map.det (lmul R S x) := rfl

lemma norm_eq_one_of_not_exists_basis
  (h : ¬ ∃ (s : finset S), nonempty (basis s R S)) (x : S) : norm R x = 1 :=
by { rw [norm_apply, linear_map.det], split_ifs with h, refl }

variables {R}

-- Can't be a `simp` lemma because it depends on a choice of basis
lemma norm_eq_matrix_det [decidable_eq ι] (b : basis ι R S) (s : S) :
  norm R s = matrix.det (algebra.left_mul_matrix b s) :=
by rw [norm_apply, ← linear_map.det_to_matrix b, to_matrix_lmul_eq]

/-- If `x` is in the base field `K`, then the norm is `x ^ [L : K]`. -/
lemma norm_algebra_map_of_basis (b : basis ι R S) (x : R) :
  norm R (algebra_map R S x) = x ^ fintype.card ι :=
begin
  haveI := classical.dec_eq ι,
  rw [norm_apply, ← det_to_matrix b, lmul_algebra_map],
  convert @det_diagonal _ _ _ _ _ (λ (i : ι), x),
  { ext i j, rw [to_matrix_lsmul, matrix.diagonal] },
  { rw [finset.prod_const, finset.card_univ] }
end

/-- If `x` is in the base field `K`, then the norm is `x ^ [L : K]`.

(If `L` is not finite-dimensional over `K`, then `norm = 1 = x ^ 0 = x ^ (finrank L K)`.)
-/
@[simp]
protected lemma norm_algebra_map (x : K) : norm K (algebra_map K L x) = x ^ finrank K L :=
begin
  by_cases H : ∃ (s : finset L), nonempty (basis s K L),
  { rw [norm_algebra_map_of_basis H.some_spec.some, finrank_eq_card_basis H.some_spec.some] },
  { rw [norm_eq_one_of_not_exists_basis K H, finrank_eq_zero_of_not_exists_basis, pow_zero],
    rintros ⟨s, ⟨b⟩⟩,
    exact H ⟨s, ⟨b⟩⟩ },
end

section eq_prod_roots

/-- Given `pb : power_basis K S`, then the norm of `pb.gen` is
`(-1) ^ pb.dim * coeff (minpoly K pb.gen) 0`. -/
lemma power_basis.norm_gen_eq_coeff_zero_minpoly [algebra K S] (pb : power_basis K S) :
  norm K pb.gen = (-1) ^ pb.dim * coeff (minpoly K pb.gen) 0 :=
begin
  rw [norm_eq_matrix_det pb.basis, det_eq_sign_charpoly_coeff, charpoly_left_mul_matrix,
    fintype.card_fin]
end

/-- Given `pb : power_basis K S`, then the norm of `pb.gen` is
`((minpoly K pb.gen).map (algebra_map K F)).roots.prod`. -/
lemma power_basis.norm_gen_eq_prod_roots [algebra K S] (pb : power_basis K S)
  (hf : (minpoly K pb.gen).splits (algebra_map K F)) :
  algebra_map K F (norm K pb.gen) =
    ((minpoly K pb.gen).map (algebra_map K F)).roots.prod :=
begin
  rw [power_basis.norm_gen_eq_coeff_zero_minpoly, ← pb.nat_degree_minpoly, ring_hom.map_mul,
    ← coeff_map, prod_roots_eq_coeff_zero_of_monic_of_split
      ((minpoly.monic (power_basis.is_integral_gen _)).map _)
      ((splits_id_iff_splits _).2 hf), nat_degree_map, map_pow, ← mul_assoc, ← mul_pow],
  simp
end

end eq_prod_roots

section eq_zero_iff

lemma norm_eq_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
  algebra.norm R x = 0 ↔ x = 0 :=
begin
  have hι : nonempty ι := b.index_nonempty,
  letI := classical.dec_eq ι,
  rw algebra.norm_eq_matrix_det b,
  split,
  { rw ← matrix.exists_mul_vec_eq_zero_iff,
    rintros ⟨v, v_ne, hv⟩,
    rw [← b.equiv_fun.apply_symm_apply v, b.equiv_fun_symm_apply, b.equiv_fun_apply,
        algebra.left_mul_matrix_mul_vec_repr] at hv,
    refine (mul_eq_zero.mp (b.ext_elem $ λ i, _)).resolve_right (show ∑ i, v i • b i ≠ 0, from _),
    { simpa only [linear_equiv.map_zero, pi.zero_apply] using congr_fun hv i },
    { contrapose! v_ne with sum_eq,
      apply b.equiv_fun.symm.injective,
      rw [b.equiv_fun_symm_apply, sum_eq, linear_equiv.map_zero] } },
  { rintro rfl,
    rw [alg_hom.map_zero, matrix.det_zero hι] },
end

lemma norm_ne_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
  algebra.norm R x ≠ 0 ↔ x ≠ 0 :=
not_iff_not.mpr (algebra.norm_eq_zero_iff_of_basis b)

/-- See also `algebra.norm_eq_zero_iff'` if you already have rewritten with `algebra.norm_apply`. -/
@[simp]
lemma norm_eq_zero_iff [finite_dimensional K L] {x : L} :
  algebra.norm K x = 0 ↔ x = 0 :=
algebra.norm_eq_zero_iff_of_basis (basis.of_vector_space K L)

/-- This is `algebra.norm_eq_zero_iff` composed with `algebra.norm_apply`. -/
@[simp]
lemma norm_eq_zero_iff' [finite_dimensional K L] {x : L} :
  linear_map.det (algebra.lmul K L x) = 0 ↔ x = 0 :=
algebra.norm_eq_zero_iff_of_basis (basis.of_vector_space K L)

end eq_zero_iff

open intermediate_field

variable (K)

lemma norm_eq_norm_adjoin [finite_dimensional K L] [is_separable K L] (x : L) :
  norm K x = norm K (adjoin_simple.gen K x) ^ finrank K⟮x⟯ L :=
begin
  letI := is_separable_tower_top_of_is_separable K K⟮x⟯ L,
  let pbL := field.power_basis_of_finite_of_separable K⟮x⟯ L,
  let pbx := intermediate_field.adjoin.power_basis (is_separable.is_integral K x),
  rw [← adjoin_simple.algebra_map_gen K x, norm_eq_matrix_det (pbx.basis.smul pbL.basis) _,
    smul_left_mul_matrix_algebra_map, det_block_diagonal, norm_eq_matrix_det pbx.basis],
  simp only [finset.card_fin, finset.prod_const],
  congr,
  rw [← power_basis.finrank, adjoin_simple.algebra_map_gen K x]
end

variable {K}

section intermediate_field

lemma _root_.intermediate_field.adjoin_simple.norm_gen_eq_one {x : L}
  (hx : ¬_root_.is_integral K x) : norm K (adjoin_simple.gen K x) = 1 :=
begin
  rw [norm_eq_one_of_not_exists_basis],
  contrapose! hx,
  obtain ⟨s, ⟨b⟩⟩ := hx,
  refine is_integral_of_mem_of_fg (K⟮x⟯).to_subalgebra _ x _,
  { exact (submodule.fg_iff_finite_dimensional _).mpr (of_finset_basis b) },
  { exact intermediate_field.subset_adjoin K _ (set.mem_singleton x) }
end

lemma _root_.intermediate_field.adjoin_simple.norm_gen_eq_prod_roots (x : L)
  (hf : (minpoly K x).splits (algebra_map K F)) :
  (algebra_map K F) (norm K (adjoin_simple.gen K x)) =
    ((minpoly K x).map (algebra_map K F)).roots.prod :=
begin
  have injKxL := (algebra_map K⟮x⟯ L).injective,
  by_cases hx : _root_.is_integral K x, swap,
  { simp [minpoly.eq_zero hx, intermediate_field.adjoin_simple.norm_gen_eq_one hx] },
  have hx' : _root_.is_integral K (adjoin_simple.gen K x),
  { rwa [← is_integral_algebra_map_iff injKxL, adjoin_simple.algebra_map_gen],
    apply_instance },
  rw [← adjoin.power_basis_gen hx, power_basis.norm_gen_eq_prod_roots];
    rw [adjoin.power_basis_gen hx, minpoly.eq_of_algebra_map_eq injKxL hx'];
    try { simp only [adjoin_simple.algebra_map_gen _ _] },
  exact hf
end

end intermediate_field

section eq_prod_embeddings

open intermediate_field intermediate_field.adjoin_simple polynomial

variables (E : Type*) [field E] [algebra K E]

lemma norm_eq_prod_embeddings_gen
  (pb : power_basis K L)
  (hE : (minpoly K pb.gen).splits (algebra_map K E)) (hfx : (minpoly K pb.gen).separable) :
  algebra_map K E (norm K pb.gen) =
    (@@finset.univ (power_basis.alg_hom.fintype pb)).prod (λ σ, σ pb.gen) :=
begin
  letI := classical.dec_eq E,
  rw [power_basis.norm_gen_eq_prod_roots pb hE, fintype.prod_equiv pb.lift_equiv',
    finset.prod_mem_multiset, finset.prod_eq_multiset_prod, multiset.to_finset_val,
    multiset.dedup_eq_self.mpr, multiset.map_id],
  { exact nodup_roots ((separable_map _).mpr hfx) },
  { intro x, refl },
  { intro σ, rw [power_basis.lift_equiv'_apply_coe, id.def] }
end

lemma norm_eq_prod_roots [is_separable K L] [finite_dimensional K L]
  {x : L} (hF : (minpoly K x).splits (algebra_map K F)) :
  algebra_map K F (norm K x) = ((minpoly K x).map (algebra_map K F)).roots.prod ^ finrank K⟮x⟯ L :=
by rw [norm_eq_norm_adjoin K x, map_pow,
  intermediate_field.adjoin_simple.norm_gen_eq_prod_roots _ hF]

variable (F)

lemma prod_embeddings_eq_finrank_pow [algebra L F] [is_scalar_tower K L F][is_alg_closed E]
  [is_separable K F] [finite_dimensional K F] (pb : power_basis K L) :
  ∏ σ : F →ₐ[K] E, σ (algebra_map L F pb.gen) =
  ((@@finset.univ (power_basis.alg_hom.fintype pb)).prod
    (λ σ : L →ₐ[K] E, σ pb.gen)) ^ finrank L F :=
begin
  haveI : finite_dimensional L F := finite_dimensional.right K L F,
  haveI : is_separable L F := is_separable_tower_top_of_is_separable K L F,
  letI : fintype (L →ₐ[K] E) := power_basis.alg_hom.fintype pb,
  letI : ∀ (f : L →ₐ[K] E), fintype (@@alg_hom L F E _ _ _ _ f.to_ring_hom.to_algebra) := _,
  rw [fintype.prod_equiv alg_hom_equiv_sigma (λ (σ : F →ₐ[K] E), _) (λ σ, σ.1 pb.gen),
     ← finset.univ_sigma_univ, finset.prod_sigma, ← finset.prod_pow],
  refine finset.prod_congr rfl (λ σ _, _),
  { letI : algebra L E := σ.to_ring_hom.to_algebra,
    simp only [finset.prod_const, finset.card_univ],
    congr,
    rw alg_hom.card L F E },
  { intros σ,
    simp only [alg_hom_equiv_sigma, equiv.coe_fn_mk, alg_hom.restrict_domain, alg_hom.comp_apply,
         is_scalar_tower.coe_to_alg_hom'] }
end

variable (K)

/-- For `L/K` a finite separable extension of fields and `E` an algebraically closed extension
of `K`, the norm (down to `K`) of an element `x` of `L` is equal to the product of the images
of `x` over all the `K`-embeddings `σ`  of `L` into `E`. -/
lemma norm_eq_prod_embeddings [finite_dimensional K L] [is_separable K L] [is_alg_closed E]
  {x : L} : algebra_map K E (norm K x) = ∏ σ : L →ₐ[K] E, σ x :=
begin
  have hx := is_separable.is_integral K x,
  rw [norm_eq_norm_adjoin K x, ring_hom.map_pow, ← adjoin.power_basis_gen hx,
    norm_eq_prod_embeddings_gen E (adjoin.power_basis hx) (is_alg_closed.splits_codomain _)],
  { exact (prod_embeddings_eq_finrank_pow L E (adjoin.power_basis hx)).symm },
  { haveI := is_separable_tower_bot_of_is_separable K K⟮x⟯ L,
    exact is_separable.separable K _ }
end

lemma norm_eq_prod_automorphisms [finite_dimensional K L] [is_galois K L] {x : L}:
  algebra_map K L (norm K x) = ∏ (σ : L ≃ₐ[K] L), σ x :=
begin
  apply no_zero_smul_divisors.algebra_map_injective L (algebraic_closure L),
  rw map_prod (algebra_map L (algebraic_closure L)),
  rw ← fintype.prod_equiv (normal.alg_hom_equiv_aut K (algebraic_closure L) L),
  { rw ← norm_eq_prod_embeddings,
    simp only [algebra_map_eq_smul_one, smul_one_smul] },
  { intro σ,
    simp only [normal.alg_hom_equiv_aut, alg_hom.restrict_normal', equiv.coe_fn_mk,
               alg_equiv.coe_of_bijective, alg_hom.restrict_normal_commutes, id.map_eq_id,
               ring_hom.id_apply] },
end

lemma is_integral_norm [algebra S L] [algebra S K] [is_scalar_tower S K L]
  [is_separable K L] [finite_dimensional K L] {x : L} (hx : _root_.is_integral S x) :
  _root_.is_integral S (norm K x) :=
begin
  have hx' : _root_.is_integral K x := is_integral_of_is_scalar_tower _ hx,
  rw [← is_integral_algebra_map_iff (algebra_map K (algebraic_closure L)).injective,
      norm_eq_prod_roots],
  { refine (is_integral.multiset_prod (λ y hy, _)).pow _,
    rw mem_roots_map (minpoly.ne_zero hx') at hy,
    use [minpoly S x, minpoly.monic hx],
    rw ← aeval_def at ⊢ hy,
    exact minpoly.aeval_of_is_scalar_tower S x y hy },
  { apply is_alg_closed.splits_codomain },
  { apply_instance }
end

end eq_prod_embeddings

end algebra


import subgroup_world.subgroup_inv_bis -- hide

variables {G : Type} [group G] {H : set G} -- hide

/-
## Closed under product

Here you prove finally that the product of elements in a subgroup stays in the subgroup.
-/
/- Lemma:
If $H\leq G$, and $x, y \in H$, then $x y \in H$.
-/
lemma subgroup.mul_mem [h : subgroup H]
{x y : G} (hx : x ∈ H) (hy : y ∈ H) :  x * y ∈ H :=
begin
  rw show x * y = x * y⁻¹⁻¹, by group,
  apply h.2 _ _ hx (subgroup.inv_mem' hy),

end


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

In this file we give an equivalence from lists in ℕ with no
duplicates to arbitrary lists in ℕ.

-/

import combinatorics.choose combinatorics.simplicial

open combinatorics
open simplicial.infinite

namespace natlist

/- The map `spread` converts arbitrary lists to nonduplicating
   lists, by moving the later entries upwards so that they
   cannot conflict with the earlier ones.  It uses the map
   `δ` from the `simplicial.infinite` namespace.
-/
def spread : list ℕ → list ℕ
| [] := []
| (i :: l) := i :: ((spread l).map (δ i))

/- The map `squash` converts nonduplicating lists to arbitrary
   lists by moving later entries downwards to eliminate the
   gaps forced by the nonduplicating property.  It uses the
   map `σ` from the `simplicial.infinite` namespace. Although
   `squash` is designed to be used on nonduplicating lists, it
   is convenient to give the definition in a form that does not
   rely on that property.
-/
def squash : ∀ (l : list ℕ ), list ℕ
| [] := []
| (i :: l) := i :: squash (l.map (simplicial.infinite.σ i.pred))
using_well_founded {
  rel_tac := λ _ _, `[exact ⟨_, measure_wf list.length⟩],
  dec_tac := well_founded_tactics.default_dec_tac }

@[simp] lemma squash.nil : squash [] = [] := by simp[squash]

@[simp] lemma squash.cons (i : ℕ) (l : list ℕ) :
  squash (i :: l)  = i :: (squash (l.map (σ i.pred))) := by simp[squash]

lemma spread.nodup (l : list ℕ) : (spread l).nodup :=
begin
  induction l with i l ih,
  { exact list.nodup_nil },
  { rw [spread, list.nodup_cons], split,
    { intro h, rcases list.mem_map.mp h with ⟨j,⟨hm,he⟩⟩, exact δ_ne i j he },
    { exact list.nodup.map (δ_inj i) ih } }
end

@[simp] lemma spread.length (l : list ℕ) : (spread l).length = l.length :=
begin
  induction l with i l ih,
  { refl },
  { rw [spread, list.length_cons, list.length_cons, list.length_map, ih] }
end

@[simp] lemma squash.length : ∀ (l : list ℕ), (squash l).length = l.length
| [] := by simp[squash]
| (i :: l) :=
begin
  rw [squash.cons, list.length_cons, squash.length, list.length_map, list.length_cons]
end
using_well_founded {
  rel_tac := λ _ _, `[exact ⟨_, measure_wf list.length⟩],
  dec_tac := well_founded_tactics.default_dec_tac }

lemma squash_spread : ∀ (l : list ℕ), squash (spread l) = l
| [] := by simp[squash,spread]
| (i :: l) :=
  by { rw [spread, squash.cons, list.map_map, σδ_pred, list.map_id, squash_spread] }

lemma spread_squash : ∀ {l : list ℕ} (hl : l.nodup), spread (squash l) = l
| [] _ := by simp[squash,spread]
| (i :: l) hl := begin
  rw [list.nodup_cons] at hl,
  let m := l.map (σ i.pred),
  have hm : m.nodup := σ_pred_nodup hl.right hl.left,
  rw [squash.cons, spread, spread_squash hm],
  congr' 1, dsimp[m], rw [list.map_map],
  let p : ℕ → ℕ := (δ i) ∘ (σ i.pred), change l.map p = l,
  have hp : ∀ (k : ℕ) (hk : k ≠ i), p k = k :=
    λ k hk, simplicial.infinite.δσ_pred hk,
  have : l.map p = l.map id :=
  begin
    apply list.map_congr, intros k hk,
    have : k ≠ i := λ h, hl.left (h ▸ hk),
    exact δσ_pred this
  end,
  rw [this, list.map_id],
end
using_well_founded {
  rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, list.length x.1)⟩],
  dec_tac := well_founded_tactics.default_dec_tac }

def spread_equiv : list ℕ ≃ { l : list ℕ // l.nodup } := {
  to_fun := λ l, ⟨spread l, spread.nodup l⟩,
  inv_fun := λ l, squash l.val,
  left_inv := λ l, squash_spread l,
  right_inv := λ l, subtype.eq (spread_squash l.property) }

/- We now prove upper bounds for the entries in the lists
   `spread l` and `squash l`.  This will enable us to define
   functions related to `spread` and `squash` using `fin n`
   instead of `ℕ`.   Everything is formulated in terms of the
   predicates `below_line n l` and `below_triangle n l` for
   `l : list ℕ`.  The first of these says that all entries
   of `l` are less than `n`, and the second says that the `i`th
   entry is less than `n - i`.
-/

def below_line : ∀ (n : ℕ) (l : list ℕ), Prop
| n [] := true
| n (i :: l) := i < n ∧ below_line n l

def below_triangle : ∀ (n : ℕ) (l : list ℕ), Prop
| 0 [] := true
| 0 (i :: l) := false
| (n + 1) [] := true
| (n + 1) (i :: l) := i < n + 1 ∧ below_triangle n l

lemma below_line.iff {n : ℕ} {l : list ℕ} :
  below_line n l ↔ ∀ j, j ∈ l → j < n :=
begin
  split; induction l with i l ih,
  { intros h j hj, exfalso, exact list.not_mem_nil j hj },
  { intros h j hj, rw [below_line] at h,
    rcases ((list.mem_cons_iff _ _ _).mp hj) with ⟨⟨_⟩|hj'⟩,
    { exact h.1 },
    { exact ih h.2 j (by assumption) } },
  { intro h, exact true.intro },
  { intro h, dsimp [below_line], split,
    { exact h i (l.mem_cons_self i) },
    { apply ih, intros j hj, exact h j (list.mem_cons_of_mem i hj) } }
end

lemma below_line.δ (i : ℕ) {n : ℕ} {l : list ℕ} (h : below_line n l ) :
  below_line (n + 1) (l.map (simplicial.infinite.δ i)) :=
begin
  rw [below_line.iff] at h ⊢,
  intros k hk,
  rcases list.mem_map.mp hk with ⟨j,⟨hm,he⟩⟩,
  rw [← he],
  exact lt_of_le_of_lt (simplicial.infinite.δ_bound' i j).2
                       (nat.succ_lt_succ (h j hm))
end

lemma below_line.σ {i n : ℕ} {l : list ℕ}
  (hi : i < n) (hl : below_line (n + 1) l) :
    (below_line n (l.map (simplicial.infinite.σ i))) :=
begin
  rw [below_line.iff] at hl ⊢,
  intros k hk,
  rcases list.mem_map.mp hk with ⟨j,⟨hm,he⟩⟩,
  rw [← he],
  exact simplicial.infinite.σ_bound hi (hl j hm)
end

lemma below_line.of_fin {n : ℕ} (l : list (fin n)) : below_line n (l.map coe) :=
below_line.iff.mpr $ (λ j hj, begin
 rcases list.mem_map.mp hj with ⟨i,⟨hm,he⟩⟩, rw [← he], exact i.is_lt
end)

lemma below_triangle.nil (n : ℕ) : below_triangle n [] :=
by { cases n; trivial }

lemma spread.below : ∀ {n : ℕ} {l : list ℕ} (hb : below_triangle n l),
  below_line n (spread l)
| n [] h := by {  simp only [spread, below_line] }
| 0 (i :: l) hb := false.elim hb
| (n + 1) (i :: l) hb :=
begin
  dsimp[below_triangle] at hb,
  split,
  { exact hb.1 },
  { exact below_line.δ i (spread.below hb.2) }
end

lemma squash.below : ∀ {n : ℕ} {l : list ℕ}
  (hb : below_line n l) (hn : l.nodup),
  below_triangle n (squash l)
| 0 [] hb hn := by { simp only [squash, below_triangle] }
| (n + 1) [] hb hn := by { simp only [squash, below_triangle] }
| 0 (i :: l) hb hn := false.elim (nat.not_lt_zero i hb.1)
| (n + 1) (i :: l) hb hn :=
begin
  dsimp [below_line] at hb,
  rw [squash.cons, below_triangle],
  split, { exact hb.1 },
  rw [list.nodup_cons] at hn,
  apply squash.below _ (σ_pred_nodup hn.right hn.left),
  by_cases hb' : i < n,
  { rw [below_line.iff] at hb ⊢,
      intros j hj,
      rcases list.mem_map.mp hj with ⟨j',hj'⟩,
      have hj'' := hb.right j' hj'.left,
      exact hj'.right ▸ (σ_bound (lt_of_le_of_lt i.pred_le hb') hj'') },
  { have : i = n := le_antisymm (nat.le_of_lt_succ hb.left) (le_of_not_gt hb'),
    cases this,
    rw [below_line.iff] at hb ⊢,
    intros j hj,
    rcases list.mem_map.mp hj with ⟨j',⟨hm',he'⟩⟩,
    have hj' : j' ≤ n := nat.le_of_lt_succ (hb.right j' hm'),
    by_cases hjn : j' = n,
    { exfalso, exact hn.left (hjn ▸ hm') },
    { rw [← he'],
      exact lt_of_le_of_lt (σ_le n.pred j') (lt_of_le_of_ne hj' hjn) } }
end

end natlist

/- `fin_falling` is an inductive type defined in the most obvious
   way to ensure that `fin_falling n k` has size `falling n k`
   (where `falling n k` is n (n - 1) (n - 2) ... (n - k + 1) )
-/
@[derive decidable_eq]
inductive fin_falling : ∀ (n : ℕ), Type
| nil (n : ℕ) : fin_falling n
| cons {n : ℕ} (i : fin (n + 1)) (l : fin_falling n) : fin_falling (n + 1)

namespace fin_falling

def length : ∀ {n : ℕ} (l : fin_falling n), ℕ :=
 @fin_falling.rec (λ n l, ℕ) (λ n, 0) (λ n i l k, k + 1)

@[simp] lemma length.nil (n : ℕ) : (fin_falling.nil n).length = 0 := rfl

@[simp] lemma length.cons {n : ℕ} (i : fin (n + 1)) (l : fin_falling n) :
  (fin_falling.cons i l).length = l.length + 1 := rfl

/- We will define three different functions that convert an element
   `l : fin_falling n k` to a list.
   * `to_list l` will be a nonduplicating list in `fin n`
   * `to_spread_list l` will be a nonduplicating list in `ℕ`, and will
     be the same as `(to_list l).map fin.val`
   * `to_squash_list l` will be a list in `ℕ`, and will be the same as
     `natlist.squash (to_spread_list l)`.
-/

def to_squash_list : ∀ { n : ℕ } (l : fin_falling n), list ℕ :=
 @fin_falling.rec (λ n l, list ℕ) (λ n, list.nil)
   (λ n i l ih, i :: ih)

lemma to_squash_list.nil (n : ℕ) : to_squash_list (fin_falling.nil n) = [] := rfl

lemma to_squash_list.cons {n : ℕ} (i : fin (n + 1)) (l : fin_falling n) :
  to_squash_list (fin_falling.cons i l) = i :: (to_squash_list l) := rfl

lemma to_squash_list.length : ∀ {n : ℕ} (l : fin_falling n), l.to_squash_list.length = l.length
| _ (fin_falling.nil n) :=
  by { rw[to_squash_list.nil, list.length, length.nil] }
| n (fin_falling.cons i l) :=
  by { rw[to_squash_list.cons, list.length, to_squash_list.length l, length.cons] }

lemma to_squash_list.below : ∀ {n : ℕ} (l : fin_falling n),
  natlist.below_triangle n l.to_squash_list
| _ (fin_falling.nil n) := natlist.below_triangle.nil n
| n (fin_falling.cons i l) := and.intro i.is_lt (to_squash_list.below l)

def to_spread_list : ∀ { n : ℕ } (l : fin_falling n), list ℕ :=
 @fin_falling.rec (λ n l, list ℕ) (λ n, list.nil)
   (λ n i l ih, i :: (ih.map (simplicial.infinite.δ i)))

lemma to_spread_list.nil (n : ℕ) : to_spread_list (fin_falling.nil n) = [] := rfl

lemma to_spread_list.cons {n : ℕ} (i : fin (n + 1)) (l : fin_falling n) :
  to_spread_list (fin_falling.cons i l) =
    i :: ((to_spread_list l).map (simplicial.infinite.δ i)) := rfl

lemma to_spread_list.length : ∀ {n : ℕ} (l : fin_falling n),
  (to_spread_list l).length = l.length
| _ (fin_falling.nil n) :=
  by { rw[to_spread_list.nil, list.length, length.nil] }
| n (fin_falling.cons i l) :=
  by { rw[to_spread_list.cons, list.length, list.length_map,
          to_spread_list.length l, length.cons] }

lemma to_spread_list.below : ∀ {n : ℕ} (l : fin_falling n),
  natlist.below_line n l.to_spread_list
| _ (fin_falling.nil n) := true.intro
| n (fin_falling.cons i l) :=
begin
  rw [to_spread_list.cons, natlist.below_line],
  split, exact i.is_lt,
  have h := to_spread_list.below l,
  rw [natlist.below_line.iff] at h ⊢,
  intros j hj,
  rcases list.mem_map.mp hj with ⟨j₀,⟨hm,he⟩⟩,
  exact he ▸ (lt_of_le_of_lt (δ_bound' i j₀).right (nat.succ_lt_succ (h j₀ hm))),
end

lemma spread_squash : ∀ {n : ℕ } (l : fin_falling n),
  natlist.spread l.to_squash_list = l.to_spread_list
| _ (fin_falling.nil n) := rfl
| n (fin_falling.cons i l) :=
by { rw [to_squash_list.cons, to_spread_list.cons, natlist.spread, spread_squash] }

lemma to_spread_list.nodup {n : ℕ } (l : fin_falling n) :
  l.to_spread_list.nodup :=
by { rw[← l.spread_squash], exact natlist.spread.nodup _ }

lemma squash_spread {n : ℕ} (l : fin_falling n) :
  natlist.squash l.to_spread_list = l.to_squash_list :=
by { rw [← spread_squash l, natlist.squash_spread] }

def to_list : ∀ { n : ℕ } (l : fin_falling n), list (fin n) :=
 @fin_falling.rec (λ n l, list (fin n)) (λ n, list.nil)
  (λ n i l ih, i :: (ih.map (simplicial.δ i)))

lemma to_list.nil (n : ℕ) : to_list (fin_falling.nil n) = [] := rfl

lemma to_list.cons {n : ℕ} (i : fin (n + 1)) (l : fin_falling n) :
  to_list (fin_falling.cons i l) = i :: (to_list l).map (simplicial.δ i) := rfl

lemma to_list.length : ∀ {n : ℕ} (l : fin_falling n), (to_list l).length = l.length
| _ (fin_falling.nil n) :=
  by { rw[to_list.nil, list.length, length.nil] }
| n (fin_falling.cons i l) :=
  by { rw[to_list.cons, list.length, list.length_map, to_list.length l, length.cons] }

lemma to_list.nodup : ∀ {n : ℕ} (l : fin_falling n), (to_list l).nodup
| _ (fin_falling.nil n) := list.nodup_nil
| n (fin_falling.cons i l) :=
begin
  rw [to_list.cons, list.nodup_cons], split,
  { rw [list.mem_map],
    rintro ⟨k,⟨hm,he⟩⟩, exact simplicial.δ_ne _ _ he, },
  { exact list.nodup.map (simplicial.δ_inj i) (to_list.nodup l) }
end

lemma to_list.val : ∀ {n : ℕ} (l : fin_falling n),
  (to_list l).map (coe : fin n → ℕ) = to_spread_list l
| _ (fin_falling.nil n) := rfl
| n (fin_falling.cons i l) :=
begin
  rw [to_list.cons, to_spread_list.cons, list.map_cons, list.map_map],
  have : (coe : (fin _) → ℕ) ∘ (simplicial.δ i) = (δ i) ∘ coe :=
  begin ext j, simp only [function.comp_app, simplicial.δ_infinite] end,
  rw [this, ← list.map_map, to_list.val]
end

def of_squash_list : ∀ {n : ℕ} (l : list ℕ)
  (hb : natlist.below_triangle n l), fin_falling n
| n [] hb := fin_falling.nil n
| 0 (i :: l) hb := false.elim hb
| (n + 1) (i :: l) hb :=
    fin_falling.cons ⟨i,hb.left⟩ (of_squash_list l hb.right)

lemma of_squash_list.nil (n : ℕ) (hb : natlist.below_triangle n []) :
  of_squash_list [] hb = fin_falling.nil n := by { cases n; refl }

lemma of_squash_list.length : ∀ {n : ℕ} (l : list ℕ)
  (hb : natlist.below_triangle n l), (of_squash_list l hb).length = l.length
| n [] hb := by { cases n; refl }
| 0 (i :: l) hb := false.elim hb
| (n + 1) (i :: l) hb :=
  by { rw [of_squash_list, length.cons, list.length_cons, of_squash_list.length] }

def of_spread_list {n : ℕ} (l : list ℕ) (hn : l.nodup) (hb : natlist.below_line n l) :
 fin_falling n := of_squash_list (natlist.squash l) (natlist.squash.below hb hn)

lemma of_spread_list.length {n : ℕ} (l : list ℕ)
  (hn : l.nodup) (hb : natlist.below_line n l) :
  (of_spread_list l hn hb).length = l.length :=
by { rw [of_spread_list, of_squash_list.length, natlist.squash.length] }

def of_list {n : ℕ} (l : list (fin n)) (hn : l.nodup) : fin_falling n :=
 of_spread_list (l.map coe)
  (list.nodup.map (λ _ _ e, subtype.val_injective e) hn) (natlist.below_line.of_fin l)

lemma of_list.length {n : ℕ} (l : list (fin n)) (hn : l.nodup) :
  (of_list l hn).length = l.length :=
by { rw [of_list, of_spread_list.length, list.length_map] }

lemma to_of_squash_list : ∀ {n : ℕ} {l : list ℕ} (hb : natlist.below_triangle n l),
 to_squash_list (of_squash_list l hb) = l
| n [] hb := by { cases n; refl }
| 0 (i :: l) hb := false.elim hb
| (n + 1) (i :: l) hb :=
  by { rw [of_squash_list, to_squash_list.cons, to_of_squash_list], refl }

lemma of_to_squash_list_aux : ∀ {n : ℕ} (l : fin_falling n) (h),
 of_squash_list (to_squash_list l) h = l :=
begin
  intros n l,
  induction l with n₀ n₁ i l ih,
  { rw [to_squash_list.nil], intro h, rw [of_squash_list.nil] },
  { rw [to_squash_list.cons], intro h, rw [of_squash_list, ih], congr' 1,
    exact fin.coe_inj rfl }
end

lemma of_to_squash_list {n : ℕ} (l : fin_falling n) :
 of_squash_list (to_squash_list l) (to_squash_list.below l) = l :=
of_to_squash_list_aux l _

lemma to_of_spread_list {n : ℕ} {l : list ℕ} (hn : l.nodup) (hb : natlist.below_line n l) :
 to_spread_list (of_spread_list l hn hb) = l :=
by { rw [of_spread_list, ← spread_squash, to_of_squash_list, natlist.spread_squash hn] }

lemma of_to_spread_list_aux {n : ℕ} (l : fin_falling n) (hn) (hb):
 of_spread_list (to_spread_list l) hn hb = l :=
begin
  dsimp [of_spread_list],
  have : ∀ {l₀ l₁ : list ℕ} (e : l₀ = l₁) (h₁ : natlist.below_triangle n l₁),
           (of_squash_list l₀ (by { rw[e], exact h₁})) = (of_squash_list l₁ h₁) :=
  by { intros, cases e, refl },
  rw [this (squash_spread l) (to_squash_list.below l), of_to_squash_list_aux]
end

lemma to_of_list {n : ℕ} (l : list (fin n)) (hn : l.nodup):
  to_list (of_list l hn) = l :=
begin
  apply list.map_injective_iff.mpr (@fin.coe_inj n),
  rw [to_list.val, of_list, to_of_spread_list]
end

lemma of_to_list {n : ℕ} (l : fin_falling n) :
  of_list (to_list l) (to_list.nodup l) = l :=
begin
  rw [of_list],
  have : ∀ {l₀ l₁ : list ℕ} (e : l₀ = l₁)
           (hn : l₁.nodup) (hb : natlist.below_line n l₁),
           (of_spread_list l₀ (by { rw[e], exact hn}) (by { rw[e], exact hb})) =
             (of_spread_list l₁ hn hb) :=
  by { intros, cases e, refl },
  rw [this (to_list.val l) (to_spread_list.nodup l) (to_spread_list.below l)],
  apply of_to_spread_list_aux
end

def ordered_subset_equiv (n k : ℕ) :
  { l : fin_falling n // l.length = k } ≃ ordered_subset (fin n) k :=
{ to_fun := λ l, ⟨fin_falling.to_list l,
                  ⟨(to_list.length l.val).trans l.property, to_list.nodup l.val⟩⟩,
  inv_fun := λ l, ⟨fin_falling.of_list l.val l.property.2,
                   (of_list.length l.val l.property.2).trans l.property.1⟩,
  left_inv := λ l, subtype.eq (of_to_list l),
  right_inv := λ l, subtype.eq (to_of_list l.val _) }

end fin_falling


/-
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
-/
import topology.metric_space.basic
import topology.metric_space.emetric_paracompact
import topology.shrinking_lemma

/-!
# Shrinking lemma in a proper metric space

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

universes u v
open set metric
open_locale topological_space

variables {α : Type u} {ι : Type v} [metric_space α] [proper_space α] {c : ι → α}
variables {x : α} {r : ℝ} {s : set α}

/-- 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. -/
lemma exists_subset_Union_ball_radius_lt {r : ι → ℝ} (hs : is_closed s)
  (uf : ∀ x ∈ s, finite {i | x ∈ ball (c i) (r i)}) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
  ∃ r' : ι → ℝ, s ⊆ (⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i < r i :=
begin
  rcases exists_subset_Union_closed_subset hs (λ i, @is_open_ball _ _ (c i) (r i)) uf us
    with ⟨v, hsv, hvc, hcv⟩,
  have := λ i, exists_lt_subset_ball (hvc i) (hcv i),
  choose r' hlt hsub,
  exact ⟨r', subset.trans hsv $ Union_subset_Union $ hsub, hlt⟩
end

/-- 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. -/
lemma exists_Union_ball_eq_radius_lt {r : ι → ℝ} (uf : ∀ x, finite {i | x ∈ ball (c i) (r i)})
  (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 is_closed_univ (λ x _, uf x) uU.ge
in ⟨r', univ_subset_iff.1 hU, hv⟩

/-- 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. -/
lemma exists_subset_Union_ball_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i) (hs : is_closed s)
  (uf : ∀ x ∈ s, finite {i | x ∈ ball (c i) (r i)}) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
  ∃ r' : ι → ℝ, s ⊆ (⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i ∈ Ioo 0 (r i) :=
begin
  rcases exists_subset_Union_closed_subset hs (λ i, @is_open_ball _ _ (c i) (r i)) uf us
    with ⟨v, hsv, hvc, hcv⟩,
  have := λ i, exists_pos_lt_subset_ball (hr i) (hvc i) (hcv i),
  choose r' hlt hsub,
  exact ⟨r', subset.trans hsv $ Union_subset_Union hsub, hlt⟩
end

/-- 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. -/
lemma exists_Union_ball_eq_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i)
  (uf : ∀ x, finite {i | x ∈ ball (c i) (r i)}) (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 is_closed_univ (λ x _, uf x) uU.ge
in ⟨r', univ_subset_iff.1 hU, hv⟩

/-- 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`. -/
lemma exists_locally_finite_subset_Union_ball_radius_lt (hs : is_closed 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)) ∧
    locally_finite (λ i, ball (c i) (r' i)) ∧ s ⊆ ⋃ i, ball (c i) (r i) :=
begin
  have : ∀ x ∈ s, (𝓝 x).has_basis (λ r : ℝ, 0 < r ∧ r < R x) (λ r, ball x r),
    from λ x hx, nhds_basis_uniformity (uniformity_basis_dist_lt (hR x hx)),
  rcases refinement_of_locally_compact_sigma_compact_of_nhds_basis_set hs this
    with ⟨ι, c, r', hr', hsub', hfin⟩,
  rcases exists_subset_Union_ball_radius_pos_lt (λ i, (hr' i).2.1) hs
    (λ x hx, hfin.point_finite x) hsub' with ⟨r, hsub, hlt⟩,
  exact ⟨ι, c, r, r', λ i, ⟨(hr' i).1, (hlt i).1, (hlt i).2, (hr' i).2.2⟩, hfin, hsub⟩
end

/-- 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`. -/
lemma exists_locally_finite_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)) ∧
    locally_finite (λ i, ball (c i) (r' i)) ∧ (⋃ i, ball (c i) (r i)) = univ :=
let ⟨ι, c, r, r', hlt, hfin, hsub⟩ := exists_locally_finite_subset_Union_ball_radius_lt
  is_closed_univ (λ x _, hR x)
in ⟨ι, c, r, r', λ i, (hlt i).2, hfin, univ_subset_iff.1 hsub⟩