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

! This file was ported from Lean 3 source module analysis.calculus.affine_map
! leanprover-community/mathlib commit 839b92fedff9981cf3fe1c1f623e04b0d127f57c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.ContinuousAffineMap
import Mathbin.Analysis.Calculus.ContDiff

/-!
# Smooth affine maps

This file contains results about smoothness of affine maps.

## Main definitions:

 * `continuous_affine_map.cont_diff`: a continuous affine map is smooth

-/

namespace ContinuousAffineMap

variable {𝕜 V W : Type _} [NontriviallyNormedField 𝕜]

variable [NormedAddCommGroup V] [NormedSpace 𝕜 V]

variable [NormedAddCommGroup W] [NormedSpace 𝕜 W]

/-- A continuous affine map between normed vector spaces is smooth. -/
theorem contDiff {n : ℕ∞} (f : V →A[𝕜] W) : ContDiff 𝕜 n f :=
  by
  rw [f.decomp]
  apply f.cont_linear.cont_diff.add
  simp only
  exact contDiff_const
#align continuous_affine_map.cont_diff ContinuousAffineMap.contDiff

end ContinuousAffineMap


/-
Copyright (c) 2020 Johan Commelin, Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/

import data.zmod.basic
import number_theory.padics.padic_integers

/-!

# Relating `ℤ_[p]` to `zmod (p ^ n)`

In this file we establish connections between the `p`-adic integers $\mathbb{Z}_p$
and the integers modulo powers of `p`, $\mathbb{Z}/p^n\mathbb{Z}$.

## Main declarations

We show that $\mathbb{Z}_p$ has a ring hom to $\mathbb{Z}/p^n\mathbb{Z}$ for each `n`.
The case for `n = 1` is handled separately, since it is used in the general construction
and we may want to use it without the `^1` getting in the way.
* `padic_int.to_zmod`: ring hom to `zmod p`
* `padic_int.to_zmod_pow`: ring hom to `zmod (p^n)`
* `padic_int.ker_to_zmod` / `padic_int.ker_to_zmod_pow`: the kernels of these maps are the ideals
  generated by `p^n`

We also establish the universal property of $\mathbb{Z}_p$ as a projective limit.
Given a family of compatible ring homs $f_k : R \to \mathbb{Z}/p^n\mathbb{Z}$,
there is a unique limit $R \to \mathbb{Z}_p$.
* `padic_int.lift`: the limit function
* `padic_int.lift_spec` / `padic_int.lift_unique`: the universal property

## Implementation notes

The ring hom constructions go through an auxiliary constructor `padic_int.to_zmod_hom`,
which removes some boilerplate code.

-/

noncomputable theory

open_locale classical
open nat local_ring padic

namespace padic_int

variables {p : ℕ} [hp_prime : fact (p.prime)]
include hp_prime

section ring_homs
/-! ### Ring homomorphisms to `zmod p` and `zmod (p ^ n)` -/
variables (p) (r : ℚ)

omit hp_prime
/--
`mod_part p r` is an integer that satisfies
`∥(r - mod_part p r : ℚ_[p])∥ < 1` when `∥(r : ℚ_[p])∥ ≤ 1`,
see `padic_int.norm_sub_mod_part`.
It is the unique non-negative integer that is `< p` with this property.

(Note that this definition assumes `r : ℚ`.
See `padic_int.zmod_repr` for a version that takes values in `ℕ`
and works for arbitrary `x : ℤ_[p]`.) -/
def mod_part : ℤ :=
(r.num * gcd_a r.denom p) % p

include hp_prime

variable {p}
lemma mod_part_lt_p : mod_part p r < p :=
begin
  convert int.mod_lt _ _,
  { simp },
  { exact_mod_cast hp_prime.1.ne_zero }
end

lemma mod_part_nonneg : 0 ≤ mod_part p r :=
int.mod_nonneg _ $ by exact_mod_cast hp_prime.1.ne_zero

lemma is_unit_denom (r : ℚ) (h : ∥(r : ℚ_[p])∥ ≤ 1) : is_unit (r.denom : ℤ_[p]) :=
begin
  rw is_unit_iff,
  apply le_antisymm (r.denom : ℤ_[p]).2,
  rw [← not_lt, val_eq_coe, coe_coe],
  intro norm_denom_lt,
  have hr : ∥(r * r.denom : ℚ_[p])∥ = ∥(r.num : ℚ_[p])∥,
  { rw_mod_cast @rat.mul_denom_eq_num r, refl, },
  rw padic_norm_e.mul at hr,
  have key : ∥(r.num : ℚ_[p])∥ < 1,
  { calc _ = _ : hr.symm
    ... < 1 * 1 : mul_lt_mul' h norm_denom_lt (norm_nonneg _) zero_lt_one
    ... = 1 : mul_one 1 },
  have : ↑p ∣ r.num ∧ (p : ℤ) ∣ r.denom,
  { simp only [← norm_int_lt_one_iff_dvd, ← padic_norm_e_of_padic_int],
    norm_cast, exact ⟨key, norm_denom_lt⟩ },
  apply hp_prime.1.not_dvd_one,
  rwa [← r.cop.gcd_eq_one, nat.dvd_gcd_iff, ← int.coe_nat_dvd_left, ← int.coe_nat_dvd],
end

lemma norm_sub_mod_part_aux (r : ℚ) (h : ∥(r : ℚ_[p])∥ ≤ 1) :
  ↑p ∣ r.num - r.num * r.denom.gcd_a p % p * ↑(r.denom) :=
begin
  rw ← zmod.int_coe_zmod_eq_zero_iff_dvd,
  simp only [int.cast_coe_nat, zmod.nat_cast_mod p, int.cast_mul, int.cast_sub],
  have := congr_arg (coe : ℤ → zmod p) (gcd_eq_gcd_ab r.denom p),
  simp only [int.cast_coe_nat, add_zero, int.cast_add, zmod.nat_cast_self, int.cast_mul, zero_mul]
    at this,
  push_cast,
  rw [mul_right_comm, mul_assoc, ←this],
  suffices rdcp : r.denom.coprime p,
  { rw rdcp.gcd_eq_one, simp only [mul_one, cast_one, sub_self], },
  apply coprime.symm,
  apply (coprime_or_dvd_of_prime hp_prime.1 _).resolve_right,
  rw [← int.coe_nat_dvd, ← norm_int_lt_one_iff_dvd, not_lt],
  apply ge_of_eq,
  rw ← is_unit_iff,
  exact is_unit_denom r h,
end

lemma norm_sub_mod_part (h : ∥(r : ℚ_[p])∥ ≤ 1) : ∥(⟨r,h⟩ - mod_part p r : ℤ_[p])∥ < 1 :=
begin
  let n := mod_part p r,
  rw [norm_lt_one_iff_dvd, ← (is_unit_denom r h).dvd_mul_right],
  suffices : ↑p ∣ r.num - n * r.denom,
  { convert (int.cast_ring_hom ℤ_[p]).map_dvd this,
    simp only [sub_mul, int.cast_coe_nat, ring_hom.eq_int_cast, int.cast_mul,
      sub_left_inj, int.cast_sub],
    apply subtype.coe_injective,
    simp only [coe_mul, subtype.coe_mk, coe_coe],
    rw_mod_cast @rat.mul_denom_eq_num r, refl },
  exact norm_sub_mod_part_aux r h
end

lemma exists_mem_range_of_norm_rat_le_one (h : ∥(r : ℚ_[p])∥ ≤ 1) :
  ∃ n : ℤ, 0 ≤ n ∧ n < p ∧ ∥(⟨r,h⟩ - n : ℤ_[p])∥ < 1 :=
⟨mod_part p r, mod_part_nonneg _, mod_part_lt_p _, norm_sub_mod_part _ h⟩

lemma zmod_congr_of_sub_mem_span_aux (n : ℕ) (x : ℤ_[p]) (a b : ℤ)
  (ha : x - a ∈ (ideal.span {p ^ n} : ideal ℤ_[p]))
  (hb : x - b ∈ (ideal.span {p ^ n} : ideal ℤ_[p])) :
  (a : zmod (p ^ n)) = b :=
begin
  rw [ideal.mem_span_singleton] at ha hb,
  rw [← sub_eq_zero, ← int.cast_sub,
      zmod.int_coe_zmod_eq_zero_iff_dvd, int.coe_nat_pow],
  rw [← dvd_neg, neg_sub] at ha,
  have := dvd_add ha hb,
  rwa [sub_eq_add_neg, sub_eq_add_neg, add_assoc, neg_add_cancel_left,
      ← sub_eq_add_neg, ← int.cast_sub, pow_p_dvd_int_iff] at this,
end

lemma zmod_congr_of_sub_mem_span (n : ℕ) (x : ℤ_[p]) (a b : ℕ)
  (ha : x - a ∈ (ideal.span {p ^ n} : ideal ℤ_[p]))
  (hb : x - b ∈ (ideal.span {p ^ n} : ideal ℤ_[p])) :
  (a : zmod (p ^ n)) = b :=
zmod_congr_of_sub_mem_span_aux n x a b ha hb

lemma zmod_congr_of_sub_mem_max_ideal (x : ℤ_[p]) (m n : ℕ)
  (hm : x - m ∈ maximal_ideal ℤ_[p]) (hn : x - n ∈ maximal_ideal ℤ_[p]) :
  (m : zmod p) = n :=
begin
  rw maximal_ideal_eq_span_p at hm hn,
  have := zmod_congr_of_sub_mem_span_aux 1 x m n,
  simp only [pow_one] at this,
  specialize this hm hn,
  apply_fun zmod.cast_hom (show p ∣ p ^ 1, by rw pow_one) (zmod p) at this,
  simpa only [ring_hom.map_int_cast],
end

variable (x : ℤ_[p])
lemma exists_mem_range : ∃ n : ℕ, n < p ∧ (x - n ∈ maximal_ideal ℤ_[p]) :=
begin
  simp only [maximal_ideal_eq_span_p, ideal.mem_span_singleton, ← norm_lt_one_iff_dvd],
  obtain ⟨r, hr⟩ := rat_dense (x : ℚ_[p]) zero_lt_one,
  have H : ∥(r : ℚ_[p])∥ ≤ 1,
  { rw norm_sub_rev at hr,
    calc _ = ∥(r : ℚ_[p]) - x + x∥ : by ring_nf
       ... ≤ _ : padic_norm_e.nonarchimedean _ _
       ... ≤ _ :  max_le (le_of_lt hr) x.2 },
  obtain ⟨n, hzn, hnp, hn⟩ := exists_mem_range_of_norm_rat_le_one r H,
  lift n to ℕ using hzn,
  use n,
  split, {exact_mod_cast hnp},
  simp only [norm_def, coe_sub, subtype.coe_mk, coe_coe] at hn ⊢,
  rw show (x - n : ℚ_[p]) = (x - r) + (r - n), by ring,
  apply lt_of_le_of_lt (padic_norm_e.nonarchimedean _ _),
  apply max_lt hr,
  simpa using hn
end

/--
`zmod_repr x` is the unique natural number smaller than `p`
satisfying `∥(x - zmod_repr x : ℤ_[p])∥ < 1`.
-/
def zmod_repr : ℕ :=
classical.some (exists_mem_range x)

lemma zmod_repr_spec : zmod_repr x < p ∧ (x - zmod_repr x ∈ maximal_ideal ℤ_[p]) :=
classical.some_spec (exists_mem_range x)

lemma zmod_repr_lt_p : zmod_repr x < p := (zmod_repr_spec _).1

lemma sub_zmod_repr_mem : (x - zmod_repr x ∈ maximal_ideal ℤ_[p]) := (zmod_repr_spec _).2

/--
`to_zmod_hom` is an auxiliary constructor for creating ring homs from `ℤ_[p]` to `zmod v`.
-/
def to_zmod_hom (v : ℕ) (f : ℤ_[p] → ℕ) (f_spec : ∀ x, x - f x ∈ (ideal.span {v} : ideal ℤ_[p]))
  (f_congr : ∀ (x : ℤ_[p]) (a b : ℕ),
     x - a ∈ (ideal.span {v} : ideal ℤ_[p]) → x - b ∈ (ideal.span {v} : ideal ℤ_[p]) →
       (a : zmod v) = b) :
  ℤ_[p] →+* zmod v :=
{ to_fun := λ x, f x,
  map_zero' :=
  begin
    rw [f_congr (0 : ℤ_[p]) _ 0, cast_zero],
    { exact f_spec _ },
    { simp only [sub_zero, cast_zero, submodule.zero_mem], }
  end,
  map_one' :=
  begin
    rw [f_congr (1 : ℤ_[p]) _ 1, cast_one],
    { exact f_spec _ },
    { simp only [sub_self, cast_one, submodule.zero_mem], }
  end,
  map_add' :=
  begin
    intros x y,
    rw [f_congr (x + y) _ (f x + f y), cast_add],
    { exact f_spec _ },
    { convert ideal.add_mem _ (f_spec x) (f_spec y),
      rw cast_add,
      ring, }
  end,
  map_mul' :=
  begin
    intros x y,
    rw [f_congr (x * y) _ (f x * f y), cast_mul],
    { exact f_spec _ },
    { let I : ideal ℤ_[p] := ideal.span {v},
      convert I.add_mem (I.mul_mem_left x (f_spec y)) (I.mul_mem_right (f y) (f_spec x)),
      rw cast_mul,
      ring, }
  end, }

/--
`to_zmod` is a ring hom from `ℤ_[p]` to `zmod p`,
with the equality `to_zmod x = (zmod_repr x : zmod p)`.
-/
def to_zmod : ℤ_[p] →+* zmod p :=
to_zmod_hom p zmod_repr
  (by { rw ←maximal_ideal_eq_span_p, exact sub_zmod_repr_mem })
  (by { rw ←maximal_ideal_eq_span_p, exact zmod_congr_of_sub_mem_max_ideal } )

/--
`z - (to_zmod z : ℤ_[p])` is contained in the maximal ideal of `ℤ_[p]`, for every `z : ℤ_[p]`.

The coercion from `zmod p` to `ℤ_[p]` is `zmod.has_coe_t`,
which coerces `zmod p` into artibrary rings.
This is unfortunate, but a consequence of the fact that we allow `zmod p`
to coerce to rings of arbitrary characteristic, instead of only rings of characteristic `p`.
This coercion is only a ring homomorphism if it coerces into a ring whose characteristic divides
`p`. While this is not the case here we can still make use of the coercion.
-/
lemma to_zmod_spec (z : ℤ_[p]) : z - (to_zmod z : ℤ_[p]) ∈ maximal_ideal ℤ_[p] :=
begin
  convert sub_zmod_repr_mem z using 2,
  dsimp [to_zmod, to_zmod_hom],
  unfreezingI { rcases (exists_eq_add_of_lt (hp_prime.1.pos)) with ⟨p', rfl⟩ },
  change ↑(zmod.val _) = _,
  simp only [zmod.val_nat_cast, add_zero, add_def, nat.cast_inj, zero_add],
  apply mod_eq_of_lt,
  simpa only [zero_add] using zmod_repr_lt_p z,
end

lemma ker_to_zmod : (to_zmod : ℤ_[p] →+* zmod p).ker = maximal_ideal ℤ_[p] :=
begin
  ext x,
  rw ring_hom.mem_ker,
  split,
  { intro h,
    simpa only [h, zmod.cast_zero, sub_zero] using to_zmod_spec x, },
  { intro h,
    rw ← sub_zero x at h,
    dsimp [to_zmod, to_zmod_hom],
    convert zmod_congr_of_sub_mem_max_ideal x _ 0 _ h,
    apply sub_zmod_repr_mem, }
end

/-- `appr n x` gives a value `v : ℕ` such that `x` and `↑v : ℤ_p` are congruent mod `p^n`.
See `appr_spec`. -/
noncomputable def appr : ℤ_[p] → ℕ → ℕ
| x 0     := 0
| x (n+1) :=
let y := x - appr x n in
if hy : y = 0 then
  appr x n
else
  let u := unit_coeff hy in
  appr x n + p ^ n * (to_zmod ((u : ℤ_[p]) * (p ^ (y.valuation - n).nat_abs))).val

lemma appr_lt (x : ℤ_[p]) (n : ℕ) : x.appr n < p ^ n :=
begin
  induction n with n ih generalizing x,
  { simp only [appr, succ_pos', pow_zero], },
  simp only [appr, ring_hom.map_nat_cast, zmod.nat_cast_self, ring_hom.map_pow, int.nat_abs,
    ring_hom.map_mul],
  have hp : p ^ n < p ^ (n + 1),
  { apply pow_lt_pow hp_prime.1.one_lt (lt_add_one n) },
  split_ifs with h,
  { apply lt_trans (ih _) hp, },
  { calc _ < p ^ n + p ^ n * (p - 1) : _
    ... = p ^ (n + 1) : _,
    { apply add_lt_add_of_lt_of_le (ih _),
      apply nat.mul_le_mul_left,
      apply le_pred_of_lt,
      apply zmod.val_lt },
    { rw [mul_tsub, mul_one, ← pow_succ'],
      apply add_tsub_cancel_of_le (le_of_lt hp) } }
end

lemma appr_mono (x : ℤ_[p]) : monotone x.appr :=
begin
  apply monotone_nat_of_le_succ,
  intro n,
  dsimp [appr],
  split_ifs, { refl, },
  apply nat.le_add_right,
end

lemma dvd_appr_sub_appr (x : ℤ_[p]) (m n : ℕ) (h : m ≤ n) :
  p ^ m ∣ x.appr n - x.appr m :=
begin
  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le h, clear h,
  induction k with k ih,
  { simp only [add_zero, tsub_self, dvd_zero], },
  rw [nat.succ_eq_add_one, ← add_assoc],
  dsimp [appr],
  split_ifs with h,
  { exact ih },
  rw [add_comm, add_tsub_assoc_of_le (appr_mono _ (nat.le_add_right m k))],
  apply dvd_add _ ih,
  apply dvd_mul_of_dvd_left,
  apply pow_dvd_pow _ (nat.le_add_right m k),
end

lemma appr_spec (n : ℕ) : ∀ (x : ℤ_[p]), x - appr x n ∈ (ideal.span {p^n} : ideal ℤ_[p]) :=
begin
  simp only [ideal.mem_span_singleton],
  induction n with n ih,
  { simp only [is_unit_one, is_unit.dvd, pow_zero, forall_true_iff], },
  intro x,
  dsimp only [appr],
  split_ifs with h,
  { rw h, apply dvd_zero },
  push_cast, rw sub_add_eq_sub_sub,
  obtain ⟨c, hc⟩ := ih x,
  simp only [ring_hom.map_nat_cast, zmod.nat_cast_self, ring_hom.map_pow, ring_hom.map_mul,
    zmod.nat_cast_val],
  have hc' : c ≠ 0,
  { rintro rfl, simp only [mul_zero] at hc, contradiction },
  conv_rhs { congr, simp only [hc], },
  rw show (x - ↑(appr x n)).valuation = (↑p ^ n * c).valuation,
  { rw hc },
  rw [valuation_p_pow_mul _ _ hc', add_sub_cancel', pow_succ', ← mul_sub],
  apply mul_dvd_mul_left,
  obtain hc0 | hc0 := c.valuation.nat_abs.eq_zero_or_pos,
  { simp only [hc0, mul_one, pow_zero],
    rw [mul_comm, unit_coeff_spec h] at hc,
    suffices : c = unit_coeff h,
    { rw [← this, ← ideal.mem_span_singleton, ← maximal_ideal_eq_span_p],
      apply to_zmod_spec },
    obtain ⟨c, rfl⟩ : is_unit c, -- TODO: write a can_lift instance for units
    { rw int.nat_abs_eq_zero at hc0,
      rw [is_unit_iff, norm_eq_pow_val hc', hc0, neg_zero, zpow_zero], },
    rw discrete_valuation_ring.unit_mul_pow_congr_unit _ _ _ _ _ hc,
    exact irreducible_p },
  { rw zero_pow hc0,
    simp only [sub_zero, zmod.cast_zero, mul_zero],
    rw unit_coeff_spec hc',
    exact (dvd_pow_self _ hc0.ne').mul_left _ }
end

attribute [irreducible] appr

/-- A ring hom from `ℤ_[p]` to `zmod (p^n)`, with underlying function `padic_int.appr n`. -/
def to_zmod_pow (n : ℕ) : ℤ_[p] →+* zmod (p ^ n) :=
to_zmod_hom (p^n) (λ x, appr x n)
  (by { intros, convert appr_spec n _ using 1, simp })
  (by { intros x a b ha hb,
        apply zmod_congr_of_sub_mem_span n x a b,
        { simpa using ha },
        { simpa using hb } })

lemma ker_to_zmod_pow (n : ℕ) : (to_zmod_pow n : ℤ_[p] →+* zmod (p ^ n)).ker = ideal.span {p ^ n} :=
begin
  ext x,
  rw ring_hom.mem_ker,
  split,
  { intro h,
    suffices : x.appr n = 0,
    { convert appr_spec n x, simp only [this, sub_zero, cast_zero], },
    dsimp [to_zmod_pow, to_zmod_hom] at h,
    rw zmod.nat_coe_zmod_eq_zero_iff_dvd at h,
    apply eq_zero_of_dvd_of_lt h (appr_lt _ _), },
  { intro h,
    rw ← sub_zero x at h,
    dsimp [to_zmod_pow, to_zmod_hom],
    rw [zmod_congr_of_sub_mem_span n x _ 0 _ h, cast_zero],
    apply appr_spec, }
end

@[simp]

@[simp] lemma cast_to_zmod_pow (m n : ℕ) (h : m ≤ n) (x : ℤ_[p]) :
  ↑(to_zmod_pow n x) = to_zmod_pow m x :=
by { rw ← zmod_cast_comp_to_zmod_pow _ _ h, refl }

lemma dense_range_nat_cast :
  dense_range (nat.cast : ℕ → ℤ_[p]) :=
begin
  intro x,
  rw metric.mem_closure_range_iff,
  intros ε hε,
  obtain ⟨n, hn⟩ := exists_pow_neg_lt p hε,
  use (x.appr n),
  rw dist_eq_norm,
  apply lt_of_le_of_lt _ hn,
  rw norm_le_pow_iff_mem_span_pow,
  apply appr_spec,
end

lemma dense_range_int_cast :
  dense_range (int.cast : ℤ → ℤ_[p]) :=
begin
  intro x,
  apply dense_range_nat_cast.induction_on x,
  { exact is_closed_closure, },
  { intro a,
    change (a.cast : ℤ_[p]) with (a : ℤ).cast,
    apply subset_closure,
    exact set.mem_range_self _ }
end

end ring_homs

section lift
/-! ### Universal property as projective limit -/

open cau_seq padic_seq

variables {R : Type*} [comm_ring R] (f : Π k : ℕ, R →+* zmod (p^k))
  (f_compat : ∀ k1 k2 (hk : k1 ≤ k2), (zmod.cast_hom (pow_dvd_pow p hk) _).comp (f k2) = f k1)

omit hp_prime

/--
Given a family of ring homs `f : Π n : ℕ, R →+* zmod (p ^ n)`,
`nth_hom f r` is an integer-valued sequence
whose `n`th value is the unique integer `k` such that `0 ≤ k < p ^ n`
and `f n r = (k : zmod (p ^ n))`.
-/
def nth_hom (r : R) : ℕ → ℤ :=
λ n, (f n r : zmod (p^n)).val

@[simp] lemma nth_hom_zero : nth_hom f 0 = 0 :=
by simp [nth_hom]; refl

variable {f}

include hp_prime
include f_compat

lemma pow_dvd_nth_hom_sub (r : R) (i j : ℕ) (h : i ≤ j) :
  ↑p ^ i ∣ nth_hom f r j - nth_hom f r i :=
begin
  specialize f_compat i j h,
  rw [← int.coe_nat_pow, ← zmod.int_coe_zmod_eq_zero_iff_dvd,
      int.cast_sub],
  dsimp [nth_hom],
  rw [← f_compat, ring_hom.comp_apply],
  have : fact (p ^ i > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
  have : fact (p ^ j > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
  unfreezingI { simp only [zmod.cast_id, zmod.cast_hom_apply, sub_self, zmod.nat_cast_val], },
end

lemma is_cau_seq_nth_hom (r : R): is_cau_seq (padic_norm p) (λ n, nth_hom f r n) :=
begin
  intros ε hε,
  obtain ⟨k, hk⟩ : ∃ k : ℕ, (p ^ - (↑(k : ℕ) : ℤ) : ℚ) < ε := exists_pow_neg_lt_rat p hε,
  use k,
  intros j hj,
  refine lt_of_le_of_lt _ hk,
  norm_cast,
  rw ← padic_norm.dvd_iff_norm_le,
  exact_mod_cast pow_dvd_nth_hom_sub f_compat r k j hj
end

/--
`nth_hom_seq f_compat r` bundles `padic_int.nth_hom f r`
as a Cauchy sequence of rationals with respect to the `p`-adic norm.
The `n`th value of the sequence is `((f n r).val : ℚ)`.
-/
def nth_hom_seq (r : R) : padic_seq p := ⟨λ n, nth_hom f r n, is_cau_seq_nth_hom f_compat r⟩

lemma nth_hom_seq_one : nth_hom_seq f_compat 1 ≈ 1 :=
begin
  intros ε hε,
  change _ < _ at hε,
  use 1,
  intros j hj,
  haveI : fact (1 < p^j) := ⟨nat.one_lt_pow _ _ (by linarith) hp_prime.1.one_lt⟩,
  simp [nth_hom_seq, nth_hom, zmod.val_one, hε],
end

lemma nth_hom_seq_add (r s : R) :
  nth_hom_seq f_compat (r + s) ≈ nth_hom_seq f_compat r + nth_hom_seq f_compat s :=
begin
  intros ε hε,
  obtain ⟨n, hn⟩ := exists_pow_neg_lt_rat p hε,
  use n,
  intros j hj,
  dsimp [nth_hom_seq],
  apply lt_of_le_of_lt _ hn,
  rw [← int.cast_add, ← int.cast_sub, ← padic_norm.dvd_iff_norm_le,
     ← zmod.int_coe_zmod_eq_zero_iff_dvd],
  dsimp [nth_hom],
  have : fact (p ^ n > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
  have : fact (p ^ j > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
  unfreezingI
  { simp only [int.cast_coe_nat, int.cast_add, ring_hom.map_add, int.cast_sub, zmod.nat_cast_val] },
  rw [zmod.cast_add (show p ^ n ∣ p ^ j, from _), sub_self],
  { apply_instance },
  { apply pow_dvd_pow, linarith only [hj] },
end

lemma nth_hom_seq_mul (r s : R) :
  nth_hom_seq f_compat (r * s) ≈ nth_hom_seq f_compat r * nth_hom_seq f_compat s :=
begin
  intros ε hε,
  obtain ⟨n, hn⟩ := exists_pow_neg_lt_rat p hε,
  use n,
  intros j hj,
  dsimp [nth_hom_seq],
  apply lt_of_le_of_lt _ hn,
  rw [← int.cast_mul, ← int.cast_sub, ← padic_norm.dvd_iff_norm_le,
     ← zmod.int_coe_zmod_eq_zero_iff_dvd],
  dsimp [nth_hom],
  have : fact (p ^ n > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
  have : fact (p ^ j > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
  unfreezingI
  { simp only [int.cast_coe_nat, int.cast_mul, int.cast_sub, ring_hom.map_mul, zmod.nat_cast_val] },
  rw [zmod.cast_mul (show p ^ n ∣ p ^ j, from _), sub_self],
  { apply_instance },
  { apply pow_dvd_pow, linarith only [hj] },
end

/--
`lim_nth_hom f_compat r` is the limit of a sequence `f` of compatible ring homs `R →+* zmod (p^k)`.
This is itself a ring hom: see `padic_int.lift`.
-/
def lim_nth_hom (r : R) : ℤ_[p] :=
of_int_seq (nth_hom f r) (is_cau_seq_nth_hom f_compat r)

lemma lim_nth_hom_spec (r : R) :
  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n ≥ N, ∥lim_nth_hom f_compat r - nth_hom f r n∥ < ε :=
begin
  intros ε hε,
  obtain ⟨ε', hε'0, hε'⟩ : ∃ v : ℚ, (0 : ℝ) < v ∧ ↑v < ε := exists_rat_btwn hε,
  norm_cast at hε'0,
  obtain ⟨N, hN⟩ := padic_norm_e.defn (nth_hom_seq f_compat r) hε'0,
  use N,
  intros n hn,
  apply lt_trans _ hε',
  change ↑(padic_norm_e _) < _,
  norm_cast,
  convert hN _ hn,
  simp [nth_hom, lim_nth_hom, nth_hom_seq, of_int_seq],
end

lemma lim_nth_hom_zero : lim_nth_hom f_compat 0 = 0 :=
by simp [lim_nth_hom]; refl

lemma lim_nth_hom_one : lim_nth_hom f_compat 1 = 1 :=
subtype.ext $ quot.sound $ nth_hom_seq_one _

lemma lim_nth_hom_add (r s : R) :
  lim_nth_hom f_compat (r + s) = lim_nth_hom f_compat r + lim_nth_hom f_compat s :=
subtype.ext $ quot.sound $ nth_hom_seq_add _ _ _

lemma lim_nth_hom_mul (r s : R) :
  lim_nth_hom f_compat (r * s) = lim_nth_hom f_compat r * lim_nth_hom f_compat s :=
subtype.ext $ quot.sound $ nth_hom_seq_mul _ _ _

-- TODO: generalize this to arbitrary complete discrete valuation rings
/--
`lift f_compat` is the limit of a sequence `f` of compatible ring homs `R →+* zmod (p^k)`,
with the equality `lift f_compat r = padic_int.lim_nth_hom f_compat r`.
-/
def lift : R →+* ℤ_[p] :=
{ to_fun := lim_nth_hom f_compat,
  map_one' := lim_nth_hom_one f_compat,
  map_mul' := lim_nth_hom_mul f_compat,
  map_zero' := lim_nth_hom_zero f_compat,
  map_add' := lim_nth_hom_add f_compat }

omit f_compat

lemma lift_sub_val_mem_span (r : R) (n : ℕ) :
  (lift f_compat r - (f n r).val) ∈ (ideal.span {↑p ^ n} : ideal ℤ_[p]) :=
begin
  obtain ⟨k, hk⟩ := lim_nth_hom_spec f_compat r _
    (show (0 : ℝ) < p ^ (-n : ℤ), from nat.zpow_pos_of_pos hp_prime.1.pos _),
  have := le_of_lt (hk (max n k) (le_max_right _ _)),
  rw norm_le_pow_iff_mem_span_pow at this,
  dsimp [lift],
  rw sub_eq_sub_add_sub (lim_nth_hom f_compat r) _ ↑(nth_hom f r (max n k)),
  apply ideal.add_mem _ _ this,
  rw [ideal.mem_span_singleton],
  simpa only [ring_hom.eq_int_cast, ring_hom.map_pow, int.cast_sub] using
    (int.cast_ring_hom ℤ_[p]).map_dvd
      (pow_dvd_nth_hom_sub f_compat r n (max n k) (le_max_left _ _)),
end

/--
One part of the universal property of `ℤ_[p]` as a projective limit.
See also `padic_int.lift_unique`.
-/
lemma lift_spec (n : ℕ) : (to_zmod_pow n).comp (lift f_compat) = f n :=
begin
  ext r,
  haveI : fact (0 < p ^ n) := ⟨pow_pos hp_prime.1.pos n⟩,
  rw [ring_hom.comp_apply, ← zmod.nat_cast_zmod_val (f n r), ← (to_zmod_pow n).map_nat_cast,
      ← sub_eq_zero, ← ring_hom.map_sub, ← ring_hom.mem_ker, ker_to_zmod_pow],
  apply lift_sub_val_mem_span,
end

/--
One part of the universal property of `ℤ_[p]` as a projective limit.
See also `padic_int.lift_spec`.
-/
lemma lift_unique (g : R →+* ℤ_[p]) (hg : ∀ n, (to_zmod_pow n).comp g = f n) :
  lift f_compat = g :=
begin
  ext1 r,
  apply eq_of_forall_dist_le,
  intros ε hε,
  obtain ⟨n, hn⟩ := exists_pow_neg_lt p hε,
  apply le_trans _ (le_of_lt hn),
  rw [dist_eq_norm, norm_le_pow_iff_mem_span_pow, ← ker_to_zmod_pow, ring_hom.mem_ker,
      ring_hom.map_sub, ← ring_hom.comp_apply, ← ring_hom.comp_apply, lift_spec, hg, sub_self],
end

@[simp] lemma lift_self (z : ℤ_[p]) : @lift p _ ℤ_[p] _ to_zmod_pow
  zmod_cast_comp_to_zmod_pow z = z :=
begin
  show _ = ring_hom.id _ z,
  rw @lift_unique p _ ℤ_[p] _ _ zmod_cast_comp_to_zmod_pow (ring_hom.id ℤ_[p]),
  intro, rw ring_hom.comp_id,
end

end lift

lemma ext_of_to_zmod_pow {x y : ℤ_[p]} :
  (∀ n, to_zmod_pow n x = to_zmod_pow n y) ↔ x = y :=
begin
  split,
  { intro h,
    rw [← lift_self x, ← lift_self y],
    simp [lift, lim_nth_hom, nth_hom, h] },
  { rintro rfl _, refl }
end

lemma to_zmod_pow_eq_iff_ext {R : Type*} [comm_ring R] {g g' : R →+* ℤ_[p]} :
  (∀ n, (to_zmod_pow n).comp g = (to_zmod_pow n).comp g') ↔ g = g' :=
begin
  split,
  { intro hg,
    ext x : 1,
    apply ext_of_to_zmod_pow.mp,
    intro n,
    show (to_zmod_pow n).comp g x = (to_zmod_pow n).comp g' x,
    rw hg n },
  { rintro rfl _, refl }
end

end padic_int


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import topology.continuous_function.bounded
import topology.continuous_function.cocompact_map

/-!
# Continuous functions vanishing at infinity

The type of continuous functions vanishing at infinity. When the domain is compact
`C(α, β) ≃ C₀(α, β)` via the identity map. When the codomain is a metric space, every continuous
map which vanishes at infinity is a bounded continuous function. When the domain is a locally
compact space, this type has nice properties.

## TODO

* Create more intances of algebraic structures (e.g., `non_unital_semiring`) once the necessary
  type classes (e.g., `topological_ring`) are sufficiently generalized.
* Relate the unitization of `C₀(α, β)` to the Alexandroff compactification.
-/
universes u v w

variables {F : Type*} {α : Type u} {β : Type v} {γ : Type w} [topological_space α]

open_locale bounded_continuous_function topological_space
open filter metric

/-- `C₀(α, β)` is the type of continuous functions `α → β` which vanish at infinity from a
topological space to a metric space with a zero element.

When possible, instead of parametrizing results over `(f : C₀(α, β))`,
you should parametrize over `(F : Type*) [zero_at_infty_continuous_map_class F α β] (f : F)`.

When you extend this structure, make sure to extend `zero_at_infty_continuous_map_class`. -/
structure zero_at_infty_continuous_map (α : Type u) (β : Type v)
  [topological_space α] [has_zero β] [topological_space β] extends continuous_map α β :
  Type (max u v) :=
(zero_at_infty' : tendsto to_fun (cocompact α) (𝓝 0))

localized "notation [priority 2000] `C₀(` α `, ` β `)` := zero_at_infty_continuous_map α β"
  in zero_at_infty
localized "notation α ` →C₀ ` β := zero_at_infty_continuous_map α β" in zero_at_infty

/-- `zero_at_infty_continuous_map_class F α β` states that `F` is a type of continuous maps which
vanish at infinity.

You should also extend this typeclass when you extend `zero_at_infty_continuous_map`. -/
class zero_at_infty_continuous_map_class (F : Type*) (α β : out_param $ Type*) [topological_space α]
  [has_zero β] [topological_space β] extends continuous_map_class F α β :=
(zero_at_infty (f : F) : tendsto f (cocompact α) (𝓝 0))

export zero_at_infty_continuous_map_class (zero_at_infty)

namespace zero_at_infty_continuous_map

section basics

variables [topological_space β] [has_zero β] [zero_at_infty_continuous_map_class F α β]

instance : zero_at_infty_continuous_map_class C₀(α, β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_continuous := λ f, f.continuous_to_fun,
  zero_at_infty := λ f, f.zero_at_infty' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun C₀(α, β) (λ _, α → β) := fun_like.has_coe_to_fun

instance : has_coe_t F C₀(α, β) :=
⟨λ f, { to_fun := f, continuous_to_fun := map_continuous f, zero_at_infty' := zero_at_infty f }⟩

@[simp] lemma coe_to_continuous_fun (f : C₀(α, β)) : (f.to_continuous_map : α → β) = f := rfl

@[ext] lemma ext {f g : C₀(α, β)} (h : ∀ x, f x = g x) : f = g := fun_like.ext _ _ h

/-- Copy of a `zero_at_infinity_continuous_map` with a new `to_fun` equal to the old one. Useful
to fix definitional equalities. -/
protected def copy (f : C₀(α, β)) (f' : α → β) (h : f' = f) : C₀(α, β) :=
{ to_fun := f',
  continuous_to_fun := by { rw h, exact f.continuous_to_fun },
  zero_at_infty' := by { simp_rw h, exact f.zero_at_infty' } }

lemma eq_of_empty [is_empty α] (f g : C₀(α, β)) : f = g :=
ext $ is_empty.elim ‹_›

/-- A continuous function on a compact space is automatically a continuous function vanishing at
infinity. -/
@[simps]
def continuous_map.lift_zero_at_infty [compact_space α] : C(α, β) ≃ C₀(α, β) :=
{ to_fun := λ f, { to_fun := f, continuous_to_fun := f.continuous, zero_at_infty' := by simp },
  inv_fun := λ f, f,
  left_inv := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl } }

/-- A continuous function on a compact space is automatically a continuous function vanishing at
infinity. This is not an instance to avoid type class loops. -/
@[simps]
def zero_at_infty_continuous_map_class.of_compact {G : Type*} [continuous_map_class G α β]
  [compact_space α] : zero_at_infty_continuous_map_class G α β :=
{ coe := λ g, g,
  coe_injective' := λ f g h, fun_like.coe_fn_eq.mp h,
  map_continuous := map_continuous,
  zero_at_infty := by simp }

end basics

/-! ### Algebraic structure

Whenever `β` has suitable algebraic structure and a compatible topological structure, then
`C₀(α, β)` inherits a corresponding algebraic structure. The primary exception to this is that
`C₀(α, β)` will not have a multiplicative identity.
-/

section algebraic_structure

variables [topological_space β] (x : α)

instance [has_zero β] : has_zero C₀(α, β) := ⟨⟨0, tendsto_const_nhds⟩⟩

instance [has_zero β] : inhabited C₀(α, β) := ⟨0⟩

@[simp] lemma coe_zero [has_zero β] : ⇑(0 : C₀(α, β)) = 0 := rfl
lemma zero_apply [has_zero β] : (0 : C₀(α, β)) x = 0 := rfl

instance [mul_zero_class β] [has_continuous_mul β] : has_mul C₀(α, β) :=
⟨λ f g, ⟨f * g, by simpa only [mul_zero] using (zero_at_infty f).mul (zero_at_infty g)⟩⟩

@[simp] lemma coe_mul [mul_zero_class β] [has_continuous_mul β] (f g : C₀(α, β)) :
  ⇑(f * g) = f * g := rfl
lemma mul_apply [mul_zero_class β] [has_continuous_mul β] (f g : C₀(α, β)) :
  (f * g) x = f x * g x := rfl

instance [mul_zero_class β] [has_continuous_mul β] : mul_zero_class C₀(α, β) :=
fun_like.coe_injective.mul_zero_class _ coe_zero coe_mul

instance [semigroup_with_zero β] [has_continuous_mul β] : semigroup_with_zero C₀(α, β) :=
fun_like.coe_injective.semigroup_with_zero _ coe_zero coe_mul

instance [add_zero_class β] [has_continuous_add β] : has_add C₀(α, β) :=
⟨λ f g, ⟨f + g, by simpa only [add_zero] using (zero_at_infty f).add (zero_at_infty g)⟩⟩

@[simp] lemma coe_add [add_zero_class β] [has_continuous_add β] (f g : C₀(α, β)) :
  ⇑(f + g) = f + g := rfl
lemma add_apply [add_zero_class β] [has_continuous_add β] (f g : C₀(α, β)) :
  (f + g) x = f x + g x := rfl

instance [add_zero_class β] [has_continuous_add β] : add_zero_class C₀(α, β) :=
fun_like.coe_injective.add_zero_class _ coe_zero coe_add

section add_monoid

variables [add_monoid β] [has_continuous_add β] (f g : C₀(α, β))

@[simp] lemma coe_nsmul_rec : ∀ n, ⇑(nsmul_rec n f) = n • f
| 0 := by rw [nsmul_rec, zero_smul, coe_zero]
| (n + 1) := by rw [nsmul_rec, succ_nsmul, coe_add, coe_nsmul_rec]

instance has_nat_scalar : has_scalar ℕ C₀(α, β) :=
⟨λ n f, ⟨n • f, by simpa [coe_nsmul_rec] using zero_at_infty (nsmul_rec n f)⟩⟩

instance : add_monoid C₀(α, β) :=
fun_like.coe_injective.add_monoid _ coe_zero coe_add (λ _ _, rfl)

end add_monoid

instance [add_comm_monoid β] [has_continuous_add β] : add_comm_monoid C₀(α, β) :=
fun_like.coe_injective.add_comm_monoid _ coe_zero coe_add (λ _ _, rfl)

section add_group

variables [add_group β] [topological_add_group β] (f g : C₀(α, β))

instance : has_neg C₀(α, β) :=
⟨λ f, ⟨-f, by simpa only [neg_zero] using (zero_at_infty f).neg⟩⟩

@[simp] lemma coe_neg : ⇑(-f) = -f := rfl
lemma neg_apply : (-f) x = -f x := rfl

instance : has_sub C₀(α, β) :=
⟨λ f g, ⟨f - g, by simpa only [sub_zero] using (zero_at_infty f).sub (zero_at_infty g)⟩⟩

@[simp]

@[simp] lemma coe_zsmul_rec : ∀ z, ⇑(zsmul_rec z f) = z • f
| (int.of_nat n) := by rw [zsmul_rec, int.of_nat_eq_coe, coe_nsmul_rec, coe_nat_zsmul]
| -[1+ n] := by rw [zsmul_rec, zsmul_neg_succ_of_nat, coe_neg, coe_nsmul_rec]

instance has_int_scalar : has_scalar ℤ C₀(α, β) :=
⟨λ n f, ⟨n • f, by simpa using zero_at_infty (zsmul_rec n f)⟩⟩

instance : add_group C₀(α, β) :=
fun_like.coe_injective.add_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)

end add_group

instance [add_comm_group β] [topological_add_group β] : add_comm_group C₀(α, β) :=
fun_like.coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)

instance [has_zero β] {R : Type*} [has_zero R] [smul_with_zero R β]
  [has_continuous_const_smul R β] : has_scalar R C₀(α, β) :=
⟨λ r f, ⟨r • f, by simpa [smul_zero] using (zero_at_infty f).const_smul r⟩⟩

@[simp] lemma coe_smul [has_zero β] {R : Type*} [has_zero R] [smul_with_zero R β]
  [has_continuous_const_smul R β] (r : R) (f : C₀(α, β)) : ⇑(r • f) = r • f := rfl

lemma smul_apply [has_zero β] {R : Type*} [has_zero R] [smul_with_zero R β]
  [has_continuous_const_smul R β] (r : R) (f : C₀(α, β)) (x : α) : (r • f) x = r • f x := rfl

instance [has_zero β] {R : Type*} [has_zero R] [smul_with_zero R β]
  [has_continuous_const_smul R β] : smul_with_zero R C₀(α, β) :=
function.injective.smul_with_zero ⟨_, coe_zero⟩ fun_like.coe_injective coe_smul

instance [has_zero β] {R : Type*} [monoid_with_zero R] [mul_action_with_zero R β]
  [has_continuous_const_smul R β] : mul_action_with_zero R C₀(α, β) :=
function.injective.mul_action_with_zero ⟨_, coe_zero⟩ fun_like.coe_injective coe_smul

instance [add_comm_monoid β] [has_continuous_add β] {R : Type*} [semiring R] [module R β]
  [has_continuous_const_smul R β] : module R C₀(α, β) :=
function.injective.module R ⟨_, coe_zero, coe_add⟩ fun_like.coe_injective coe_smul

instance [non_unital_non_assoc_semiring β] [topological_semiring β] :
  non_unital_non_assoc_semiring C₀(α, β) :=
fun_like.coe_injective.non_unital_non_assoc_semiring _ coe_zero coe_add coe_mul (λ _ _, rfl)

instance [non_unital_semiring β] [topological_semiring β] :
  non_unital_semiring C₀(α, β) :=
fun_like.coe_injective.non_unital_semiring _ coe_zero coe_add coe_mul (λ _ _, rfl)

instance [non_unital_non_assoc_ring β] [topological_ring β] :
  non_unital_non_assoc_ring C₀(α, β) :=
fun_like.coe_injective.non_unital_non_assoc_ring _ coe_zero coe_add coe_mul coe_neg coe_sub
  (λ _ _, rfl) (λ _ _, rfl)

instance [non_unital_ring β] [topological_ring β] :
  non_unital_ring C₀(α, β) :=
fun_like.coe_injective.non_unital_ring _ coe_zero coe_add coe_mul coe_neg coe_sub (λ _ _, rfl)
  (λ _ _, rfl)

instance {R : Type*} [semiring R] [non_unital_non_assoc_semiring β] [topological_semiring β]
  [module R β] [has_continuous_const_smul R β] [is_scalar_tower R β β] :
  is_scalar_tower R C₀(α, β) C₀(α, β) :=
{ smul_assoc := λ r f g,
  begin
    ext,
    simp only [smul_eq_mul, coe_mul, coe_smul, pi.mul_apply, pi.smul_apply],
    rw [←smul_eq_mul, ←smul_eq_mul, smul_assoc],
  end }

instance {R : Type*} [semiring R] [non_unital_non_assoc_semiring β] [topological_semiring β]
  [module R β] [has_continuous_const_smul R β] [smul_comm_class R β β] :
  smul_comm_class R C₀(α, β) C₀(α, β) :=
{ smul_comm := λ r f g,
  begin
    ext,
    simp only [smul_eq_mul, coe_smul, coe_mul, pi.smul_apply, pi.mul_apply],
    rw [←smul_eq_mul, ←smul_eq_mul, smul_comm],
  end }

end algebraic_structure

/-! ### Metric structure

When `β` is a metric space, then every element of `C₀(α, β)` is bounded, and so there is a natural
inclusion map `zero_at_infty_continuous_map.to_bcf : C₀(α, β) → (α →ᵇ β)`. Via this map `C₀(α, β)`
inherits a metric as the pullback of the metric on `α →ᵇ β`. Moreover, this map has closed range
in `α →ᵇ β` and consequently `C₀(α, β)` is a complete space whenever `β` is complete.
-/

section metric

open metric set

variables [metric_space β] [has_zero β] [zero_at_infty_continuous_map_class F α β]

protected lemma bounded (f : F) : ∃ C, ∀ x y : α, dist ((f : α → β) x) (f y) ≤ C :=
begin
  obtain ⟨K : set α, hK₁, hK₂⟩ := mem_cocompact.mp (tendsto_def.mp (zero_at_infty (f : F)) _
    (closed_ball_mem_nhds (0 : β) zero_lt_one)),
  obtain ⟨C, hC⟩ := (hK₁.image (map_continuous f)).bounded.subset_ball (0 : β),
  refine ⟨max C 1 + max C 1, (λ x y, _)⟩,
  have : ∀ x, f x ∈ closed_ball (0 : β) (max C 1),
  { intro x,
    by_cases hx : x ∈ K,
    { exact (mem_closed_ball.mp $ hC ⟨x, hx, rfl⟩).trans (le_max_left _ _) },
    { exact (mem_closed_ball.mp $ mem_preimage.mp (hK₂ hx)).trans (le_max_right _ _) } },
  exact (dist_triangle (f x) 0 (f y)).trans
    (add_le_add (mem_closed_ball.mp $ this x) (mem_closed_ball'.mp $ this y)),
end

lemma bounded_range (f : C₀(α, β)) : bounded (range f) :=
bounded_range_iff.2 f.bounded

lemma bounded_image (f : C₀(α, β)) (s : set α) : bounded (f '' s) :=
f.bounded_range.mono $ image_subset_range _ _

@[priority 100]
instance : bounded_continuous_map_class F α β :=
{ map_bounded := λ f, zero_at_infty_continuous_map.bounded f }

/-- Construct a bounded continuous function from a continuous function vanishing at infinity. -/
@[simps]
def to_bcf (f : C₀(α, β)) : α →ᵇ β :=
⟨f, map_bounded f⟩

section
variables (α) (β)
lemma to_bcf_injective :
  function.injective (to_bcf : C₀(α, β) → α →ᵇ β) :=
λ f g h, by { ext, simpa only using fun_like.congr_fun h x, }
end

variables {C : ℝ} {f g : C₀(α, β)}

/-- The type of continuous functions vanishing at infinity, with the uniform distance induced by the
inclusion `zero_at_infinity_continuous_map.to_bcf`, is a metric space. -/
noncomputable instance : metric_space C₀(α, β) :=
metric_space.induced _ (to_bcf_injective α β) (by apply_instance)

@[simp]
lemma dist_to_bcf_eq_dist {f g : C₀(α, β)} : dist f.to_bcf g.to_bcf = dist f g := rfl

open bounded_continuous_function

/-- Convergence in the metric on `C₀(α, β)` is uniform convergence. -/
lemma tendsto_iff_tendsto_uniformly {ι : Type*} {F : ι → C₀(α, β)} {f : C₀(α, β)} {l : filter ι} :
  tendsto F l (𝓝 f) ↔ tendsto_uniformly (λ i, F i) f l :=
by simpa only [metric.tendsto_nhds] using @bounded_continuous_function.tendsto_iff_tendsto_uniformly
  _ _ _ _ _ (λ i, (F i).to_bcf) f.to_bcf l

lemma isometry_to_bcf : isometry (to_bcf : C₀(α, β) → α →ᵇ β) := by tauto

lemma closed_range_to_bcf : is_closed (range (to_bcf : C₀(α, β) → α →ᵇ β)) :=
begin
  refine is_closed_iff_cluster_pt.mpr (λ f hf, _),
  rw cluster_pt_principal_iff at hf,
  have : tendsto f (cocompact α) (𝓝 0),
  { refine metric.tendsto_nhds.mpr (λ ε hε, _),
    obtain ⟨_, hg, g, rfl⟩ := hf (ball f (ε / 2)) (ball_mem_nhds f $ half_pos hε),
    refine (metric.tendsto_nhds.mp (zero_at_infty g) (ε / 2)
      (half_pos hε)).mp (eventually_of_forall $ λ x hx, _),
    calc dist (f x) 0 ≤ dist (g.to_bcf x) (f x) + dist (g x) 0 : dist_triangle_left _ _ _
    ...               < dist g.to_bcf f + ε / 2 : add_lt_add_of_le_of_lt (dist_coe_le_dist x) hx
    ...               < ε : by simpa [add_halves ε] using add_lt_add_right hg (ε / 2) },
  exact ⟨⟨f.to_continuous_map, this⟩, by {ext, refl}⟩,
end

/-- Continuous functions vanishing at infinity taking values in a complete space form a
complete space. -/
instance [complete_space β] : complete_space C₀(α, β) :=
(complete_space_iff_is_complete_range isometry_to_bcf.uniform_inducing).mpr
  closed_range_to_bcf.is_complete

end metric

section norm

/-! ### Normed space

The norm structure on `C₀(α, β)` is the one induced by the inclusion `to_bcf : C₀(α, β) → (α →ᵇ b)`,
viewed as an additive monoid homomorphism. Then `C₀(α, β)` is naturally a normed space over a normed
field `𝕜` whenever `β` is as well.
-/

section normed_space

variables [normed_group β] {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]

/-- The natural inclusion `to_bcf : C₀(α, β) → (α →ᵇ β)` realized as an additive monoid
homomorphism. -/
def to_bcf_add_monoid_hom : C₀(α, β) →+ (α →ᵇ β) :=
{ to_fun := to_bcf,
  map_zero' := rfl,
  map_add' := λ x y, rfl }

@[simp]
lemma coe_to_bcf_add_monoid_hom (f : C₀(α, β)) : (f.to_bcf_add_monoid_hom : α → β) = f := rfl

noncomputable instance : normed_group C₀(α, β) :=
normed_group.induced to_bcf_add_monoid_hom (to_bcf_injective α β)

@[simp]
lemma norm_to_bcf_eq_norm {f : C₀(α, β)} : ∥f.to_bcf∥ = ∥f∥ := rfl

instance : normed_space 𝕜 C₀(α, β) :=
{ norm_smul_le := λ k f, (norm_smul k f.to_bcf).le }

end normed_space

section normed_ring

variables [non_unital_normed_ring β]

noncomputable instance : non_unital_normed_ring C₀(α, β) :=
{ norm_mul := λ f g, norm_mul_le f.to_bcf g.to_bcf,
  ..zero_at_infty_continuous_map.non_unital_ring,
  ..zero_at_infty_continuous_map.normed_group }

end normed_ring

end norm

section star

/-! ### Star structure

It is possible to equip `C₀(α, β)` with a pointwise `star` operation whenever there is a continuous
`star : β → β` for which `star (0 : β) = 0`. However, we have no such minimal type classes (e.g.,
`has_continuous_star` or `star_zero_class`) and so the type class assumptions on `β` sufficient to
guarantee these conditions are `[normed_group β]`, `[star_add_monoid β]` and
`[normed_star_group β]`, which allow for the corresponding classes on `C₀(α, β)` essentially
inherited from their counterparts on `α →ᵇ β`. Ultimately, when `β` is a C⋆-ring, then so is
`C₀(α, β)`.
-/

variables [normed_group β] [star_add_monoid β] [normed_star_group β]

instance : has_star C₀(α, β) :=
{ star := λ f,
  { to_fun := λ x, star (f x),
    continuous_to_fun := (map_continuous f).star,
    zero_at_infty' := by simpa only [star_zero]
      using (continuous_star.tendsto (0 : β)).comp (zero_at_infty f) } }

@[simp]
lemma coe_star (f : C₀(α, β)) : ⇑(star f) = star f := rfl

lemma star_apply (f : C₀(α, β)) (x : α) :
  (star f) x = star (f x) := rfl

instance : star_add_monoid C₀(α, β) :=
{ star_involutive := λ f, ext $ λ x, star_star (f x),
  star_add := λ f g, ext $ λ x, star_add (f x) (g x) }

instance : normed_star_group C₀(α, β) :=
{ norm_star := λ f, @norm_star _ _ _ _ f.to_bcf }

end star

section star_module

variables {𝕜 : Type*} [semiring 𝕜] [has_star 𝕜]
  [normed_group β] [star_add_monoid β] [normed_star_group β]
  [module 𝕜 β] [has_continuous_const_smul 𝕜 β] [star_module 𝕜 β]

instance : star_module 𝕜 C₀(α, β) :=
{ star_smul := λ k f, ext $ λ x, star_smul k (f x) }

end star_module

section star_ring

variables [non_unital_normed_ring β] [star_ring β]

instance [normed_star_group β] : star_ring C₀(α, β) :=
{ star_mul := λ f g, ext $ λ x, star_mul (f x) (g x),
  ..zero_at_infty_continuous_map.star_add_monoid }

instance [cstar_ring β] : cstar_ring C₀(α, β) :=
{ norm_star_mul_self := λ f, @cstar_ring.norm_star_mul_self _ _ _ _ f.to_bcf }

end star_ring

/-! ### C₀ as a functor

For each `β` with sufficient structure, there is a contravariant functor `C₀(-, β)` from the
category of topological spaces with morphisms given by `cocompact_map`s.
-/

variables {δ : Type*} [topological_space β] [topological_space γ] [topological_space δ]

local notation α ` →co ` β := cocompact_map α β

section
variables [has_zero δ]

/-- Composition of a continuous function vanishing at infinity with a cocompact map yields another
continuous function vanishing at infinity. -/
def comp (f : C₀(γ, δ)) (g : β →co γ) : C₀(β, δ) :=
{ to_continuous_map := (f : C(γ, δ)).comp g,
  zero_at_infty' := (zero_at_infty f).comp (cocompact_tendsto g) }

@[simp] lemma coe_comp_to_continuous_fun (f : C₀(γ, δ)) (g : β →co γ) :
  ((f.comp g).to_continuous_map : β → δ) = f ∘ g := rfl

@[simp] lemma comp_id (f : C₀(γ, δ)) : f.comp (cocompact_map.id γ) = f := ext (λ x, rfl)

@[simp] lemma comp_assoc (f : C₀(γ, δ)) (g : β →co γ) (h : α →co β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl

@[simp] lemma zero_comp (g : β →co γ) : (0 : C₀(γ, δ)).comp g = 0 := rfl

end

/-- Composition as an additive monoid homomorphism. -/
def comp_add_monoid_hom [add_monoid δ] [has_continuous_add δ] (g : β →co γ) :
  C₀(γ, δ) →+ C₀(β, δ) :=
{ to_fun := λ f, f.comp g,
  map_zero' := zero_comp g,
  map_add' := λ f₁ f₂, rfl }

/-- Composition as a semigroup homomorphism. -/
def comp_mul_hom [mul_zero_class δ] [has_continuous_mul δ]
  (g : β →co γ) : mul_hom C₀(γ, δ) C₀(β, δ) :=
{ to_fun := λ f, f.comp g,
  map_mul' := λ f₁ f₂, rfl }

/-- Composition as a linear map. -/
def comp_linear_map [add_comm_monoid δ] [has_continuous_add δ] {R : Type*}
  [semiring R] [module R δ] [has_continuous_const_smul R δ] (g : β →co γ) :
  C₀(γ, δ) →ₗ[R] C₀(β, δ) :=
{ to_fun := λ f, f.comp g,
  map_add' := λ f₁ f₂, rfl,
  map_smul' := λ r f, rfl }

/-- Composition as a non-unital algebra homomorphism. -/
def comp_non_unital_alg_hom {R : Type*} [semiring R] [non_unital_non_assoc_semiring δ]
  [topological_semiring δ] [module R δ] [has_continuous_const_smul R δ] (g : β →co γ) :
  non_unital_alg_hom R C₀(γ, δ) C₀(β, δ) :=
{ to_fun := λ f, f.comp g,
  map_smul' := λ r f, rfl,
  map_zero' := rfl,
  map_add' := λ f₁ f₂, rfl,
  map_mul' := λ f₁ f₂, rfl }

end zero_at_infty_continuous_map


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.of_associative
import algebra.lie.ideal_operations

/-!
# Trivial Lie modules and Abelian Lie algebras

The action of a Lie algebra `L` on a module `M` is trivial if `⁅x, m⁆ = 0` for all `x ∈ L` and
`m ∈ M`. In the special case that `M = L` with the adjoint action, triviality corresponds to the
concept of an Abelian Lie algebra.

In this file we define these concepts and provide some related definitions and results.

## Main definitions

  * `lie_module.is_trivial`
  * `is_lie_abelian`
  * `commutative_ring_iff_abelian_lie_ring`
  * `lie_module.ker`
  * `lie_module.max_triv_submodule`
  * `lie_algebra.center`

## Tags

lie algebra, abelian, commutative, center
-/

universes u v w w₁ w₂

/-- A Lie (ring) module is trivial iff all brackets vanish. -/
class lie_module.is_trivial (L : Type v) (M : Type w) [has_bracket L M] [has_zero M] : Prop :=
(trivial : ∀ (x : L) (m : M), ⁅x, m⁆ = 0)

@[simp] lemma trivial_lie_zero (L : Type v) (M : Type w)
  [has_bracket L M] [has_zero M] [lie_module.is_trivial L M] (x : L) (m : M) : ⁅x, m⁆ = 0 :=
lie_module.is_trivial.trivial x m

/-- A Lie algebra is Abelian iff it is trivial as a Lie module over itself. -/
abbreviation is_lie_abelian (L : Type v) [has_bracket L L] [has_zero L] : Prop :=
lie_module.is_trivial L L

instance lie_ideal.is_lie_abelian_of_trivial (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L) [h : lie_module.is_trivial L I] :
  is_lie_abelian I :=
{ trivial := λ x y, by apply h.trivial }

lemma function.injective.is_lie_abelian {R : Type u} {L₁ : Type v} {L₂ : Type w}
  [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_algebra R L₁] [lie_algebra R L₂]
  {f : L₁ →ₗ⁅R⁆ L₂} (h₁ : function.injective f) (h₂ : is_lie_abelian L₂) :
  is_lie_abelian L₁ :=
{ trivial := λ x y, h₁ $
    calc f ⁅x,y⁆ = ⁅f x, f y⁆ : lie_hom.map_lie f x y
             ... = 0          : trivial_lie_zero _ _ _ _
             ... = f 0        : f.map_zero.symm }

lemma function.surjective.is_lie_abelian {R : Type u} {L₁ : Type v} {L₂ : Type w}
  [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_algebra R L₁] [lie_algebra R L₂]
  {f : L₁ →ₗ⁅R⁆ L₂} (h₁ : function.surjective f) (h₂ : is_lie_abelian L₁) :
  is_lie_abelian L₂ :=
{ trivial := λ x y,
    begin
      obtain ⟨u, rfl⟩ := h₁ x,
      obtain ⟨v, rfl⟩ := h₁ y,
      rw [← lie_hom.map_lie, trivial_lie_zero, lie_hom.map_zero],
    end }

lemma lie_abelian_iff_equiv_lie_abelian {R : Type u} {L₁ : Type v} {L₂ : Type w}
  [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_algebra R L₁] [lie_algebra R L₂]
  (e : L₁ ≃ₗ⁅R⁆ L₂) : is_lie_abelian L₁ ↔ is_lie_abelian L₂ :=
⟨e.symm.injective.is_lie_abelian, e.injective.is_lie_abelian⟩

lemma commutative_ring_iff_abelian_lie_ring {A : Type v} [ring A] :
  is_commutative A (*) ↔ is_lie_abelian A :=
have h₁ : is_commutative A (*) ↔ ∀ (a b : A), a * b = b * a := ⟨λ h, h.1, λ h, ⟨h⟩⟩,
have h₂ : is_lie_abelian A ↔ ∀ (a b : A), ⁅a, b⁆ = 0 := ⟨λ h, h.1, λ h, ⟨h⟩⟩,
by simp only [h₁, h₂, lie_ring.of_associative_ring_bracket, sub_eq_zero]

lemma lie_algebra.is_lie_abelian_bot (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] : is_lie_abelian (⊥ : lie_ideal R L) :=
⟨λ ⟨x, hx⟩ _, by convert zero_lie _⟩

section center

variables (R : Type u) (L : Type v) (M : Type w) (N : Type w₁)
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]

namespace lie_module

/-- The kernel of the action of a Lie algebra `L` on a Lie module `M` as a Lie ideal in `L`. -/
protected def ker : lie_ideal R L := (to_endomorphism R L M).ker

@[simp] protected

/-- The largest submodule of a Lie module `M` on which the Lie algebra `L` acts trivially. -/
def max_triv_submodule : lie_submodule R L M :=
{ carrier   := { m | ∀ (x : L), ⁅x, m⁆ = 0 },
  zero_mem' := λ x, lie_zero x,
  add_mem'  := λ x y hx hy z, by rw [lie_add, hx, hy, add_zero],
  smul_mem' := λ c x hx y, by rw [lie_smul, hx, smul_zero],
  lie_mem   := λ x m hm y, by rw [hm, lie_zero], }

@[simp] lemma mem_max_triv_submodule (m : M) :
  m ∈ max_triv_submodule R L M ↔ ∀ (x : L), ⁅x, m⁆ = 0 :=
iff.rfl

instance : is_trivial L (max_triv_submodule R L M) :=
{ trivial := λ x m, subtype.ext (m.property x), }

@[simp] lemma ideal_oper_max_triv_submodule_eq_bot (I : lie_ideal R L) :
  ⁅I, max_triv_submodule R L M⁆ = ⊥ :=
begin
  rw [← lie_submodule.coe_to_submodule_eq_iff, lie_submodule.lie_ideal_oper_eq_linear_span,
    lie_submodule.bot_coe_submodule, submodule.span_eq_bot],
  rintros m ⟨⟨x, hx⟩, ⟨⟨m, hm⟩, rfl⟩⟩,
  exact hm x,
end

lemma le_max_triv_iff_bracket_eq_bot {N : lie_submodule R L M} :
  N ≤ max_triv_submodule R L M ↔ ⁅(⊤ : lie_ideal R L), N⁆ = ⊥ :=
begin
  refine ⟨λ h, _, λ h m hm, _⟩,
  { rw [← le_bot_iff, ← ideal_oper_max_triv_submodule_eq_bot R L M ⊤],
    exact lie_submodule.mono_lie_right _ _ ⊤ h, },
  { rw mem_max_triv_submodule,
    rw lie_submodule.lie_eq_bot_iff at h,
    exact λ x, h x (lie_submodule.mem_top x) m hm, },
end

lemma trivial_iff_le_maximal_trivial (N : lie_submodule R L M) :
  is_trivial L N ↔ N ≤ max_triv_submodule R L M :=
⟨ λ h m hm x, is_trivial.dcases_on h (λ h, subtype.ext_iff.mp (h x ⟨m, hm⟩)),
  λ h, { trivial := λ x m, subtype.ext (h m.2 x) }⟩

lemma is_trivial_iff_max_triv_eq_top :
  is_trivial L M ↔ max_triv_submodule R L M = ⊤ :=
begin
  split,
  { rintros ⟨h⟩, ext,
    simp only [mem_max_triv_submodule, h, forall_const, true_iff, eq_self_iff_true], },
  { intros h, constructor, intros x m, revert x,
    rw [← mem_max_triv_submodule R L M, h], exact lie_submodule.mem_top m, },
end

variables {R L M N}

/-- `max_triv_submodule` is functorial. -/
def max_triv_hom (f : M →ₗ⁅R,L⁆ N) :
  max_triv_submodule R L M →ₗ⁅R,L⁆ max_triv_submodule R L N :=
{ to_fun    := λ m, ⟨f m, λ x, (lie_module_hom.map_lie _ _ _).symm.trans $
        (congr_arg f (m.property x)).trans (lie_module_hom.map_zero _)⟩,
  map_add'  := λ m n, by simpa,
  map_smul' := λ t m, by simpa,
  map_lie'  := λ x m, by simp, }

@[norm_cast, simp] lemma coe_max_triv_hom_apply
  (f : M →ₗ⁅R,L⁆ N) (m : max_triv_submodule R L M) :
  (max_triv_hom f m : N) = f m :=
rfl

/-- The maximal trivial submodules of Lie-equivalent Lie modules are Lie-equivalent. -/
def max_triv_equiv (e : M ≃ₗ⁅R,L⁆ N) :
  max_triv_submodule R L M ≃ₗ⁅R,L⁆ max_triv_submodule R L N :=
{ to_fun    := max_triv_hom (e : M →ₗ⁅R,L⁆ N),
  inv_fun   := max_triv_hom (e.symm : N →ₗ⁅R,L⁆ M),
  left_inv  := λ m, by { ext, simp, },
  right_inv := λ n, by { ext, simp, },
  .. max_triv_hom (e : M →ₗ⁅R,L⁆ N), }

@[norm_cast, simp] lemma coe_max_triv_equiv_apply
  (e : M ≃ₗ⁅R,L⁆ N) (m : max_triv_submodule R L M) :
  (max_triv_equiv e m : N) = e ↑m :=
rfl

@[simp] lemma max_triv_equiv_of_refl_eq_refl :
  max_triv_equiv (lie_module_equiv.refl : M ≃ₗ⁅R,L⁆ M) = lie_module_equiv.refl :=
by { ext, simp only [coe_max_triv_equiv_apply, lie_module_equiv.refl_apply], }

@[simp] lemma max_triv_equiv_of_equiv_symm_eq_symm (e : M ≃ₗ⁅R,L⁆ N) :
  (max_triv_equiv e).symm = max_triv_equiv e.symm :=
rfl

/-- A linear map between two Lie modules is a morphism of Lie modules iff the Lie algebra action
on it is trivial. -/
def max_triv_linear_map_equiv_lie_module_hom :
  (max_triv_submodule R L (M →ₗ[R] N)) ≃ₗ[R] (M →ₗ⁅R,L⁆ N) :=
{ to_fun    := λ f,
    { to_linear_map := f.val,
      map_lie' := λ x m, by
      { have hf : ⁅x, f.val⁆ m = 0, { rw [f.property x, linear_map.zero_apply], },
        rw [lie_hom.lie_apply, sub_eq_zero, ← linear_map.to_fun_eq_coe] at hf, exact hf.symm, }, },
  map_add'  := λ f g, by { ext, simp, },
  map_smul' := λ F G, by { ext, simp, },
  inv_fun   := λ F, ⟨F, λ x, by { ext, simp, }⟩,
  left_inv  := λ f, by simp,
  right_inv := λ F, by simp, }

@[simp] lemma coe_max_triv_linear_map_equiv_lie_module_hom
  (f : max_triv_submodule R L (M →ₗ[R] N)) :
  ((max_triv_linear_map_equiv_lie_module_hom f) : M → N) = f :=
by { ext, refl, }

@[simp] lemma coe_max_triv_linear_map_equiv_lie_module_hom_symm
  (f : M →ₗ⁅R,L⁆ N) :
  ((max_triv_linear_map_equiv_lie_module_hom.symm f) : M → N) = f :=
rfl

@[simp] lemma coe_linear_map_max_triv_linear_map_equiv_lie_module_hom
  (f : max_triv_submodule R L (M →ₗ[R] N)) :
  ((max_triv_linear_map_equiv_lie_module_hom f) : M →ₗ[R] N) = (f : M →ₗ[R] N) :=
by { ext, refl, }

@[simp] lemma coe_linear_map_max_triv_linear_map_equiv_lie_module_hom_symm
  (f : M →ₗ⁅R,L⁆ N) :
  ((max_triv_linear_map_equiv_lie_module_hom.symm f) : M →ₗ[R] N) = (f : M →ₗ[R] N) :=
rfl

end lie_module

namespace lie_algebra

/-- The center of a Lie algebra is the set of elements that commute with everything. It can
be viewed as the maximal trivial submodule of the Lie algebra as a Lie module over itself via the
adjoint representation. -/
abbreviation center : lie_ideal R L := lie_module.max_triv_submodule R L L

instance : is_lie_abelian (center R L) := infer_instance

@[simp] lemma ad_ker_eq_self_module_ker : (ad R L).ker = lie_module.ker R L L := rfl

@[simp] lemma self_module_ker_eq_center : lie_module.ker R L L = center R L :=
begin
  ext y,
  simp only [lie_module.mem_max_triv_submodule, lie_module.mem_ker, ← lie_skew _ y, neg_eq_zero],
end

lemma abelian_of_le_center (I : lie_ideal R L) (h : I ≤ center R L) : is_lie_abelian I :=
begin
  haveI : lie_module.is_trivial L I := (lie_module.trivial_iff_le_maximal_trivial R L L I).mpr h,
  exact lie_ideal.is_lie_abelian_of_trivial R L I,
end

lemma is_lie_abelian_iff_center_eq_top : is_lie_abelian L ↔ center R L = ⊤ :=
lie_module.is_trivial_iff_max_triv_eq_top R L L

end lie_algebra

end center

section ideal_operations

open lie_submodule lie_subalgebra

variables {R : Type u} {L : Type v} {M : Type w}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]
variables (N N' : lie_submodule R L M) (I J : lie_ideal R L)

@[simp] lemma lie_submodule.trivial_lie_oper_zero [lie_module.is_trivial L M] : ⁅I, N⁆ = ⊥ :=
begin
  suffices : ⁅I, N⁆ ≤ ⊥, from le_bot_iff.mp this,
  rw [lie_ideal_oper_eq_span, lie_submodule.lie_span_le],
  rintros m ⟨x, n, h⟩, rw trivial_lie_zero at h, simp [← h],
end

lemma lie_submodule.lie_abelian_iff_lie_self_eq_bot : is_lie_abelian I ↔ ⁅I, I⁆ = ⊥ :=
begin
  simp only [_root_.eq_bot_iff, lie_ideal_oper_eq_span, lie_submodule.lie_span_le,
    lie_submodule.bot_coe, set.subset_singleton_iff, set.mem_set_of_eq, exists_imp_distrib],
  refine ⟨λ h z x y hz, hz.symm.trans (((I : lie_subalgebra R L).coe_bracket x y).symm.trans
    ((coe_zero_iff_zero _ _).mpr (by apply h.trivial))),
    λ h, ⟨λ x y, ((I : lie_subalgebra R L).coe_zero_iff_zero _).mp (h _ x y rfl)⟩⟩,
end

end ideal_operations


import util.data.set
import util.data.minimum.basic

namespace nat

namespace wf

variable (s : set ℕ)
variable (P : s ≠ ∅)

def gt (P : s ≠ ∅) (i j : ℕ) : Prop :=
(∀ k, k ∈ s → k > j) ∧ i > j

lemma gt_accessible'
: ∀ (x y z k : ℕ), z ∈ s → z ≤ k + x  → gt s P y x → acc (gt s P) y
| x y z 0 Hz V P :=
begin
  have h := P.left z Hz,
  exfalso,
  apply not_le_of_gt h,
  simp at V,
  apply V,
end
| x y z (succ k) Hz V P :=
begin
  apply acc.intro _ (λ y', gt_accessible' y y' z k Hz _),
  apply le_trans V,
  rw [succ_add,← add_succ],
  apply add_le_add_left,
  apply P.right,
end

lemma gt_accessible (x y : ℕ)
  (h : gt s P y x)
: acc (gt s P) y :=
begin
  have Hex : ∃ z, z ∈ s := set.exists_mem_of_ne_empty P,
  cases Hex with z hz,
  have hz_le_zxx : z ≤ z - x + x,
  { rw [nat.sub_add_cancel],
    apply le_of_lt,
    apply h.left _ hz, },
  apply gt_accessible' s P x y z (z - x) hz hz_le_zxx h
end

def gt_wf (P : s ≠ ∅) : well_founded (gt s P) :=
⟨ λ x, ⟨ _, gt_accessible s P x ⟩ ⟩

variable {s}

lemma gt_of_not_mem {i j : ℕ}
(h₀ : ∀ (x : ℕ), x ∈ s → j ≤ x)
(h₁ : j ∉ s)
(h₂ : i > j)
: gt s P i j :=
begin
  unfold wf.gt, split,
  { intros k h,
    apply lt_of_le_of_ne (h₀ _ h),
    intro, subst j,
    cases h₁ h, },
  { apply h₂ }
end

end wf

section

variables (s : set ℕ)
variables [decidable_pred (λ x, x ∈ s)]
variables (P : s ≠ ∅)

def minimum_aux
: Π i, (∀ j, j ∈ s → i ≤ j) → ℕ :=
well_founded.fix (wf.gt_wf s P) $ λ x f P',
  if h : x ∈ s
  then x
  else
    have h₀ : ∀ (j : ℕ), j ∈ s → succ x ≤ j,
      begin intros j h₁,
            apply succ_le_of_lt,
            apply lt_of_le_of_ne,
            { apply P' _ h₁ },
            { intro h₂, subst x, contradiction },
      end,
    f (succ x) ⟨h₀, lt_succ_self _⟩ h₀

variables [decidable (s = ∅)]

protected def minimum : ℕ :=
have h' : ∀ (j : ℕ), j ∈ s → 0 ≤ j,
   from assume j _, zero_le j,
if h : s = ∅ then 0
              else minimum_aux s h 0 h'

include P

lemma minimum.induction_aux (i : ℕ)
  {p : ℕ → Prop}
  (h₀ : ∀ i, (∀ j, j ∈ s → i ≤ j) → i ∈ s → p i)
  (h₁ : ∀ j, j ∈ s → i ≤ j)
: p (nat.minimum_aux s P i h₁) :=
begin
  revert h₁,
  apply well_founded.induction (wf.gt_wf s P) i _,
  intros i IH h₁,
  unfold minimum_aux,
  rw well_founded.fix_eq,
  cases decidable.em (i ∈ s) with h₂ h₂,
  { rw dif_pos h₂,
    apply h₀ _ h₁ h₂, },
  { rw dif_neg h₂,
    apply IH,
    apply wf.gt_of_not_mem _ h₁ h₂,
    apply lt_succ_self }
end

lemma minimum.induction
  (p : ℕ → Prop)
  (h : ∀ i, (∀ j, j ∈ s → i ≤ j) → i ∈ s → p i)
: p (nat.minimum s) :=
begin
  unfold nat.minimum,
  rw dif_neg P,
  apply minimum.induction_aux _ _ _ h,
end

end

section

parameter (s : set ℕ)
parameter [decidable_pred (λ x, x ∈ s)]
parameter (P : s ≠ ∅)
local infix ` ≻ `:50 := wf.gt s P

parameter [decidable (s = ∅)]

protected lemma minimum_mem
  (hnemp : s ≠ ∅)
: nat.minimum s ∈ s :=
begin
  apply nat.minimum.induction s hnemp (λ i, i ∈ s),
  intros i h₀ h₁, apply h₁,
end

protected lemma minimum_le
  (x : ℕ)
  (hmem : x ∈ s)
: nat.minimum s ≤ x :=
begin
  apply nat.minimum.induction s (set.ne_empty_of_mem hmem) (λ i, i ≤ x),
  intros i h₀ h₁, apply h₀ _ hmem,
end

protected lemma le_minimum_of_forall_le (x : ℕ)
  (h₀ : s ≠ ∅)
  (h₁ : ∀ (y : ℕ), y ∈ s → x ≤ y)
: x ≤ nat.minimum s :=
begin
  revert h₁,
  apply nat.minimum.induction s h₀ (λ i, (∀ (y : ℕ), y ∈ s → x ≤ y) → x ≤ i),
  intros i h₀ h₁ h₂,
  apply h₂ _ h₁,
end

end

end nat

local attribute [instance] classical.prop_decidable

noncomputable instance : has_minimum ℕ :=
{ (_ : partial_order ℕ) with
  minimum := λ s, nat.minimum s
, minimum_le := λ s, nat.minimum_le s
, le_minimum_of_forall_le := λ s, nat.le_minimum_of_forall_le s
, minimum_mem := λ s, nat.minimum_mem s }


class CommAddSemigroup (α : Type u) extends Add α where
    addComm : {a b : α} → a + b = b + a
    addAssoc : {a b c : α} → a + b + c = a + (b + c)

open CommAddSemigroup

theorem addComm3 [CommAddSemigroup α] {a b c : α} : a + b + c = a + c + b := by {
    have h : b + c = c + b := addComm;
    have h' := congrArg (a + .) h;
    simp at h';
    rw [←addAssoc] at h';
    rw [←addAssoc (a := a)] at h';
    exact h';
}

theorem addComm4 [CommAddSemigroup α] {a b c : α} : a + b + c = a + c + b := by {
    rw [addAssoc, addAssoc];
    rw [addComm (a := b)];
}

theorem addComm5 [CommAddSemigroup α] {a b c : α} : a + b + c = a + c + b := by {
    have h : b + c = c + b := addComm;
    have h' := congrArg (a + .) h;
    simp at h';
    rw [←addAssoc] at h';
    rw [←@addAssoc (a := a)] at h';
    exact h';
}

theorem addComm6 [CommAddSemigroup α] {a b c : α} : a + b + c = a + c + b := by {
    have h : b + c = c + b := addComm;
    have h' := congrArg (a + .) h;
    simp at h';
    rw [←addAssoc] at h';
    rw [←addAssoc] at h';
    exact h';
}


import linalg
  analysis.inner_product_space.basic

variables {V : Type}
[inner_product_space ℝ V] [finite_dimensional ℝ V]

def submodule_pair (V : Type)
[inner_product_space ℝ V] := Σ E : submodule ℝ V, {F : submodule ℝ V // F ≤ E}

def submodule_pair.big (M : submodule_pair V) : submodule ℝ V :=
M.fst

def submodule_pair.small (M : submodule_pair V) : submodule ℝ V :=
M.snd.val

def submodule_pair.le (M : submodule_pair V) :
M.small ≤ M.big := M.snd.property

def multiset.elem_le (C D : multiset (submodule ℝ V)) :=
∃ CD : multiset (submodule_pair V),
CD.map submodule_pair.small = C ∧
CD.map submodule_pair.big = D

reserve infix ` ⊑ₘ `:50
notation C ` ⊑ₘ ` D := multiset.elem_le C D

lemma elem_le_refl (C : multiset (submodule ℝ V)) : C ⊑ₘ C :=
begin
  refine ⟨C.map (λ W, ⟨W, ⟨W, le_refl W⟩⟩), _, _⟩,
  {
    simp only [submodule_pair.small, multiset.map_map, multiset.map_id'],
  },
  {
    simp only [submodule_pair.big, multiset.map_map, multiset.map_id'],
  },
end

/- lemma elem_le_antisymm {C D : multiset (submodule ℝ V)}
(CD : C ⊑ₘ D) (DC : D ⊑ₘ C) : C = D := sorry -/

lemma elem_le_trans {C D E : multiset (submodule ℝ V)}
(CD : C ⊑ₘ D) (DE : D ⊑ₘ E) : C ⊑ₘ E :=
begin
  obtain ⟨CD, hCD⟩ := CD,
  obtain ⟨DE, hDE⟩ := DE,
  obtain rfl := hDE.1,
  obtain ⟨T, TCD, TDE⟩ := multiset.exists_join' hCD.2,
  refine ⟨T.map (λ t, ⟨t.val.snd.big, ⟨t.val.fst.small, _⟩⟩), _⟩,
  {
    refine le_trans t.val.fst.le _,
    rw [t.property],
    exact t.val.snd.le,
  },
  {
    obtain rfl := TCD,
    obtain rfl := TDE,
    simp only [subtype.val_eq_coe, multiset.map_map, function.comp_app, eq_self_iff_true, true_and] at hCD hDE,
    simp only [submodule_pair.small, submodule_pair.big, subtype.val_eq_coe, multiset.map_map, function.comp_app, subtype.coe_mk],
    exact ⟨hCD.1, hDE⟩,
  },
end

lemma card_eq_of_elem_le {C D : multiset (submodule ℝ V)}
(CD : C ⊑ₘ D) : C.card = D.card :=
begin
  obtain ⟨CD, ⟨rfl, rfl⟩⟩ := CD,
  simp only [multiset.card_map],
end

lemma cons_elem_le_cons_head
{U W : submodule ℝ V} {C : multiset (submodule ℝ V)}
(h : U ≤ W) : U ::ₘ C ⊑ₘ W ::ₘ C :=
begin
  obtain ⟨X, ⟨hX₁, hX₂⟩⟩ := elem_le_refl C,
  refine ⟨⟨W, ⟨U, h⟩⟩ ::ₘ X, _, _⟩,
  {
    simp only [submodule_pair.small, subtype.val_eq_coe, multiset.map_cons, subtype.coe_mk, multiset.cons_inj_right],
    exact hX₁,
  },
  {
    simp only [submodule_pair.big, multiset.map_cons, multiset.cons_inj_right],
    exact hX₂,
  },
end

lemma add_elem_le_add {C D E F: multiset (submodule ℝ V)}
(CE : C ⊑ₘ E) (DF : D ⊑ₘ F) : C + D ⊑ₘ E + F :=
begin
  obtain ⟨X, ⟨rfl, rfl⟩⟩ := CE,
  obtain ⟨Y, ⟨rfl, rfl⟩⟩ := DF,
  refine ⟨X + Y, _, _⟩,
  all_goals {simp only [multiset.map_add]},
end

lemma add_elem_le_add_left {C D E : multiset (submodule ℝ V)}
(DE : D ⊑ₘ E) : C + D ⊑ₘ C + E :=
add_elem_le_add (elem_le_refl _) DE

lemma add_elem_le_add_right {C D E : multiset (submodule ℝ V)}
(DE : D ⊑ₘ E) : D + C ⊑ₘ E + C :=
add_elem_le_add DE (elem_le_refl _)

noncomputable def submodule_pair.proj_keep_big (E : submodule ℝ V)
(M : submodule_pair V) : submodule_pair E × submodule ℝ V :=
begin
  refine ⟨⟨project_subspace E M.big, _⟩, M.big⟩,
  refine ⟨project_subspace E M.small, _⟩,
  simp only [project_subspace],
  exact submodule.map_mono M.le,
end

noncomputable def submodule_pair.proj (E : submodule ℝ V)
(M : submodule_pair V) : submodule_pair E :=
begin
  refine ⟨project_subspace E M.big, project_subspace E M.small, _⟩,
  simp only [project_subspace],
  exact submodule.map_mono M.le,
end

--MOVETO linalg.lean
lemma exists_equiv_to_image
{W : Type} [inner_product_space ℝ W] [finite_dimensional ℝ V]
(E : submodule ℝ V)
(f : V →ₗ[ℝ] W) :
∃ (T : submodule ℝ V), T ≤ E ∧ T ⊓ f.ker = ⊥ ∧ T.map f = E.map f :=
begin
  let g := (f.dom_restrict E).range_restrict,
  -- linear_map.range_range_restrict
  obtain ⟨h, hh⟩ := g.exists_right_inverse_of_surjective (linear_map.range_range_restrict _),
  let H := h.range,
  refine ⟨H.map E.subtype, submodule.map_subtype_le _ _, _, _⟩,
  {
    rw [submodule.eq_bot_iff],
    intros x hx,
    rw [submodule.mem_inf, submodule.mem_map] at hx,
    obtain ⟨⟨y, yH, rfl⟩, hx⟩ := hx,
    rw [linear_map.mem_range] at yH,
    obtain ⟨z, rfl⟩ := yH,
    rw [linear_map.mem_ker, submodule.coe_subtype] at hx,
    simp only [submodule.coe_subtype, submodule.coe_eq_zero],
    simp only [linear_map.ext_iff, linear_map.id_coe, id.def] at hh,
    replace hh := hh z,
    simp only [g, linear_map.comp_apply, linear_map.range_restrict] at hh,
    replace hh := congr_arg (submodule.subtype _) hh,
    simp only [submodule.coe_subtype, linear_map.cod_restrict_apply, linear_map.dom_restrict_apply] at hh,
    rw [hh] at hx,
    have : (0 : W) = ↑(0 : (f.dom_restrict E).range) := rfl,
    rw [this] at hx,
    replace hx := subtype.coe_injective hx,
    rw [hx],
    simp only [map_zero],
  },
  {
    simp only [H, linear_map.range_eq_map, ←submodule.map_comp, ←linear_map.dom_restrict],
    rw [←linear_map.comp_assoc],
    ext,
    simp only [submodule.mem_map],
    split,
    {
      rintro ⟨y, -, rfl⟩,
      refine ⟨E.subtype.comp h y, _⟩,
      simp only [linear_map.comp_apply, submodule.coe_subtype],
      simp only [submodule.coe_mem, eq_self_iff_true, and_self],
    },
    {
      rintro ⟨y, yE, rfl⟩,
      refine ⟨⟨(f.dom_restrict E) ⟨y, yE⟩, linear_map.mem_range_self _ _⟩, _, _⟩,
      {
        apply submodule.mem_top,
      },
      simp only [g, linear_map.dom_restrict, linear_map.ext_iff] at hh,
      simp only [linear_map.comp_apply, linear_map.range_restrict] at hh ⊢,
      replace hh := congr_arg (submodule.subtype _) (hh ⟨(f.dom_restrict E ⟨y, yE⟩), linear_map.mem_range_self _ _⟩),
      simp only [submodule.coe_subtype, linear_map.cod_restrict_apply] at hh,
      simp only [linear_map.id_coe, id.def, linear_map.dom_restrict_apply, submodule.coe_subtype] at hh ⊢,
      rw [hh, submodule.coe_mk, submodule.coe_mk],
    },
  },
end

lemma exists_dim_eq_dim_image
{W : Type} [inner_product_space ℝ W] [finite_dimensional ℝ V]
{E : submodule ℝ V}
(f : V →ₗ[ℝ] W) :
∃ T : submodule ℝ V, T ≤ E ∧ f.ker ⊓ T = ⊥ ∧ T.map f = E.map f :=
begin
  obtain ⟨T, hT₁, hT₂, hT₃⟩ := exists_equiv_to_image E f,
  refine ⟨T, hT₁, _, hT₃⟩,
  {
    rw [inf_comm, hT₂],
  },
end

lemma exists_dim_eq_dim_image'
{W : Type} [inner_product_space ℝ W] [finite_dimensional ℝ V]
{E : submodule ℝ V} {F : submodule ℝ W}
(f : V →ₗ[ℝ] W)
(FE : F ≤ E.map f) :
∃ T : submodule ℝ V, T ≤ E ∧ f.ker ⊓ T = ⊥ ∧ T.map f = F :=
begin
  obtain ⟨T, hT₁, hT₂, hT₃⟩ := exists_equiv_to_image E f,
  refine ⟨T ⊓ F.comap f, _, _, _⟩,
  {
    exact le_trans inf_le_left hT₁,
  },
  {
    rw [inf_comm] at hT₂,
    refine le_antisymm _ bot_le,
    refine le_trans (inf_le_inf_left _ inf_le_left) _,
    exact le_of_eq hT₂,
  },
  {
    apply le_antisymm,
    {
      refine le_trans (submodule.map_mono inf_le_right) _,
      apply submodule.map_comap_le,
    },
    {
      rw [←hT₃] at FE,
      intros f hf,
      have := FE hf,
      rw [submodule.mem_map] at this ⊢,
      obtain ⟨y, yT, rfl⟩ := this,
      refine ⟨y, _, rfl⟩,
      rw [submodule.mem_inf, submodule.mem_comap],
      exact ⟨yT, hf⟩,
    },
  },
end

-- MOVETO multiset.lean
lemma multiset.exists_of_exists_elementwise {α β: Type}
{C : multiset α}
{p : α → β → Prop}
(h : multiset_all (λ a, ∃ b : β, p a b) C) :
∃ D : multiset ({x : α × β // p x.fst x.snd }), C = D.map (λ x, x.val.fst) :=
begin
  induction C using pauls_multiset_induction with C a ih,
  {
    refine ⟨0, _⟩,
    rw [multiset.map_zero],
  },
  {
    obtain ⟨b, pab⟩ := h a (multiset.mem_cons_self _ _),
    obtain ⟨D, hD⟩ := ih (multiset.all_of_le (multiset.le_cons_self _ _) h),
    refine ⟨⟨⟨a, b⟩, pab⟩ ::ₘ D, _⟩,
    simp only [hD, subtype.val_eq_coe, multiset.map_cons, subtype.coe_mk, multiset.cons_inj_right],
  },
end

lemma multiset.lift_submodules
{C : multiset (submodule ℝ V)}
{E : submodule ℝ V}
{D : multiset (submodule ℝ E)}
(DC : D ⊑ₘ C.map (project_subspace E)) :
∃ F, F ⊑ₘ C ∧ D = F.map (project_subspace E) ∧
multiset_all (λ W, (proj E).ker ⊓ W = ⊥) F :=
begin
  obtain ⟨X, ⟨hX', hX⟩⟩ := DC,
  obtain ⟨Y, YX, YC⟩ := multiset.exists_join' hX,
  let Z : multiset {pr : submodule ℝ V × submodule ℝ E // pr.snd ≤ project_subspace E pr.fst} :=
  Y.map (λ pr, ⟨⟨pr.val.snd, pr.val.fst.small⟩, _⟩), rotate,
  {
    rw [←pr.property],
    exact pr.val.fst.le,
  },
  have ZC : C = Z.map (λ x, x.val.fst),
  {
    rw [←YC, multiset.map_map],
  },
  have ZD : D = Z.map (λ x, x.val.snd),
  {
    rw [←hX', ←YX, multiset.map_map, multiset.map_map],
  },
  clear_value Z,
  clear' X hX' hX Y YX YC,
  have : multiset_all (λ z : {z : submodule ℝ V × submodule ℝ E // z.snd ≤ project_subspace E z.fst},
  ∃ U : submodule ℝ V, U ≤ z.val.fst ∧ project_subspace E U = z.val.snd ∧ (proj E).ker ⊓ U = ⊥) Z,
  {
    intros z hz,
    have := z.property,
    simp only [project_subspace] at this,
    obtain ⟨U, hU₁, hU₂, hU₃⟩ := exists_dim_eq_dim_image' _ this,
    exact ⟨U, hU₁, hU₃, hU₂⟩,
  },
  obtain ⟨W, hW⟩ := multiset.exists_of_exists_elementwise this,
  let K : multiset (submodule_pair V) := W.map (λ w, ⟨w.val.fst.val.fst, ⟨w.val.snd, w.property.1⟩⟩),
  have KC: C = K.map (λ k, k.fst),
  {
    simp only [ZC, hW, multiset.map_map],
  },
  refine ⟨K.map (λ k, k.snd.val), _, _, _⟩,
  {
    refine ⟨K, rfl, _⟩,
    {
      rw [KC],
      refl,
    },
  },
  {
    rw [ZD, hW],
    simp only [subtype.val_eq_coe, multiset.map_map, function.comp_app, subtype.coe_mk],
    congr, funext x,
    exact x.property.2.1.symm,
  },
  {
    intros W hW,
    rw [multiset.mem_map] at hW,
    obtain ⟨k, kK, rfl⟩ := hW,
    rw [multiset.mem_map] at kK,
    obtain ⟨w, wW, rfl⟩ := kK,
    exact w.property.2.2,
  },
end

noncomputable def span_singleton (x : V) : submodule ℝ V := submodule.span ℝ {x}


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import order.symm_diff
import order.disjointed
import order.conditionally_complete_lattice
import data.equiv.encodable.lattice
import data.set.countable

/-!
# Measurable spaces and measurable functions

This file defines measurable spaces and measurable functions.

A measurable space is a set equipped with a σ-algebra, a collection of
subsets closed under complementation and countable union. A function
between measurable spaces is measurable if the preimage of each
measurable subset is measurable.

σ-algebras on a fixed set `α` form a complete lattice. Here we order
σ-algebras by writing `m₁ ≤ m₂` if every set which is `m₁`-measurable is
also `m₂`-measurable (that is, `m₁` is a subset of `m₂`). In particular, any
collection of subsets of `α` generates a smallest σ-algebra which
contains all of them.

Do not add measurability lemmas (which could be tagged with
@[measurability]) to this file, since the measurability tactic is downstream
from here. Use `measure_theory.measurable_space` instead.

## References

* <https://en.wikipedia.org/wiki/Measurable_space>
* <https://en.wikipedia.org/wiki/Sigma-algebra>
* <https://en.wikipedia.org/wiki/Dynkin_system>

## Tags

measurable space, σ-algebra, measurable function
-/

open set encodable function equiv
open_locale classical

variables {α β γ δ δ' : Type*} {ι : Sort*} {s t u : set α}

/-- A measurable space is a space equipped with a σ-algebra. -/
structure measurable_space (α : Type*) :=
(measurable_set' : set α → Prop)
(measurable_set_empty : measurable_set' ∅)
(measurable_set_compl : ∀ s, measurable_set' s → measurable_set' sᶜ)
(measurable_set_Union : ∀ f : ℕ → set α, (∀ i, measurable_set' (f i)) → measurable_set' (⋃ i, f i))

attribute [class] measurable_space

instance [h : measurable_space α] : measurable_space (order_dual α) := h

section
variable [measurable_space α]

/-- `measurable_set s` means that `s` is measurable (in the ambient measure space on `α`) -/
def measurable_set : set α → Prop := ‹measurable_space α›.measurable_set'

localized "notation `measurable_set[` m `]` := @measurable_set _ m" in measure_theory

@[simp] lemma measurable_set.empty : measurable_set (∅ : set α) :=
‹measurable_space α›.measurable_set_empty

lemma measurable_set.compl : measurable_set s → measurable_set sᶜ :=
‹measurable_space α›.measurable_set_compl s

lemma measurable_set.of_compl (h : measurable_set sᶜ) : measurable_set s :=
compl_compl s ▸ h.compl

@[simp] lemma measurable_set.compl_iff : measurable_set sᶜ ↔ measurable_set s :=
⟨measurable_set.of_compl, measurable_set.compl⟩

@[simp] lemma measurable_set.univ : measurable_set (univ : set α) :=
by simpa using (@measurable_set.empty α _).compl

@[nontriviality] lemma subsingleton.measurable_set [subsingleton α] {s : set α} :
  measurable_set s :=
subsingleton.set_cases measurable_set.empty measurable_set.univ s

lemma measurable_set.congr {s t : set α} (hs : measurable_set s) (h : s = t) :
  measurable_set t :=
by rwa ← h

lemma measurable_set.bUnion_decode₂ [encodable β] ⦃f : β → set α⦄ (h : ∀ b, measurable_set (f b))
  (n : ℕ) : measurable_set (⋃ b ∈ decode₂ β n, f b) :=
encodable.Union_decode₂_cases measurable_set.empty h

lemma measurable_set.Union [encodable β] ⦃f : β → set α⦄ (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
begin
  rw ← encodable.Union_decode₂,
  exact ‹measurable_space α›.measurable_set_Union _ (measurable_set.bUnion_decode₂ h)
end

lemma measurable_set.bUnion {f : β → set α} {s : set β} (hs : countable s)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋃ b ∈ s, f b) :=
begin
  rw bUnion_eq_Union,
  haveI := hs.to_encodable,
  exact measurable_set.Union (by simpa using h)
end

lemma set.finite.measurable_set_bUnion {f : β → set α} {s : set β} (hs : finite s)
  (h : ∀ b ∈ s, measurable_set (f b)) :
  measurable_set (⋃ b ∈ s, f b) :=
measurable_set.bUnion hs.countable h

lemma finset.measurable_set_bUnion {f : β → set α} (s : finset β)
  (h : ∀ b ∈ s, measurable_set (f b)) :
  measurable_set (⋃ b ∈ s, f b) :=
s.finite_to_set.measurable_set_bUnion h

lemma measurable_set.sUnion {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋃₀ s) :=
by { rw sUnion_eq_bUnion, exact measurable_set.bUnion hs h }

lemma set.finite.measurable_set_sUnion {s : set (set α)} (hs : finite s)
  (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋃₀ s) :=
measurable_set.sUnion hs.countable h

lemma measurable_set.Union_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
by { by_cases p; simp [h, hf, measurable_set.empty] }

lemma measurable_set.Inter [encodable β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
measurable_set.compl_iff.1 $
by { rw compl_Inter, exact measurable_set.Union (λ b, (h b).compl) }

section fintype

local attribute [instance] fintype.encodable

lemma measurable_set.Union_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
measurable_set.Union h

lemma measurable_set.Inter_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
measurable_set.Inter h

end fintype

lemma measurable_set.bInter {f : β → set α} {s : set β} (hs : countable s)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
measurable_set.compl_iff.1 $
by { rw compl_bInter, exact measurable_set.bUnion hs (λ b hb, (h b hb).compl) }

lemma set.finite.measurable_set_bInter {f : β → set α} {s : set β} (hs : finite s)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
measurable_set.bInter hs.countable h

lemma finset.measurable_set_bInter {f : β → set α} (s : finset β)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
s.finite_to_set.measurable_set_bInter h

lemma measurable_set.sInter {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋂₀ s) :=
by { rw sInter_eq_bInter, exact measurable_set.bInter hs h }

lemma set.finite.measurable_set_sInter {s : set (set α)} (hs : finite s)
  (h : ∀ t ∈ s, measurable_set t) : measurable_set (⋂₀ s) :=
measurable_set.sInter hs.countable h

lemma measurable_set.Inter_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
by { by_cases p; simp [h, hf, measurable_set.univ] }

@[simp] lemma measurable_set.union {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∪ s₂) :=
by { rw union_eq_Union, exact measurable_set.Union (bool.forall_bool.2 ⟨h₂, h₁⟩) }

@[simp] lemma measurable_set.inter {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∩ s₂) :=
by { rw inter_eq_compl_compl_union_compl, exact (h₁.compl.union h₂.compl).compl }

@[simp] lemma measurable_set.diff {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ \ s₂) :=
h₁.inter h₂.compl

@[simp] lemma measurable_set.symm_diff {s₁ s₂ : set α}
  (h₁ : measurable_set s₁) (h₂ : measurable_set s₂) :
  measurable_set (s₁ Δ s₂) :=
(h₁.diff h₂).union (h₂.diff h₁)

@[simp] lemma measurable_set.ite {t s₁ s₂ : set α} (ht : measurable_set t) (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (t.ite s₁ s₂) :=
(h₁.inter ht).union (h₂.diff ht)

@[simp] lemma measurable_set.cond {s₁ s₂ : set α} (h₁ : measurable_set s₁) (h₂ : measurable_set s₂)
  {i : bool} : measurable_set (cond i s₁ s₂) :=
by { cases i, exacts [h₂, h₁] }

@[simp] lemma measurable_set.disjointed {f : ℕ → set α} (h : ∀ i, measurable_set (f i)) (n) :
  measurable_set (disjointed f n) :=
disjointed_rec (λ t i ht, measurable_set.diff ht $ h _) (h n)

@[simp] lemma measurable_set.const (p : Prop) : measurable_set {a : α | p} :=
by { by_cases p; simp [h, measurable_set.empty]; apply measurable_set.univ }

/-- Every set has a measurable superset. Declare this as local instance as needed. -/
lemma nonempty_measurable_superset (s : set α) : nonempty { t // s ⊆ t ∧ measurable_set t} :=
⟨⟨univ, subset_univ s, measurable_set.univ⟩⟩

end

@[ext] lemma measurable_space.ext : ∀ {m₁ m₂ : measurable_space α},
  (∀ s : set α, m₁.measurable_set' s ↔ m₂.measurable_set' s) → m₁ = m₂
| ⟨s₁, _, _, _⟩ ⟨s₂, _, _, _⟩ h :=
  have s₁ = s₂, from funext $ assume x, propext $ h x,
  by subst this

@[ext] lemma measurable_space.ext_iff {m₁ m₂ : measurable_space α} :
  m₁ = m₂ ↔ (∀ s : set α, m₁.measurable_set' s ↔ m₂.measurable_set' s) :=
⟨by { unfreezingI {rintro rfl}, intro s, refl }, measurable_space.ext⟩

/-- A typeclass mixin for `measurable_space`s such that each singleton is measurable. -/
class measurable_singleton_class (α : Type*) [measurable_space α] : Prop :=
(measurable_set_singleton : ∀ x, measurable_set ({x} : set α))

export measurable_singleton_class (measurable_set_singleton)

attribute [simp] measurable_set_singleton

section measurable_singleton_class

variables [measurable_space α] [measurable_singleton_class α]

lemma measurable_set_eq {a : α} : measurable_set {x | x = a} :=
measurable_set_singleton a

lemma measurable_set.insert {s : set α} (hs : measurable_set s) (a : α) :
  measurable_set (insert a s) :=
(measurable_set_singleton a).union hs

@[simp] lemma measurable_set_insert {a : α} {s : set α} :
  measurable_set (insert a s) ↔ measurable_set s :=
⟨λ h, if ha : a ∈ s then by rwa ← insert_eq_of_mem ha
  else insert_diff_self_of_not_mem ha ▸ h.diff (measurable_set_singleton _),
  λ h, h.insert a⟩

lemma set.subsingleton.measurable_set {s : set α} (hs : s.subsingleton) : measurable_set s :=
hs.induction_on measurable_set.empty measurable_set_singleton

lemma set.finite.measurable_set {s : set α} (hs : finite s) : measurable_set s :=
finite.induction_on hs measurable_set.empty $ λ a s ha hsf hsm, hsm.insert _

protected lemma finset.measurable_set (s : finset α) : measurable_set (↑s : set α) :=
s.finite_to_set.measurable_set

lemma set.countable.measurable_set {s : set α} (hs : countable s) : measurable_set s :=
begin
  rw [← bUnion_of_singleton s],
  exact measurable_set.bUnion hs (λ b hb, measurable_set_singleton b)
end

end measurable_singleton_class

namespace measurable_space

section complete_lattice

instance : has_le (measurable_space α) :=
{ le          := λ m₁ m₂, m₁.measurable_set' ≤ m₂.measurable_set' }

lemma le_def {α} {a b : measurable_space α} :
  a ≤ b ↔ a.measurable_set' ≤ b.measurable_set' := iff.rfl

instance : partial_order (measurable_space α) :=
{ le_refl     := assume a b, le_refl _,
  le_trans    := assume a b c hab hbc, le_def.mpr (le_trans hab hbc),
  le_antisymm := assume a b h₁ h₂, measurable_space.ext $ assume s, ⟨h₁ s, h₂ s⟩,
  ..measurable_space.has_le }

/-- The smallest σ-algebra containing a collection `s` of basic sets -/
inductive generate_measurable (s : set (set α)) : set α → Prop
| basic : ∀ u ∈ s, generate_measurable u
| empty : generate_measurable ∅
| compl : ∀ s, generate_measurable s → generate_measurable sᶜ
| union : ∀ f : ℕ → set α, (∀ n, generate_measurable (f n)) → generate_measurable (⋃ i, f i)

/-- Construct the smallest measure space containing a collection of basic sets -/
def generate_from (s : set (set α)) : measurable_space α :=
{ measurable_set'      := generate_measurable s,
  measurable_set_empty := generate_measurable.empty,
  measurable_set_compl := generate_measurable.compl,
  measurable_set_Union := generate_measurable.union }

lemma measurable_set_generate_from {s : set (set α)} {t : set α} (ht : t ∈ s) :
  (generate_from s).measurable_set' t :=
generate_measurable.basic t ht

lemma generate_from_le {s : set (set α)} {m : measurable_space α}
  (h : ∀ t ∈ s, m.measurable_set' t) : generate_from s ≤ m :=
assume t (ht : generate_measurable s t), ht.rec_on h
  (measurable_set_empty m)
  (assume s _ hs, measurable_set_compl m s hs)
  (assume f _ hf, measurable_set_Union m f hf)

lemma generate_from_le_iff {s : set (set α)} (m : measurable_space α) :
  generate_from s ≤ m ↔ s ⊆ {t | m.measurable_set' t} :=
iff.intro
  (assume h u hu, h _ $ measurable_set_generate_from hu)
  (assume h, generate_from_le h)

@[simp] lemma generate_from_measurable_set [measurable_space α] :
  generate_from {s : set α | measurable_set s} = ‹_› :=
le_antisymm (generate_from_le $ λ _, id) $ λ s, measurable_set_generate_from

/-- If `g` is a collection of subsets of `α` such that the `σ`-algebra generated from `g` contains
the same sets as `g`, then `g` was already a `σ`-algebra. -/
protected def mk_of_closure (g : set (set α)) (hg : {t | (generate_from g).measurable_set' t} = g) :
  measurable_space α :=
{ measurable_set'      := λ s, s ∈ g,
  measurable_set_empty := hg ▸ measurable_set_empty _,
  measurable_set_compl := hg ▸ measurable_set_compl _,
  measurable_set_Union := hg ▸ measurable_set_Union _ }

lemma mk_of_closure_sets {s : set (set α)}
  {hs : {t | (generate_from s).measurable_set' t} = s} :
  measurable_space.mk_of_closure s hs = generate_from s :=
measurable_space.ext $ assume t, show t ∈ s ↔ _, by { conv_lhs { rw [← hs] }, refl }

/-- We get a Galois insertion between `σ`-algebras on `α` and `set (set α)` by using `generate_from`
  on one side and the collection of measurable sets on the other side. -/
def gi_generate_from : galois_insertion (@generate_from α) (λ m, {t | @measurable_set α m t}) :=
{ gc        := assume s, generate_from_le_iff,
  le_l_u    := assume m s, measurable_set_generate_from,
  choice    :=
    λ g hg, measurable_space.mk_of_closure g $ le_antisymm hg $ (generate_from_le_iff _).1 le_rfl,
  choice_eq := assume g hg, mk_of_closure_sets }

instance : complete_lattice (measurable_space α) :=
gi_generate_from.lift_complete_lattice

instance : inhabited (measurable_space α) := ⟨⊤⟩

lemma measurable_set_bot_iff {s : set α} : @measurable_set α ⊥ s ↔ (s = ∅ ∨ s = univ) :=
let b : measurable_space α :=
{ measurable_set'      := λ s, s = ∅ ∨ s = univ,
  measurable_set_empty := or.inl rfl,
  measurable_set_compl := by simp [or_imp_distrib] {contextual := tt},
  measurable_set_Union := assume f hf, classical.by_cases
    (assume h : ∃i, f i = univ,
      let ⟨i, hi⟩ := h in
      or.inr $ eq_univ_of_univ_subset $ hi ▸ le_supr f i)
    (assume h : ¬ ∃i, f i = univ,
      or.inl $ eq_empty_of_subset_empty $ Union_subset $ assume i,
        (hf i).elim (by simp {contextual := tt}) (assume hi, false.elim $ h ⟨i, hi⟩)) } in
have b = ⊥, from bot_unique $ assume s hs,
  hs.elim (λ s, s.symm ▸ @measurable_set_empty _ ⊥) (λ s, s.symm ▸ @measurable_set.univ _ ⊥),
this ▸ iff.rfl

@[simp] theorem measurable_set_top {s : set α} : @measurable_set _ ⊤ s := trivial

@[simp] theorem measurable_set_inf {m₁ m₂ : measurable_space α} {s : set α} :
  @measurable_set _ (m₁ ⊓ m₂) s ↔ @measurable_set _ m₁ s ∧ @measurable_set _ m₂ s :=
iff.rfl

@[simp] theorem measurable_set_Inf {ms : set (measurable_space α)} {s : set α} :
  @measurable_set _ (Inf ms) s ↔ ∀ m ∈ ms, @measurable_set _ m s :=
show s ∈ (⋂₀ _) ↔ _, by simp

@[simp] theorem measurable_set_infi {ι} {m : ι → measurable_space α} {s : set α} :
  @measurable_set _ (infi m) s ↔ ∀ i, @measurable_set _ (m i) s :=
by rw [infi, measurable_set_Inf, forall_range_iff]

theorem measurable_set_sup {m₁ m₂ : measurable_space α} {s : set α} :
  @measurable_set _ (m₁ ⊔ m₂) s ↔ generate_measurable (m₁.measurable_set' ∪ m₂.measurable_set') s :=
iff.refl _

theorem measurable_set_Sup {ms : set (measurable_space α)} {s : set α} :
  @measurable_set _ (Sup ms) s ↔
    generate_measurable {s : set α | ∃ m ∈ ms, @measurable_set _ m s} s :=
begin
  change @measurable_set' _ (generate_from $ ⋃₀ _) _ ↔ _,
  simp [generate_from, ← set_of_exists]
end

theorem measurable_set_supr {ι} {m : ι → measurable_space α} {s : set α} :
  @measurable_set _ (supr m) s ↔
    generate_measurable {s : set α | ∃ i, @measurable_set _ (m i) s} s :=
by simp only [supr, measurable_set_Sup, exists_range_iff]

end complete_lattice

end measurable_space

section measurable_functions
open measurable_space

/-- A function `f` between measurable spaces is measurable if the preimage of every
  measurable set is measurable. -/
def measurable [measurable_space α] [measurable_space β] (f : α → β) : Prop :=
∀ ⦃t : set β⦄, measurable_set t → measurable_set (f ⁻¹' t)

localized "notation `measurable[` m `]` := @measurable _ _ m _" in measure_theory

variables [measurable_space α] [measurable_space β] [measurable_space γ]

lemma measurable_id : measurable (@id α) := λ t, id

lemma measurable_id' : measurable (λ a : α, a) := measurable_id

lemma measurable.comp {g : β → γ} {f : α → β} (hg : measurable g) (hf : measurable f) :
  measurable (g ∘ f) :=
λ t ht, hf (hg ht)

@[simp] lemma measurable_const {a : α} : measurable (λ b : β, a) :=
assume s hs, measurable_set.const (a ∈ s)

lemma measurable.le {α} {m m0 : measurable_space α} (hm : m ≤ m0) {f : α → β}
  (hf : measurable[m] f) : measurable[m0] f :=
λ s hs, hm _ (hf hs)

end measurable_functions


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.nat.interval
import data.finset.locally_finite

/-!
# Finite intervals in `fin n`

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

This file proves that `fin n` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.
-/

open finset fin function

open_locale big_operators

variables (n : ℕ)

instance : locally_finite_order (fin n) :=
order_iso.locally_finite_order fin.order_iso_subtype

instance : locally_finite_order_bot (fin n) :=
order_iso.locally_finite_order_bot fin.order_iso_subtype

instance : Π n, locally_finite_order_top (fin n)
| 0 := is_empty.to_locally_finite_order_top
| (n + 1) := infer_instance

namespace fin
variables {n} (a b : fin n)

lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).fin n := rfl
lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).fin n := rfl
lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).fin n := rfl
lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).fin n := rfl

@[simp] lemma map_subtype_embedding_Icc : (Icc a b).map fin.coe_embedding = Icc a b :=
by simp [Icc_eq_finset_subtype, finset.fin, finset.map_map, Icc_filter_lt_of_lt_right]

@[simp] lemma map_subtype_embedding_Ico : (Ico a b).map fin.coe_embedding = Ico a b :=
by simp [Ico_eq_finset_subtype, finset.fin, finset.map_map]

@[simp] lemma map_subtype_embedding_Ioc : (Ioc a b).map fin.coe_embedding = Ioc a b :=
by simp [Ioc_eq_finset_subtype, finset.fin, finset.map_map, Ioc_filter_lt_of_lt_right]

@[simp] lemma map_subtype_embedding_Ioo : (Ioo a b).map fin.coe_embedding = Ioo a b :=
by simp [Ioo_eq_finset_subtype, finset.fin, finset.map_map]

@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a :=
by rw [←nat.card_Icc, ←map_subtype_embedding_Icc, card_map]

@[simp] lemma card_Ico : (Ico a b).card = b - a :=
by rw [←nat.card_Ico, ←map_subtype_embedding_Ico, card_map]

@[simp] lemma card_Ioc : (Ioc a b).card = b - a :=
by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioc, card_map]

@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 :=
by rw [←nat.card_Ioo, ←map_subtype_embedding_Ioo, card_map]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a :=
by rw [←card_Icc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = b - a :=
by rw [←card_Ico, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = b - a :=
by rw [←card_Ioc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 :=
by rw [←card_Ioo, fintype.card_of_finset]

lemma Ici_eq_finset_subtype : Ici a = (Icc (a : ℕ) n).fin n := by { ext, simp }
lemma Ioi_eq_finset_subtype : Ioi a = (Ioc (a : ℕ) n).fin n := by { ext, simp }
lemma Iic_eq_finset_subtype : Iic b = (Iic (b : ℕ)).fin n := rfl
lemma Iio_eq_finset_subtype : Iio b = (Iio (b : ℕ)).fin n := rfl

@[simp] lemma map_subtype_embedding_Ici : (Ici a).map fin.coe_embedding = Icc a (n - 1) :=
begin
  ext x,
  simp only [exists_prop, embedding.coe_subtype, mem_Ici, mem_map, mem_Icc],
  split,
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨hx, le_tsub_of_add_le_right $ x.2⟩ },
  cases n,
  { exact fin.elim0 a },
  { exact λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ }
end

@[simp] lemma map_subtype_embedding_Ioi : (Ioi a).map fin.coe_embedding = Ioc a (n - 1) :=
begin
  ext x,
  simp only [exists_prop, embedding.coe_subtype, mem_Ioi, mem_map, mem_Ioc],
  split,
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨hx, le_tsub_of_add_le_right $ x.2⟩ },
  cases n,
  { exact fin.elim0 a },
  { exact λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ }
end

@[simp] lemma map_subtype_embedding_Iic : (Iic b).map fin.coe_embedding = Iic b :=
by simp [Iic_eq_finset_subtype, finset.fin, finset.map_map, Iic_filter_lt_of_lt_right]

@[simp] lemma map_subtype_embedding_Iio : (Iio b).map fin.coe_embedding = Iio b :=
by simp [Iio_eq_finset_subtype, finset.fin, finset.map_map]

@[simp] lemma card_Ici : (Ici a).card = n - a :=
by { cases n, { exact fin.elim0 a }, rw [←card_map, map_subtype_embedding_Ici, nat.card_Icc], refl }

@[simp] lemma card_Ioi : (Ioi a).card = n - 1 - a :=
by { rw [←card_map, map_subtype_embedding_Ioi, nat.card_Ioc] }

@[simp] lemma card_Iic : (Iic b).card = b + 1 :=
by rw [←nat.card_Iic b, ←map_subtype_embedding_Iic, card_map]

@[simp] lemma card_Iio : (Iio b).card = b :=
by rw [←nat.card_Iio b, ←map_subtype_embedding_Iio, card_map]

@[simp] lemma card_fintype_Ici : fintype.card (set.Ici a) = n - a :=
by rw [fintype.card_of_finset, card_Ici]

@[simp] lemma card_fintype_Ioi : fintype.card (set.Ioi a) = n - 1 - a :=
by rw [fintype.card_of_finset, card_Ioi]

@[simp] lemma card_fintype_Iic : fintype.card (set.Iic b) = b + 1 :=
by rw [fintype.card_of_finset, card_Iic]

@[simp] lemma card_fintype_Iio : fintype.card (set.Iio b) = b :=
by rw [fintype.card_of_finset, card_Iio]

end fin