/-
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.solvable
import algebra.lie.quotient
import linear_algebra.eigenspace
import ring_theory.nilpotent

/-!
# Nilpotent Lie algebras

Like groups, Lie algebras admit a natural concept of nilpotency. More generally, any Lie module
carries a natural concept of nilpotency. We define these here via the lower central series.

## Main definitions

  * `lie_module.lower_central_series`
  * `lie_module.is_nilpotent`

## Tags

lie algebra, lower central series, nilpotent
-/

universes u v w w₁ w₂

section nilpotent_modules

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 (k : ℕ) (N : lie_submodule R L M)

namespace lie_submodule

/-- A generalisation of the lower central series. The zeroth term is a specified Lie submodule of
a Lie module. In the case when we specify the top ideal `⊤` of the Lie algebra, regarded as a Lie
module over itself, we get the usual lower central series of a Lie algebra.

It can be more convenient to work with this generalisation when considering the lower central series
of a Lie submodule, regarded as a Lie module in its own right, since it provides a type-theoretic
expression of the fact that the terms of the Lie submodule's lower central series are also Lie
submodules of the enclosing Lie module.

See also `lie_module.lower_central_series_eq_lcs_comap` and
`lie_module.lower_central_series_map_eq_lcs` below. -/
def lcs : lie_submodule R L M → lie_submodule R L M := (λ N, ⁅(⊤ : lie_ideal R L), N⁆)^[k]

@[simp]

@[simp] lemma lcs_succ : N.lcs (k + 1) = ⁅(⊤ : lie_ideal R L), N.lcs k⁆ :=
function.iterate_succ_apply' (λ N', ⁅⊤, N'⁆) k N

end lie_submodule

namespace lie_module

variables (R L M)

/-- The lower central series of Lie submodules of a Lie module. -/
def lower_central_series : lie_submodule R L M := (⊤ : lie_submodule R L M).lcs k

@[simp] lemma lower_central_series_zero : lower_central_series R L M 0 = ⊤ := rfl

@[simp] lemma lower_central_series_succ :
  lower_central_series R L M (k + 1) = ⁅(⊤ : lie_ideal R L), lower_central_series R L M k⁆ :=
(⊤ : lie_submodule R L M).lcs_succ k

end lie_module

namespace lie_submodule

open lie_module

variables {R L M}

lemma lcs_le_self : N.lcs k ≤ N :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lcs_succ],
    exact (lie_submodule.mono_lie_right _ _ ⊤ ih).trans (N.lie_le_right ⊤), },
end

lemma lower_central_series_eq_lcs_comap :
  lower_central_series R L N k = (N.lcs k).comap N.incl :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lcs_succ, lower_central_series_succ] at ⊢ ih,
    have : N.lcs k ≤ N.incl.range,
    { rw N.range_incl,
      apply lcs_le_self, },
    rw [ih, lie_submodule.comap_bracket_eq _ _ N.incl N.ker_incl this], },
end

lemma lower_central_series_map_eq_lcs :
  (lower_central_series R L N k).map N.incl = N.lcs k :=
begin
  rw [lower_central_series_eq_lcs_comap, lie_submodule.map_comap_incl, inf_eq_right],
  apply lcs_le_self,
end

end lie_submodule

namespace lie_module

variables (R L M)

lemma antitone_lower_central_series : antitone $ lower_central_series R L M :=
begin
  intros l k,
  induction k with k ih generalizing l;
  intros h,
  { exact (le_zero_iff.mp h).symm ▸ le_rfl, },
  { rcases nat.of_le_succ h with hk | hk,
    { rw lower_central_series_succ,
      exact (lie_submodule.mono_lie_right _ _ ⊤ (ih hk)).trans (lie_submodule.lie_le_right _ _), },
    { exact hk.symm ▸ le_rfl, }, },
end

lemma trivial_iff_lower_central_eq_bot : is_trivial L M ↔ lower_central_series R L M 1 = ⊥ :=
begin
  split; intros h,
  { erw [eq_bot_iff, lie_submodule.lie_span_le], rintros m ⟨x, n, hn⟩, rw [← hn, h.trivial], simp,},
  { rw lie_submodule.eq_bot_iff at h, apply is_trivial.mk, intros x m, apply h,
    apply lie_submodule.subset_lie_span, use [x, m], refl, },
end

lemma iterate_to_endomorphism_mem_lower_central_series (x : L) (m : M) (k : ℕ) :
  (to_endomorphism R L M x)^[k] m ∈ lower_central_series R L M k :=
begin
  induction k with k ih,
  { simp only [function.iterate_zero], },
  { simp only [lower_central_series_succ, function.comp_app, function.iterate_succ',
      to_endomorphism_apply_apply],
    exact lie_submodule.lie_mem_lie _ _ (lie_submodule.mem_top x) ih, },
end

variables {R L M}

lemma map_lower_central_series_le
  {M₂ : Type w₁} [add_comm_group M₂] [module R M₂] [lie_ring_module L M₂] [lie_module R L M₂]
  (k : ℕ) (f : M →ₗ⁅R,L⁆ M₂) :
  lie_submodule.map f (lower_central_series R L M k) ≤ lower_central_series R L M₂ k :=
begin
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero, le_top], },
  { simp only [lie_module.lower_central_series_succ, lie_submodule.map_bracket_eq],
    exact lie_submodule.mono_lie_right _ _ ⊤ ih, },
end

variables (R L M)
open lie_algebra

lemma derived_series_le_lower_central_series (k : ℕ) :
  derived_series R L k ≤ lower_central_series R L L k :=
begin
  induction k with k h,
  { rw [derived_series_def, derived_series_of_ideal_zero, lower_central_series_zero],
    exact le_rfl, },
  { have h' : derived_series R L k ≤ ⊤, { by simp only [le_top], },
    rw [derived_series_def, derived_series_of_ideal_succ, lower_central_series_succ],
    exact lie_submodule.mono_lie _ _ _ _ h' h, },
end

/-- A Lie module is nilpotent if its lower central series reaches 0 (in a finite number of
steps). -/
class is_nilpotent : Prop :=
(nilpotent : ∃ k, lower_central_series R L M k = ⊥)

@[priority 100]
instance trivial_is_nilpotent [is_trivial L M] : is_nilpotent R L M :=
⟨by { use 1, change ⁅⊤, ⊤⁆ = ⊥, simp, }⟩

lemma nilpotent_endo_of_nilpotent_module [hM : is_nilpotent R L M] :
  ∃ (k : ℕ), ∀ (x : L), (to_endomorphism R L M x)^k = 0 :=
begin
  unfreezingI { obtain ⟨k, hM⟩ := hM, },
  use k,
  intros x, ext m,
  rw [linear_map.pow_apply, linear_map.zero_apply, ← @lie_submodule.mem_bot R L M, ← hM],
  exact iterate_to_endomorphism_mem_lower_central_series R L M x m k,
end

/-- For a nilpotent Lie module, the weight space of the 0 weight is the whole module.

This result will be used downstream to show that weight spaces are Lie submodules, at which time
it will be possible to state it in the language of weight spaces. -/
lemma infi_max_gen_zero_eigenspace_eq_top_of_nilpotent [is_nilpotent R L M] :
  (⨅ (x : L), (to_endomorphism R L M x).maximal_generalized_eigenspace 0) = ⊤ :=
begin
  ext m,
  simp only [module.End.mem_maximal_generalized_eigenspace, submodule.mem_top, sub_zero, iff_true,
    zero_smul, submodule.mem_infi],
  intros x,
  obtain ⟨k, hk⟩ := nilpotent_endo_of_nilpotent_module R L M,
  use k, rw hk,
  exact linear_map.zero_apply m,
end

/-- If the quotient of a Lie module `M` by a Lie submodule on which the Lie algebra acts trivially
is nilpotent then `M` is nilpotent.

This is essentially the Lie module equivalent of the fact that a central
extension of nilpotent Lie algebras is nilpotent. See `lie_algebra.nilpotent_of_nilpotent_quotient`
below for the corresponding result for Lie algebras. -/
lemma nilpotent_of_nilpotent_quotient {N : lie_submodule R L M}
  (h₁ : N ≤ max_triv_submodule R L M) (h₂ : is_nilpotent R L (M ⧸ N)) : is_nilpotent R L M :=
begin
  unfreezingI { obtain ⟨k, hk⟩ := h₂, },
  use k+1,
  simp only [lower_central_series_succ],
  suffices : lower_central_series R L M k ≤ N,
  { replace this := lie_submodule.mono_lie_right _ _ ⊤ (le_trans this h₁),
    rwa [ideal_oper_max_triv_submodule_eq_bot, le_bot_iff] at this, },
  rw [← lie_submodule.quotient.map_mk'_eq_bot_le, ← le_bot_iff, ← hk],
  exact map_lower_central_series_le k (lie_submodule.quotient.mk' N),
end

/-- Given a nilpotent Lie module `M` with lower central series `M = C₀ ≥ C₁ ≥ ⋯ ≥ Cₖ = ⊥`, this is
the natural number `k` (the number of inclusions).

For a non-nilpotent module, we use the junk value 0. -/
noncomputable def nilpotency_length : ℕ :=
Inf { k | lower_central_series R L M k = ⊥ }

lemma nilpotency_length_eq_zero_iff [is_nilpotent R L M] :
  nilpotency_length R L M = 0 ↔ subsingleton M :=
begin
  let s := { k | lower_central_series R L M k = ⊥ },
  have hs : s.nonempty,
  { unfreezingI { obtain ⟨k, hk⟩ := (by apply_instance : is_nilpotent R L M), },
    exact ⟨k, hk⟩, },
  change Inf s = 0 ↔ _,
  rw [← lie_submodule.subsingleton_iff R L M, ← subsingleton_iff_bot_eq_top,
      ← lower_central_series_zero, @eq_comm (lie_submodule R L M)],
  refine ⟨λ h, h ▸ nat.Inf_mem hs, λ h, _⟩,
  rw nat.Inf_eq_zero,
  exact or.inl h,
end

lemma nilpotency_length_eq_succ_iff (k : ℕ) :
  nilpotency_length R L M = k + 1 ↔
  lower_central_series R L M (k + 1) = ⊥ ∧ lower_central_series R L M k ≠ ⊥ :=
begin
  let s := { k | lower_central_series R L M k = ⊥ },
  change Inf s = k + 1 ↔ k + 1 ∈ s ∧ k ∉ s,
  have hs : ∀ k₁ k₂, k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s,
  { rintros k₁ k₂ h₁₂ (h₁ : lower_central_series R L M k₁ = ⊥),
    exact eq_bot_iff.mpr (h₁ ▸ antitone_lower_central_series R L M h₁₂), },
  exact nat.Inf_upward_closed_eq_succ_iff hs k,
end

/-- Given a non-trivial nilpotent Lie module `M` with lower central series
`M = C₀ ≥ C₁ ≥ ⋯ ≥ Cₖ = ⊥`, this is the `k-1`th term in the lower central series (the last
non-trivial term).

For a trivial or non-nilpotent module, this is the bottom submodule, `⊥`. -/
noncomputable def lower_central_series_last : lie_submodule R L M :=
match nilpotency_length R L M with
| 0     := ⊥
| k + 1 := lower_central_series R L M k
end

lemma lower_central_series_last_le_max_triv :
  lower_central_series_last R L M ≤ max_triv_submodule R L M :=
begin
  rw lower_central_series_last,
  cases h : nilpotency_length R L M with k,
  { exact bot_le, },
  { rw le_max_triv_iff_bracket_eq_bot,
    rw [nilpotency_length_eq_succ_iff, lower_central_series_succ] at h,
    exact h.1, },
end

lemma nontrivial_lower_central_series_last [nontrivial M] [is_nilpotent R L M] :
  nontrivial (lower_central_series_last R L M) :=
begin
  rw [lie_submodule.nontrivial_iff_ne_bot, lower_central_series_last],
  cases h : nilpotency_length R L M,
  { rw [nilpotency_length_eq_zero_iff, ← not_nontrivial_iff_subsingleton] at h,
    contradiction, },
  { rw nilpotency_length_eq_succ_iff at h,
    exact h.2, },
end

lemma nontrivial_max_triv_of_is_nilpotent [nontrivial M] [is_nilpotent R L M] :
  nontrivial (max_triv_submodule R L M) :=
set.nontrivial_mono
  (lower_central_series_last_le_max_triv R L M)
  (nontrivial_lower_central_series_last R L M)

@[simp] lemma coe_lcs_range_to_endomorphism_eq (k : ℕ) :
  (lower_central_series R (to_endomorphism R L M).range M k : submodule R M) =
  lower_central_series R L M k :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lower_central_series_succ, lie_submodule.lie_ideal_oper_eq_linear_span',
      ← (lower_central_series R (to_endomorphism R L M).range M k).mem_coe_submodule, ih],
    congr,
    ext m,
    split,
    { rintros ⟨⟨-, ⟨y, rfl⟩⟩, -, n, hn, rfl⟩,
      exact ⟨y, lie_submodule.mem_top _, n, hn, rfl⟩, },
    { rintros ⟨x, hx, n, hn, rfl⟩,
      exact ⟨⟨to_endomorphism R L M x, lie_hom.mem_range_self _ x⟩, lie_submodule.mem_top _,
        n, hn, rfl⟩, }, },
end

@[simp] lemma is_nilpotent_range_to_endomorphism_iff :
  is_nilpotent R (to_endomorphism R L M).range M ↔ is_nilpotent R L M :=
begin
  split;
  rintros ⟨k, hk⟩;
  use k;
  rw ← lie_submodule.coe_to_submodule_eq_iff at ⊢ hk;
  simpa using hk,
end

end lie_module

section morphisms

open lie_module function

variables {L₂ M₂ : Type*} [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 {f : L →ₗ⁅R⁆ L₂} {g : M →ₗ[R] M₂}
variables (hf : surjective f) (hg : surjective g) (hfg : ∀ x m, ⁅f x, g m⁆ = g ⁅x, m⁆)

include hf hg hfg

lemma function.surjective.lie_module_lcs_map_eq (k : ℕ) :
  (lower_central_series R L M k : submodule R M).map g = lower_central_series R L₂ M₂ k :=
begin
  induction k with k ih,
  { simp [linear_map.range_eq_top, hg], },
  { suffices : g '' {m | ∃ (x : L) n, n ∈ lower_central_series R L M k ∧ ⁅x, n⁆ = m} =
               {m | ∃ (x : L₂) n, n ∈ lower_central_series R L M k ∧ ⁅x, g n⁆ = m},
    { simp only [← lie_submodule.mem_coe_submodule] at this,
      simp [← lie_submodule.mem_coe_submodule, ← ih, lie_submodule.lie_ideal_oper_eq_linear_span',
        submodule.map_span, -submodule.span_image, this], },
    ext m₂,
    split,
    { rintros ⟨m, ⟨x, n, hn, rfl⟩, rfl⟩,
      exact ⟨f x, n, hn, hfg x n⟩, },
    { rintros ⟨x, n, hn, rfl⟩,
      obtain ⟨y, rfl⟩ := hf x,
      exact ⟨⁅y, n⁆, ⟨y, n, hn, rfl⟩, (hfg y n).symm⟩, }, },
end

lemma function.surjective.lie_module_is_nilpotent [is_nilpotent R L M] : is_nilpotent R L₂ M₂ :=
begin
  obtain ⟨k, hk⟩ := id (by apply_instance : is_nilpotent R L M),
  use k,
  rw ← lie_submodule.coe_to_submodule_eq_iff at ⊢ hk,
  simp [← hf.lie_module_lcs_map_eq hg hfg k, hk],
end

omit hf hg hfg

lemma equiv.lie_module_is_nilpotent_iff (f : L ≃ₗ⁅R⁆ L₂) (g : M ≃ₗ[R] M₂)
  (hfg : ∀ x m, ⁅f x, g m⁆ = g ⁅x, m⁆) :
  is_nilpotent R L M ↔ is_nilpotent R L₂ M₂ :=
begin
  split;
  introsI h,
  { have hg : surjective (g : M →ₗ[R] M₂) := g.surjective,
    exact f.surjective.lie_module_is_nilpotent hg hfg, },
  { have hg : surjective (g.symm : M₂ →ₗ[R] M) := g.symm.surjective,
    refine f.symm.surjective.lie_module_is_nilpotent hg (λ x m, _),
    rw [linear_equiv.coe_coe, lie_equiv.coe_to_lie_hom, ← g.symm_apply_apply ⁅f.symm x, g.symm m⁆,
      ← hfg, f.apply_symm_apply, g.apply_symm_apply], },
end

@[simp] lemma lie_module.is_nilpotent_of_top_iff :
  is_nilpotent R (⊤ : lie_subalgebra R L) M ↔ is_nilpotent R L M :=
equiv.lie_module_is_nilpotent_iff lie_subalgebra.top_equiv_self (1 : M ≃ₗ[R] M) (λ x m, rfl)

end morphisms

end nilpotent_modules

@[priority 100]
instance lie_algebra.is_solvable_of_is_nilpotent (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [hL : lie_module.is_nilpotent R L L] :
  lie_algebra.is_solvable R L :=
begin
  obtain ⟨k, h⟩ : ∃ k, lie_module.lower_central_series R L L k = ⊥ := hL.nilpotent,
  use k, rw ← le_bot_iff at h ⊢,
  exact le_trans (lie_module.derived_series_le_lower_central_series R L k) h,
end

section nilpotent_algebras

variables (R : Type u) (L : Type v) (L' : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']

/-- We say a Lie algebra is nilpotent when it is nilpotent as a Lie module over itself via the
adjoint representation. -/
abbreviation lie_algebra.is_nilpotent (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] : Prop :=
lie_module.is_nilpotent R L L

open lie_algebra

lemma lie_algebra.nilpotent_ad_of_nilpotent_algebra [is_nilpotent R L] :
  ∃ (k : ℕ), ∀ (x : L), (ad R L x)^k = 0 :=
lie_module.nilpotent_endo_of_nilpotent_module R L L

/-- See also `lie_algebra.zero_root_space_eq_top_of_nilpotent`. -/
lemma lie_algebra.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent [is_nilpotent R L] :
  (⨅ (x : L), (ad R L x).maximal_generalized_eigenspace 0) = ⊤ :=
lie_module.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent R L L

-- TODO Generalise the below to Lie modules if / when we define morphisms, equivs of Lie modules
-- covering a Lie algebra morphism of (possibly different) Lie algebras.

variables {R L L'}

open lie_module (lower_central_series)

/-- Given an ideal `I` of a Lie algebra `L`, the lower central series of `L ⧸ I` is the same
whether we regard `L ⧸ I` as an `L` module or an `L ⧸ I` module.

TODO: This result obviously generalises but the generalisation requires the missing definition of
morphisms between Lie modules over different Lie algebras. -/
lemma coe_lower_central_series_ideal_quot_eq {I : lie_ideal R L} (k : ℕ) :
  (lower_central_series R L (L ⧸ I) k : submodule R (L ⧸ I)) =
  lower_central_series R (L ⧸ I) (L ⧸ I) k :=
begin
  induction k with k ih,
  { simp only [lie_submodule.top_coe_submodule, lie_module.lower_central_series_zero], },
  { simp only [lie_module.lower_central_series_succ, lie_submodule.lie_ideal_oper_eq_linear_span],
    congr,
    ext x,
    split,
    { rintros ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩,
      erw [← lie_submodule.mem_coe_submodule, ih, lie_submodule.mem_coe_submodule] at hz,
      exact ⟨⟨lie_submodule.quotient.mk y, submodule.mem_top⟩, ⟨z, hz⟩, rfl⟩, },
    { rintros ⟨⟨⟨y⟩, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩,
      erw [← lie_submodule.mem_coe_submodule, ← ih, lie_submodule.mem_coe_submodule] at hz,
      exact ⟨⟨y, submodule.mem_top⟩, ⟨z, hz⟩, rfl⟩, }, },
end

/-- Note that the below inequality can be strict. For example the ideal of strictly-upper-triangular
2x2 matrices inside the Lie algebra of upper-triangular 2x2 matrices with `k = 1`. -/
lemma lie_module.coe_lower_central_series_ideal_le {I : lie_ideal R L} (k : ℕ) :
  (lower_central_series R I I k : submodule R I) ≤ lower_central_series R L I k :=
begin
  induction k with k ih,
  { simp, },
  { simp only [lie_module.lower_central_series_succ, lie_submodule.lie_ideal_oper_eq_linear_span],
    apply submodule.span_mono,
    rintros x ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩,
    exact ⟨⟨y.val, submodule.mem_top⟩, ⟨z, ih hz⟩, rfl⟩, },
end

/-- A central extension of nilpotent Lie algebras is nilpotent. -/
lemma lie_algebra.nilpotent_of_nilpotent_quotient {I : lie_ideal R L}
  (h₁ : I ≤ center R L) (h₂ : is_nilpotent R (L ⧸ I)) : is_nilpotent R L :=
begin
  suffices : lie_module.is_nilpotent R L (L ⧸ I),
  { exact lie_module.nilpotent_of_nilpotent_quotient R L L h₁ this, },
  unfreezingI { obtain ⟨k, hk⟩ := h₂, },
  use k,
  simp [← lie_submodule.coe_to_submodule_eq_iff, coe_lower_central_series_ideal_quot_eq, hk],
end

lemma lie_algebra.non_trivial_center_of_is_nilpotent [nontrivial L] [is_nilpotent R L] :
  nontrivial $ center R L :=
lie_module.nontrivial_max_triv_of_is_nilpotent R L L

lemma lie_ideal.map_lower_central_series_le (k : ℕ) {f : L →ₗ⁅R⁆ L'} :
  lie_ideal.map f (lower_central_series R L L k) ≤ lower_central_series R L' L' k :=
begin
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero, le_top], },
  { simp only [lie_module.lower_central_series_succ],
    exact le_trans (lie_ideal.map_bracket_le f) (lie_submodule.mono_lie _ _ _ _ le_top ih), },
end

lemma lie_ideal.lower_central_series_map_eq (k : ℕ) {f : L →ₗ⁅R⁆ L'}
  (h : function.surjective f) :
  lie_ideal.map f (lower_central_series R L L k) = lower_central_series R L' L' k :=
begin
  have h' : (⊤ : lie_ideal R L).map f = ⊤,
  { rw ←f.ideal_range_eq_map,
    exact f.ideal_range_eq_top_of_surjective h, },
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero], exact h', },
  { simp only [lie_module.lower_central_series_succ, lie_ideal.map_bracket_eq f h, ih, h'], },
end

lemma function.injective.lie_algebra_is_nilpotent [h₁ : is_nilpotent R L'] {f : L →ₗ⁅R⁆ L'}
  (h₂ : function.injective f) : is_nilpotent R L :=
{ nilpotent :=
  begin
    obtain ⟨k, hk⟩ := id h₁,
    use k,
    apply lie_ideal.bot_of_map_eq_bot h₂, rw [eq_bot_iff, ← hk],
    apply lie_ideal.map_lower_central_series_le,
  end, }

lemma function.surjective.lie_algebra_is_nilpotent [h₁ : is_nilpotent R L] {f : L →ₗ⁅R⁆ L'}
  (h₂ : function.surjective f) : is_nilpotent R L' :=
{ nilpotent :=
  begin
    obtain ⟨k, hk⟩ := id h₁,
    use k,
    rw [← lie_ideal.lower_central_series_map_eq k h₂, hk],
    simp only [lie_ideal.map_eq_bot_iff, bot_le],
  end, }

lemma lie_equiv.nilpotent_iff_equiv_nilpotent (e : L ≃ₗ⁅R⁆ L') :
  is_nilpotent R L ↔ is_nilpotent R L' :=
begin
  split; introsI h,
  { exact e.symm.injective.lie_algebra_is_nilpotent, },
  { exact e.injective.lie_algebra_is_nilpotent, },
end

lemma lie_hom.is_nilpotent_range [is_nilpotent R L] (f : L →ₗ⁅R⁆ L') :
  is_nilpotent R f.range :=
f.surjective_range_restrict.lie_algebra_is_nilpotent

/-- Note that this result is not quite a special case of
`lie_module.is_nilpotent_range_to_endomorphism_iff` which concerns nilpotency of the
`(ad R L).range`-module `L`, whereas this result concerns nilpotency of the `(ad R L).range`-module
`(ad R L).range`. -/
@[simp] lemma lie_algebra.is_nilpotent_range_ad_iff :
  is_nilpotent R (ad R L).range ↔ is_nilpotent R L :=
begin
  refine ⟨λ h, _, _⟩,
  { have : (ad R L).ker = center R L, { by simp, },
    exact lie_algebra.nilpotent_of_nilpotent_quotient (le_of_eq this)
      ((ad R L).quot_ker_equiv_range.nilpotent_iff_equiv_nilpotent.mpr h), },
  { introsI h,
    exact (ad R L).is_nilpotent_range, },
end

instance [h : lie_algebra.is_nilpotent R L] : lie_algebra.is_nilpotent R (⊤ : lie_subalgebra R L) :=
lie_subalgebra.top_equiv_self.nilpotent_iff_equiv_nilpotent.mpr h

end nilpotent_algebras

namespace lie_ideal

open lie_module

variables {R L : Type*} [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L)
variables (M : Type*) [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables (k : ℕ)

/-- Given a Lie module `M` over a Lie algebra `L` together with an ideal `I` of `L`, this is the
lower central series of `M` as an `I`-module. The advantage of using this definition instead of
`lie_module.lower_central_series R I M` is that its terms are Lie submodules of `M` as an
`L`-module, rather than just as an `I`-module.

See also `lie_ideal.coe_lcs_eq`. -/
def lcs : lie_submodule R L M := (λ N, ⁅I, N⁆)^[k] ⊤

@[simp] lemma lcs_zero : I.lcs M 0 = ⊤ := rfl

@[simp] lemma lcs_succ : I.lcs M (k + 1) = ⁅I, I.lcs M k⁆ :=
function.iterate_succ_apply' (λ N, ⁅I, N⁆) k ⊤

lemma lcs_top : (⊤ : lie_ideal R L).lcs M k = lower_central_series R L M k := rfl

lemma coe_lcs_eq : (I.lcs M k : submodule R M) = lower_central_series R I M k :=
begin
  induction k with k ih,
  { simp, },
  { simp_rw [lower_central_series_succ, lcs_succ, lie_submodule.lie_ideal_oper_eq_linear_span',
      ← (I.lcs M k).mem_coe_submodule, ih, lie_submodule.mem_coe_submodule,
      lie_submodule.mem_top, exists_true_left, lie_subalgebra.coe_bracket_of_module],
    congr,
    ext m,
    split,
    { rintros ⟨x, hx, m, hm, rfl⟩,
      exact ⟨⟨x, hx⟩, m, hm, rfl⟩, },
    { rintros ⟨⟨x, hx⟩, m, hm, rfl⟩,
      exact ⟨x, hx, m, hm, rfl⟩, }, },
end

end lie_ideal

section of_associative

variables (R : Type u) {A : Type v} [comm_ring R] [ring A] [algebra R A]

lemma lie_algebra.ad_nilpotent_of_nilpotent {a : A} (h : is_nilpotent a) :
  is_nilpotent (lie_algebra.ad R A a) :=
begin
  rw lie_algebra.ad_eq_lmul_left_sub_lmul_right,
  have hl : is_nilpotent (algebra.lmul_left R a), { rwa algebra.is_nilpotent_lmul_left_iff, },
  have hr : is_nilpotent (algebra.lmul_right R a), { rwa algebra.is_nilpotent_lmul_right_iff, },
  exact (algebra.commute_lmul_left_right R a a).is_nilpotent_sub hl hr,
end

variables {R}

lemma lie_subalgebra.is_nilpotent_ad_of_is_nilpotent_ad {L : Type v} [lie_ring L] [lie_algebra R L]
  (K : lie_subalgebra R L) {x : K} (h : is_nilpotent (lie_algebra.ad R L ↑x)) :
  is_nilpotent (lie_algebra.ad R K x) :=
begin
  obtain ⟨n, hn⟩ := h,
  use n,
  exact linear_map.submodule_pow_eq_zero_of_pow_eq_zero (K.ad_comp_incl_eq x) hn,
end

lemma lie_algebra.is_nilpotent_ad_of_is_nilpotent {L : lie_subalgebra R A} {x : L}
  (h : is_nilpotent (x : A)) : is_nilpotent (lie_algebra.ad R L x) :=
L.is_nilpotent_ad_of_is_nilpotent_ad $ lie_algebra.ad_nilpotent_of_nilpotent R h

end of_associative


/-
This is a d∃∀duction file providing exercises for sets and maps. French version.
-/

import data.set
import tactic

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object
import push_neg_once    -- pushing negation just one step
import compute

-- dEAduction definitions
import set_definitions

-------------------------
-- dEAduction METADATA --
-------------------------
/- dEAduction
Title
    Arithmétique
Author
    Frédéric Le Roux, Thomas Richard
Institution
    Université du monde
Description
    Premier essai d'arithmétique
-/

local attribute [instance] classical.prop_decidable
---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course

open set

------------------
-- COURSE TITLE --
------------------
namespace definitions
/- dEAduction
PrettyName
    Ensembles et applications
-/

def pair (a: ℕ) := ∃ b, a = 2*b

def divise (a b:ℕ) := ∃ c, b = a * c

lemma definition.pair {a:ℕ} : (pair a) ↔ ∃ b, a = 2*b :=
/- dEAduction
ImplicitUse
  True
-/
begin
  refl
end

lemma definition.divise {a b : ℕ} : (divise a b) ↔ (∃ c, b = a * c) :=
/- dEAduction
ImplicitUse
  True
-/
begin
  refl
end

lemma exercise.mul_divise {a b c : ℕ} : divise a b → divise a (b*c) :=
begin
  intro H2,
  cases H2 with k,
  use (k*c),
  rw H2_h,
  ring,
end

end definitions

end course


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

! This file was ported from Lean 3 source module field_theory.is_alg_closed.algebraic_closure
! leanprover-community/mathlib commit 6a5a6494968741677358457a806f487c7e293d39
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.DirectLimit
import Mathbin.FieldTheory.IsAlgClosed.Basic
import Mathbin.FieldTheory.SplittingField

/-!
# Algebraic Closure

In this file we construct the algebraic closure of a field

## Main Definitions

- `algebraic_closure k` is an algebraic closure of `k` (in the same universe).
  It is constructed by taking the polynomial ring generated by indeterminates `x_f`
  corresponding to monic irreducible polynomials `f` with coefficients in `k`, and quotienting
  out by a maximal ideal containing every `f(x_f)`, and then repeating this step countably
  many times. See Exercise 1.13 in Atiyah--Macdonald.

## Tags

algebraic closure, algebraically closed
-/

universe u v w

noncomputable section

open Classical BigOperators Polynomial

open Polynomial

variable (k : Type u) [Field k]

namespace AlgebraicClosure

open MvPolynomial

/-- The subtype of monic irreducible polynomials -/
@[reducible]
def MonicIrreducible : Type u :=
  { f : k[X] // Monic f ∧ Irreducible f }
#align algebraic_closure.monic_irreducible AlgebraicClosure.MonicIrreducible

/-- Sends a monic irreducible polynomial `f` to `f(x_f)` where `x_f` is a formal indeterminate. -/
def evalXSelf (f : MonicIrreducible k) : MvPolynomial (MonicIrreducible k) k :=
  Polynomial.eval₂ MvPolynomial.C (X f) f
#align algebraic_closure.eval_X_self AlgebraicClosure.evalXSelf

/-- The span of `f(x_f)` across monic irreducible polynomials `f` where `x_f` is an
indeterminate. -/
def spanEval : Ideal (MvPolynomial (MonicIrreducible k) k) :=
  Ideal.span <| Set.range <| evalXSelf k
#align algebraic_closure.span_eval AlgebraicClosure.spanEval

/-- Given a finset of monic irreducible polynomials, construct an algebra homomorphism to the
splitting field of the product of the polynomials sending each indeterminate `x_f` represented by
the polynomial `f` in the finset to a root of `f`. -/
def toSplittingField (s : Finset (MonicIrreducible k)) :
    MvPolynomial (MonicIrreducible k) k →ₐ[k] SplittingField (∏ x in s, x : k[X]) :=
  MvPolynomial.aeval fun f =>
    if hf : f ∈ s then
      rootOfSplits _
        ((splits_prod_iff _ fun (j : MonicIrreducible k) _ => j.2.2.NeZero).1
          (SplittingField.splits _) f hf)
        (mt isUnit_iff_degree_eq_zero.2 f.2.2.not_unit)
    else 37
#align algebraic_closure.to_splitting_field AlgebraicClosure.toSplittingField

theorem toSplittingField_evalXSelf {s : Finset (MonicIrreducible k)} {f} (hf : f ∈ s) :
    toSplittingField k s (evalXSelf k f) = 0 :=
  by
  rw [to_splitting_field, eval_X_self, ← AlgHom.coe_toRingHom, hom_eval₂, AlgHom.coe_toRingHom,
    MvPolynomial.aeval_X, dif_pos hf, ← algebra_map_eq, AlgHom.comp_algebraMap]
  exact map_root_of_splits _ _ _
#align algebraic_closure.to_splitting_field_eval_X_self AlgebraicClosure.toSplittingField_evalXSelf

theorem spanEval_ne_top : spanEval k ≠ ⊤ :=
  by
  rw [Ideal.ne_top_iff_one, span_eval, Ideal.span, ← Set.image_univ,
    Finsupp.mem_span_image_iff_total]
  rintro ⟨v, _, hv⟩
  replace hv := congr_arg (to_splitting_field k v.support) hv
  rw [AlgHom.map_one, Finsupp.total_apply, Finsupp.sum, AlgHom.map_sum, Finset.sum_eq_zero] at hv
  · exact zero_ne_one hv
  intro j hj
  rw [smul_eq_mul, AlgHom.map_mul, to_splitting_field_eval_X_self k hj, MulZeroClass.mul_zero]
#align algebraic_closure.span_eval_ne_top AlgebraicClosure.spanEval_ne_top

/-- A random maximal ideal that contains `span_eval k` -/
def maxIdeal : Ideal (MvPolynomial (MonicIrreducible k) k) :=
  Classical.choose <| Ideal.exists_le_maximal _ <| spanEval_ne_top k
#align algebraic_closure.max_ideal AlgebraicClosure.maxIdeal

instance maxIdeal.isMaximal : (maxIdeal k).IsMaximal :=
  (Classical.choose_spec <| Ideal.exists_le_maximal _ <| spanEval_ne_top k).1
#align algebraic_closure.max_ideal.is_maximal AlgebraicClosure.maxIdeal.isMaximal

theorem le_maxIdeal : spanEval k ≤ maxIdeal k :=
  (Classical.choose_spec <| Ideal.exists_le_maximal _ <| spanEval_ne_top k).2
#align algebraic_closure.le_max_ideal AlgebraicClosure.le_maxIdeal

/-- The first step of constructing `algebraic_closure`: adjoin a root of all monic polynomials -/
def AdjoinMonic : Type u :=
  MvPolynomial (MonicIrreducible k) k ⧸ maxIdeal k
#align algebraic_closure.adjoin_monic AlgebraicClosure.AdjoinMonic

instance AdjoinMonic.field : Field (AdjoinMonic k) :=
  Ideal.Quotient.field _
#align algebraic_closure.adjoin_monic.field AlgebraicClosure.AdjoinMonic.field

instance AdjoinMonic.inhabited : Inhabited (AdjoinMonic k) :=
  ⟨37⟩
#align algebraic_closure.adjoin_monic.inhabited AlgebraicClosure.AdjoinMonic.inhabited

/-- The canonical ring homomorphism to `adjoin_monic k`. -/
def toAdjoinMonic : k →+* AdjoinMonic k :=
  (Ideal.Quotient.mk _).comp C
#align algebraic_closure.to_adjoin_monic AlgebraicClosure.toAdjoinMonic

instance AdjoinMonic.algebra : Algebra k (AdjoinMonic k) :=
  (toAdjoinMonic k).toAlgebra
#align algebraic_closure.adjoin_monic.algebra AlgebraicClosure.AdjoinMonic.algebra

theorem AdjoinMonic.algebraMap : algebraMap k (AdjoinMonic k) = (Ideal.Quotient.mk _).comp C :=
  rfl
#align algebraic_closure.adjoin_monic.algebra_map AlgebraicClosure.AdjoinMonic.algebraMap

theorem AdjoinMonic.isIntegral (z : AdjoinMonic k) : IsIntegral k z :=
  let ⟨p, hp⟩ := Ideal.Quotient.mk_surjective z
  hp ▸
    MvPolynomial.induction_on p (fun x => isIntegral_algebraMap) (fun p q => isIntegral_add)
      fun p f ih =>
      @isIntegral_mul _ _ _ _ _ _ (Ideal.Quotient.mk _ _) ih
        ⟨f, f.2.1,
          by
          erw [adjoin_monic.algebra_map, ← hom_eval₂, Ideal.Quotient.eq_zero_iff_mem]
          exact le_max_ideal k (Ideal.subset_span ⟨f, rfl⟩)⟩
#align algebraic_closure.adjoin_monic.is_integral AlgebraicClosure.AdjoinMonic.isIntegral

theorem AdjoinMonic.exists_root {f : k[X]} (hfm : f.Monic) (hfi : Irreducible f) :
    ∃ x : AdjoinMonic k, f.eval₂ (toAdjoinMonic k) x = 0 :=
  ⟨Ideal.Quotient.mk _ <| X (⟨f, hfm, hfi⟩ : MonicIrreducible k),
    by
    rw [to_adjoin_monic, ← hom_eval₂, Ideal.Quotient.eq_zero_iff_mem]
    exact le_max_ideal k (Ideal.subset_span <| ⟨_, rfl⟩)⟩
#align algebraic_closure.adjoin_monic.exists_root AlgebraicClosure.AdjoinMonic.exists_root

/-- The `n`th step of constructing `algebraic_closure`, together with its `field` instance. -/
def stepAux (n : ℕ) : Σα : Type u, Field α :=
  Nat.recOn n ⟨k, inferInstance⟩ fun n ih => ⟨@AdjoinMonic ih.1 ih.2, @AdjoinMonic.field ih.1 ih.2⟩
#align algebraic_closure.step_aux AlgebraicClosure.stepAux

/-- The `n`th step of constructing `algebraic_closure`. -/
def Step (n : ℕ) : Type u :=
  (stepAux k n).1
#align algebraic_closure.step AlgebraicClosure.Step

instance Step.field (n : ℕ) : Field (Step k n) :=
  (stepAux k n).2
#align algebraic_closure.step.field AlgebraicClosure.Step.field

instance Step.inhabited (n) : Inhabited (Step k n) :=
  ⟨37⟩
#align algebraic_closure.step.inhabited AlgebraicClosure.Step.inhabited

/-- The canonical inclusion to the `0`th step. -/
def toStepZero : k →+* Step k 0 :=
  RingHom.id k
#align algebraic_closure.to_step_zero AlgebraicClosure.toStepZero

/-- The canonical ring homomorphism to the next step. -/
def toStepSucc (n : ℕ) : Step k n →+* Step k (n + 1) :=
  @toAdjoinMonic (Step k n) (Step.field k n)
#align algebraic_closure.to_step_succ AlgebraicClosure.toStepSucc

instance Step.algebraSucc (n) : Algebra (Step k n) (Step k (n + 1)) :=
  (toStepSucc k n).toAlgebra
#align algebraic_closure.step.algebra_succ AlgebraicClosure.Step.algebraSucc

theorem toStepSucc.exists_root {n} {f : Polynomial (Step k n)} (hfm : f.Monic)
    (hfi : Irreducible f) : ∃ x : Step k (n + 1), f.eval₂ (toStepSucc k n) x = 0 :=
  @AdjoinMonic.exists_root _ (Step.field k n) _ hfm hfi
#align algebraic_closure.to_step_succ.exists_root AlgebraicClosure.toStepSucc.exists_root

/-- The canonical ring homomorphism to a step with a greater index. -/
def toStepOfLe (m n : ℕ) (h : m ≤ n) : Step k m →+* Step k n
    where
  toFun := Nat.leRecOn h fun n => toStepSucc k n
  map_one' := by
    induction' h with n h ih; · exact Nat.leRecOn_self 1
    rw [Nat.leRecOn_succ h, ih, RingHom.map_one]
  map_mul' x y := by
    induction' h with n h ih; · simp_rw [Nat.leRecOn_self]
    simp_rw [Nat.leRecOn_succ h, ih, RingHom.map_mul]
  map_zero' := by
    induction' h with n h ih; · exact Nat.leRecOn_self 0
    rw [Nat.leRecOn_succ h, ih, RingHom.map_zero]
  map_add' x y := by
    induction' h with n h ih; · simp_rw [Nat.leRecOn_self]
    simp_rw [Nat.leRecOn_succ h, ih, RingHom.map_add]
#align algebraic_closure.to_step_of_le AlgebraicClosure.toStepOfLe

@[simp]
theorem coe_toStepOfLe (m n : ℕ) (h : m ≤ n) :
    (toStepOfLe k m n h : Step k m → Step k n) = Nat.leRecOn h fun n => toStepSucc k n :=
  rfl
#align algebraic_closure.coe_to_step_of_le AlgebraicClosure.coe_toStepOfLe

instance Step.algebra (n) : Algebra k (Step k n) :=
  (toStepOfLe k 0 n n.zero_le).toAlgebra
#align algebraic_closure.step.algebra AlgebraicClosure.Step.algebra

instance Step.scalar_tower (n) : IsScalarTower k (Step k n) (Step k (n + 1)) :=
  IsScalarTower.of_algebraMap_eq fun z =>
    @Nat.leRecOn_succ (Step k) 0 n n.zero_le (n + 1).zero_le (fun n => toStepSucc k n) z
#align algebraic_closure.step.scalar_tower AlgebraicClosure.Step.scalar_tower

theorem Step.isIntegral (n) : ∀ z : Step k n, IsIntegral k z :=
  Nat.recOn n (fun z => isIntegral_algebraMap) fun n ih z =>
    isIntegral_trans ih _ (AdjoinMonic.isIntegral (Step k n) z : _)
#align algebraic_closure.step.is_integral AlgebraicClosure.Step.isIntegral

instance toStepOfLe.directedSystem : DirectedSystem (Step k) fun i j h => toStepOfLe k i j h :=
  ⟨fun i x h => Nat.leRecOn_self x, fun i₁ i₂ i₃ h₁₂ h₂₃ x => (Nat.leRecOn_trans h₁₂ h₂₃ x).symm⟩
#align algebraic_closure.to_step_of_le.directed_system AlgebraicClosure.toStepOfLe.directedSystem

end AlgebraicClosure

/-- The canonical algebraic closure of a field, the direct limit of adding roots to the field for
each polynomial over the field. -/
def AlgebraicClosure : Type u :=
  Ring.DirectLimit (AlgebraicClosure.Step k) fun i j h => AlgebraicClosure.toStepOfLe k i j h
#align algebraic_closure AlgebraicClosure

namespace AlgebraicClosure

instance : Field (AlgebraicClosure k) :=
  Field.DirectLimit.field _ _

instance : Inhabited (AlgebraicClosure k) :=
  ⟨37⟩

/-- The canonical ring embedding from the `n`th step to the algebraic closure. -/
def ofStep (n : ℕ) : Step k n →+* AlgebraicClosure k :=
  Ring.DirectLimit.of _ _ _
#align algebraic_closure.of_step AlgebraicClosure.ofStep

instance algebraOfStep (n) : Algebra (Step k n) (AlgebraicClosure k) :=
  (ofStep k n).toAlgebra
#align algebraic_closure.algebra_of_step AlgebraicClosure.algebraOfStep

theorem ofStep_succ (n : ℕ) : (ofStep k (n + 1)).comp (toStepSucc k n) = ofStep k n :=
  RingHom.ext fun x =>
    show Ring.DirectLimit.of (Step k) (fun i j h => toStepOfLe k i j h) _ _ = _
      by
      convert Ring.DirectLimit.of_f n.le_succ x
      ext x
      exact (Nat.leRecOn_succ' x).symm
#align algebraic_closure.of_step_succ AlgebraicClosure.ofStep_succ

theorem exists_ofStep (z : AlgebraicClosure k) : ∃ n x, ofStep k n x = z :=
  Ring.DirectLimit.exists_of z
#align algebraic_closure.exists_of_step AlgebraicClosure.exists_ofStep

-- slow
theorem exists_root {f : Polynomial (AlgebraicClosure k)} (hfm : f.Monic) (hfi : Irreducible f) :
    ∃ x : AlgebraicClosure k, f.eval x = 0 :=
  by
  have : ∃ n p, Polynomial.map (of_step k n) p = f := by
    convert Ring.DirectLimit.Polynomial.exists_of f
  obtain ⟨n, p, rfl⟩ := this
  rw [monic_map_iff] at hfm
  have := hfm.irreducible_of_irreducible_map (of_step k n) p hfi
  obtain ⟨x, hx⟩ := to_step_succ.exists_root k hfm this
  refine' ⟨of_step k (n + 1) x, _⟩
  rw [← of_step_succ k n, eval_map, ← hom_eval₂, hx, RingHom.map_zero]
#align algebraic_closure.exists_root AlgebraicClosure.exists_root

instance : IsAlgClosed (AlgebraicClosure k) :=
  IsAlgClosed.of_exists_root _ fun f => exists_root k

instance {R : Type _} [CommSemiring R] [alg : Algebra R k] : Algebra R (AlgebraicClosure k) :=
  ((ofStep k 0).comp (@algebraMap _ _ _ _ alg)).toAlgebra

theorem algebraMap_def {R : Type _} [CommSemiring R] [alg : Algebra R k] :
    algebraMap R (AlgebraicClosure k) = (ofStep k 0 : k →+* _).comp (@algebraMap _ _ _ _ alg) :=
  rfl
#align algebraic_closure.algebra_map_def AlgebraicClosure.algebraMap_def

instance {R S : Type _} [CommSemiring R] [CommSemiring S] [Algebra R S] [Algebra S k] [Algebra R k]
    [IsScalarTower R S k] : IsScalarTower R S (AlgebraicClosure k) :=
  IsScalarTower.of_algebraMap_eq fun x =>
    RingHom.congr_arg _ (IsScalarTower.algebraMap_apply R S k x : _)

/-- Canonical algebra embedding from the `n`th step to the algebraic closure. -/
def ofStepHom (n) : Step k n →ₐ[k] AlgebraicClosure k :=
  { ofStep k n with commutes' := fun x => Ring.DirectLimit.of_f n.zero_le x }
#align algebraic_closure.of_step_hom AlgebraicClosure.ofStepHom

theorem isAlgebraic : Algebra.IsAlgebraic k (AlgebraicClosure k) := fun z =>
  isAlgebraic_iff_isIntegral.2 <|
    let ⟨n, x, hx⟩ := exists_ofStep k z
    hx ▸ map_isIntegral (ofStepHom k n) (Step.isIntegral k n x)
#align algebraic_closure.is_algebraic AlgebraicClosure.isAlgebraic

instance : IsAlgClosure k (AlgebraicClosure k) :=
  ⟨AlgebraicClosure.isAlgClosed k, isAlgebraic k⟩

end AlgebraicClosure


/-
Copyright (c) 2022 Flemming Hermansen.
Released under Apache 2.0 license as described in
https://www.apache.org/licenses/LICENSE-2.0
Authors: Flemming Hermansen
-/

import tactic
import tactic.basic
import field_theory.separable

/-
This file defines the property 'is_rel_inv a b' for elements in a semigroup.
This property means that a is the inverse relatively to a unique idempotent element (a*b).
The definition does not mention a zero element, so it does not need a semiring structure.
Zero has zero as its relative inverse.
Non-zero nilpotent elements can not have a relative inverse.
Properties of the relative inverse if it exists:
The relation is commutative. A relative inverse element is unique if it exists.
Being relative inverses transfers along any possibly non-unital homomorphism.
All elements in a field have relativerse elements.
Products of semigroups preserve the property that all the elements have relative inverses.

Later it will be shown that
all algebraic separable elements in a commutative algebra over a field have
relative inverses.

Relative inverses can be used to prove that certain principal ideals are
isomorphic to fields.

Another application is to prove that certain ideals are maximal by producing a one-element
if the ideals are extended.

There were problems with type conversions from commutative rings
to non-unital commutative semigroups in Lean.
Therefore, this files uses commutative rings instrad of commutative semigroups.
-/

section inv_a

open_locale classical
open_locale big_operators
noncomputable theory

def is_rel_inv {A : Type} [comm_ring A] (a b : A) :=
-- let e := (a * b) in
(a * b) * (a * b) = (a * b) ∧ -- (a * b) is idempotent and b = inv a is the relative inverse
(a * b) * a = a ∧ -- the idempotent acts as a one-element for a
(a * b) * b = b. -- the idempotent acts as a one-element for b
-- if a = 0 then b = inv a = 0 and (a * b) = 0, but 0 is not mentioned explicitly

def all_rel_inv (A : Type*) [comm_ring A] : Prop :=
∀ (a : A), ∃ (b : A), is_rel_inv a b

lemma rel_inv_comm {A : Type} [comm_ring A] {a b : A} : is_rel_inv a b → is_rel_inv b a :=
begin
  unfold is_rel_inv,
  intros h, cases h with he h, cases h with ha hb,
  simp only [mul_comm b _],
  split, assumption,  split, assumption, assumption,
end

lemma rel_inv_is_unique {A : Type} [comm_ring A] (a b b' : A)
: is_rel_inv a b ∧ is_rel_inv a b' → b = b' :=
begin
  intros h, cases h with hb hb',
  unfold is_rel_inv at hb, unfold is_rel_inv at hb',
  rcases hb with ⟨he, hea, heb⟩, rcases hb' with ⟨he', hea', heb'⟩,
  have e_eq : a * b = a * b',
  begin
    calc a * b = ((a * b') * a ) * b : by rw hea'
    ... = ((a * b) * a) * b' : by simp only [mul_comm, mul_assoc]
    ... = a * b' : by rw hea
  end,
  have b_eq_b' : b = b',
  begin
    calc b = (a * b) * b : by rw heb
    ... =(a * b') * b : by rw e_eq
    ... = (a * b) * b' : by simp only [mul_comm, mul_assoc]
    ... = (a * b') * b' : by rw e_eq
    ... = b' : by rw heb'
  end,
  assumption,
end

lemma inv_invariant_hom_a_b {A : Type} [comm_ring A] {A' : Type} [comm_ring A']
(h : A →ₙ* A') { a b : A} : is_rel_inv a b → is_rel_inv (h.to_fun a) (h.to_fun b) :=
begin
  -- →ₙ* means a non_unital_homomorphism
  intros hl1,
  rcases hl1 with ⟨he, ha, hb⟩,
  unfold is_rel_inv,
  have mul1 : ∀ (x y : A), h.to_fun (x * y) = h.to_fun x * h.to_fun y,
    by exact h.map_mul,
  -- h_map_mul': ∀ (x y : A), h_to_fun (x * y) = h_to_fun x * h_to_fun y
  repeat {rw ← (mul1 _ _)},
  rw he, rw ha, rw hb,
  split, refl, split, refl, refl,
end

lemma inv_invariant_a_b {A : Type} [comm_ring A] {A' : Type} [comm_ring A']
(h : A ≃* A') { b : A} {a' : A'}:
(h.inv_fun a' * b) * (h.inv_fun a' * b) = (h.inv_fun a' * b) ∧
(h.inv_fun a' * b) * h.inv_fun a' = h.inv_fun a' ∧
(h.inv_fun a' * b) * b = b →
(a' * h.to_fun b) * (a' * h.to_fun b) = (a' * h.to_fun b) ∧
(a' * h.to_fun b) * a' = a' ∧
(a' * h.to_fun b) * h.to_fun b = h.to_fun b :=
begin
  intros hl1,
  rcases hl1 with ⟨he, ha, hb⟩,
  have ha' : a' = h.to_fun (h.inv_fun a'),
  begin
    rw ← (h.right_inv a'), simp,
  end,
  rw ha',
  have mul1 : ∀ (x y : A), h.to_fun (x * y) = h.to_fun x * h.to_fun y,
    by exact h.map_mul,
  -- h_map_mul': ∀ (x y : A), h_to_fun (x * y) = h_to_fun x * h_to_fun y
  repeat {rw ← (mul1 _ _)},
  rw he, rw ha, rw hb,
  split, refl, split, refl, refl,
end

lemma rel_inv_invariant_isomorphism' {A : Type} [comm_ring A] {A' : Type} [comm_ring A']
(h : A ≃* A') : all_rel_inv A → all_rel_inv A' :=
begin
  unfold all_rel_inv, unfold is_rel_inv,
  intros hl, intros a',
  specialize hl (h.inv_fun a'), cases hl with b hl1,
  use  h.to_fun b,
  apply inv_invariant_a_b h, assumption,
end

lemma field_all_rel_inv {A : Type} [field A] : all_rel_inv A :=
begin
  unfold all_rel_inv, unfold is_rel_inv,
  intros a,
  by_cases ha0 : a=0,
  {rw ha0,simp}, -- a = 0
  -- now ha0 : a ≠ 0
  have ha_div_a : a * (1/a) = 1, by exact mul_div_cancel' 1 ha0,
  use 1/a, rw ha_div_a, ring_nf, simp,
end

-- Products preserve all_rel_inv
lemma product_all_rel_inv {A : Type*} [comm_ring A] {A' : Type*} [comm_ring A']
  : ( all_rel_inv A) → ( all_rel_inv A')  → all_rel_inv (A × A') :=
  begin
    unfold all_rel_inv is_rel_inv,
    intros hA hA' c,
    cases c with a a', specialize hA a, specialize hA' a',
    cases hA with b hA, cases hA with he hA, cases hA with ha hb,
    cases hA' with b' hA', cases hA' with he' hA', cases hA' with ha' hb',
    use ⟨ b, b' ⟩,
    split, simp, exact and.intro he he',
    split, simp, exact and.intro ha ha',
    simp, exact and.intro hb hb',
  end

  end inv_a


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
-/
import ring_theory.adjoin_root
import ring_theory.localization.basic

/-!
# Localizations away from an element

## Main definitions

 * `is_localization.away (x : R) S` expresses that `S` is a localization away from `x`, as an
   abbreviation of `is_localization (submonoid.powers x) S`

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

section comm_semiring

variables {R : Type*} [comm_semiring R] (M : submonoid R) {S : Type*} [comm_semiring S]
variables [algebra R S] {P : Type*} [comm_semiring P]

namespace is_localization

section away

variables (x : R)

/-- Given `x : R`, the typeclass `is_localization.away x S` states that `S` is
isomorphic to the localization of `R` at the submonoid generated by `x`. -/
abbreviation away (S : Type*) [comm_semiring S] [algebra R S] :=
is_localization (submonoid.powers x) S

namespace away

variables [is_localization.away x S]

/-- Given `x : R` and a localization map `F : R →+* S` away from `x`, `inv_self` is `(F x)⁻¹`. -/
noncomputable def inv_self : S :=
mk' S (1 : R) ⟨x, submonoid.mem_powers _⟩

@[simp] lemma mul_inv_self : algebra_map R S x * inv_self x = 1 :=
by { convert is_localization.mk'_mul_mk'_eq_one _ 1, symmetry, apply is_localization.mk'_one }

variables {g : R →+* P}

/-- Given `x : R`, a localization map `F : R →+* S` away from `x`, and a map of `comm_semiring`s
`g : R →+* P` such that `g x` is invertible, the homomorphism induced from `S` to `P` sending
`z : S` to `g y * (g x)⁻ⁿ`, where `y : R, n : ℕ` are such that `z = F y * (F x)⁻ⁿ`. -/
noncomputable def lift (hg : is_unit (g x)) : S →+* P :=
is_localization.lift $ λ (y : submonoid.powers x), show is_unit (g y.1),
begin
  obtain ⟨n, hn⟩ := y.2,
  rw [←hn, g.map_pow],
  exact is_unit.map (pow_monoid_hom n : P →* P) hg,
end

@[simp] lemma away_map.lift_eq (hg : is_unit (g x)) (a : R) :
  lift x hg ((algebra_map R S) a) = g a := lift_eq _ _

@[simp] lemma away_map.lift_comp (hg : is_unit (g x)) :
  (lift x hg).comp (algebra_map R S) = g := lift_comp _

/-- Given `x y : R` and localizations `S`, `P` away from `x` and `x * y`
respectively, the homomorphism induced from `S` to `P`. -/
noncomputable def away_to_away_right (y : R) [algebra R P] [is_localization.away (x * y) P] :
  S →+* P :=
lift x $ show is_unit ((algebra_map R P) x), from
is_unit_of_mul_eq_one ((algebra_map R P) x) (mk' P y ⟨x * y, submonoid.mem_powers _⟩) $
by rw [mul_mk'_eq_mk'_of_mul, mk'_self]

variables (S) (Q : Type*) [comm_semiring Q] [algebra P Q]

/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
noncomputable
def map (f : R →+* P) (r : R) [is_localization.away r S]
  [is_localization.away (f r) Q] : S →+* Q :=
is_localization.map Q f
  (show submonoid.powers r ≤ (submonoid.powers (f r)).comap f,
    by { rintros x ⟨n, rfl⟩, use n, simp })

end away

end away

variables [is_localization M S]

section at_units
variables (R) (S) (M)

/-- The localization at a module of units is isomorphic to the ring -/
noncomputable
def at_units (H : ∀ x : M, is_unit (x : R)) : R ≃ₐ[R] S :=
begin
  refine alg_equiv.of_bijective (algebra.of_id R S) ⟨_, _⟩,
  { intros x y hxy,
    obtain ⟨c, eq⟩ := (is_localization.eq_iff_exists M S).mp hxy,
    obtain ⟨u, hu⟩ := H c,
    rwa [← hu, units.mul_right_inj] at eq },
  { intros y,
    obtain ⟨⟨x, s⟩, eq⟩ := is_localization.surj M y,
    obtain ⟨u, hu⟩ := H s,
    use x * u.inv,
    dsimp only [algebra.of_id, ring_hom.to_fun_eq_coe, alg_hom.coe_mk],
    rw [ring_hom.map_mul, ← eq, ← hu, mul_assoc, ← ring_hom.map_mul],
    simp }
end

/-- The localization away from a unit is isomorphic to the ring -/
noncomputable
def at_unit (x : R) (e : is_unit x) [is_localization.away x S] : R ≃ₐ[R] S :=
begin
  apply at_units R (submonoid.powers x),
  rintros ⟨xn, n, hxn⟩,
  obtain ⟨u, hu⟩ := e,
  rw is_unit_iff_exists_inv,
  use u.inv ^ n,
  simp[← hxn, ← hu, ← mul_pow]
end

/-- The localization at one is isomorphic to the ring. -/
noncomputable
def at_one [is_localization.away (1 : R) S] : R ≃ₐ[R] S :=
@at_unit R _ S _ _ (1 : R) is_unit_one _

lemma away_of_is_unit_of_bijective {R : Type*} (S : Type*) [comm_ring R] [comm_ring S]
  [algebra R S] {r : R} (hr : is_unit r) (H : function.bijective (algebra_map R S)) :
  is_localization.away r S :=
{ map_units := by { rintros ⟨_, n, rfl⟩, exact (algebra_map R S).is_unit_map (hr.pow _) },
  surj := λ z, by { obtain ⟨z', rfl⟩ := H.2 z, exact ⟨⟨z', 1⟩, by simp⟩ },
  eq_iff_exists := λ x y, begin
    erw H.1.eq_iff,
    split,
    { rintro rfl, exact ⟨1, rfl⟩ },
    { rintro ⟨⟨_, n, rfl⟩, e⟩, exact (hr.pow _).mul_right_inj.mp e }
  end }

end at_units

end is_localization

namespace localization

open is_localization

variables {M}

/-- Given a map `f : R →+* S` and an element `r : R`, such that `f r` is invertible,
  we may construct a map `Rᵣ →+* S`. -/
noncomputable
abbreviation away_lift (f : R →+* P) (r : R) (hr : is_unit (f r)) :
  localization.away r →+* P :=
is_localization.away.lift r hr

/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
noncomputable
abbreviation away_map (f : R →+* P) (r : R) :
  localization.away r →+* localization.away (f r) :=
is_localization.away.map _ _ f r

end localization

end comm_semiring

open polynomial adjoin_root localization

variables {R : Type*} [comm_ring R]

local attribute [instance] is_localization.alg_hom_subsingleton adjoin_root.alg_hom_subsingleton

/-- The `R`-`alg_equiv` between the localization of `R` away from `r` and
    `R` with an inverse of `r` adjoined. -/
noncomputable def localization.away_equiv_adjoin (r : R) : away r ≃ₐ[R] adjoin_root (C r * X - 1) :=
alg_equiv.of_alg_hom
  { commutes' := is_localization.away.away_map.lift_eq r
      (is_unit_of_mul_eq_one _ _ $ root_is_inv r), .. away_lift _ r _ }
  (lift_hom _ (is_localization.away.inv_self r) $ by simp only
    [map_sub, map_mul, aeval_C, aeval_X, is_localization.away.mul_inv_self, aeval_one, sub_self])
  (subsingleton.elim _ _)
  (subsingleton.elim _ _)

lemma is_localization.adjoin_inv (r : R) : is_localization.away r (adjoin_root $ C r * X - 1) :=
is_localization.is_localization_of_alg_equiv _ (localization.away_equiv_adjoin r)

lemma is_localization.away.finite_presentation (r : R) {S} [comm_ring S] [algebra R S]
  [is_localization.away r S] : algebra.finite_presentation R S :=
(adjoin_root.finite_presentation _).equiv $ (localization.away_equiv_adjoin r).symm.trans $
  is_localization.alg_equiv (submonoid.powers r) _ _


#eval Lean.versionString

theorem zero_div_eq_zero: ∀x, 0 / x = 0 := by {
  intro x;
  rw [Nat.div_eq];
  have h: ∀y, ¬(0 < y ∧ y ≤ 0) := by {
    intro y contra;
    have h': y = 0 := by {
      apply Nat.eq_zero_of_le_zero;
      apply contra.right;
    };
    rw [h'] at contra;
    apply Nat.lt_irrefl;
    apply contra.left;
  };
  simp [h];
}

theorem div_lt: ∀x y, x > 0 → y > 1 → x / y < x := by {
  intro x y x_gt_0 y_gt_1;
  induction x, y using Nat.div.inductionOn with
  | ind x y prems ih => {
    conv => {
      lhs;
      rw [Nat.div_eq];
      simp [prems];
    };

    have x_sub_y_add_y: x = x - y + y := by {
      apply Eq.symm;
      apply Nat.sub_add_cancel;
      apply prems.right;
    };
    have h: (x - y) / y + 1 < x := by {
      conv =>
        rhs;
        rw [x_sub_y_add_y];
      have or: y = x ∨ y < x := by {
        apply Nat.eq_or_lt_of_le;
        apply prems.right;
      };
      match or with
      | Or.inl y_eq_x => {
        simp [y_eq_x, zero_div_eq_zero];
        rw [y_eq_x] at y_gt_1;
        assumption;
      }
      | Or.inr y_lt_x => {
        apply Nat.add_lt_add;
        . {
          apply ih;
          . {
            apply Nat.zero_lt_sub_of_lt;
            assumption;
          }
          . assumption;
        }
        . assumption;
      }
    };
    assumption
  }
  | base x y prems => {
    rw [Nat.div_eq];
    simp [prems];
    assumption;
  }
}

def PositionalNotation {base: Nat} {h: base > 1} := List (Fin base)
def PositionalNotation.toNat {base: Nat} {h: base > 1}: @PositionalNotation base h → Nat :=
  List.foldr (fun (digit: Fin base) (accum: Nat) => digit + accum * base) 0

def toPositionalNotation {base: Nat} {h: base > 1} (n: Nat): @PositionalNotation base h :=
  if isLt: n < base then
    [Fin.mk n isLt]
  else
    let rem := n % base;
    let quot := n / base;
    let h': base > 0 := by {
      apply Nat.lt_trans;
      case m => apply 1;
      decide;
      assumption;
    };
    let n_gt_0: n > 0 := by {
      apply Nat.lt_of_lt_of_le;
      case m => apply base;
      . apply h';
      . match Nat.lt_or_ge n base with
        | Or.inl _ => contradiction;
        | Or.inr _ => assumption;
    };
    Fin.mk rem (Nat.mod_lt n h') :: @toPositionalNotation base h quot
termination_by _ n => n
decreasing_by {
  apply div_lt;
  . apply n_gt_0;
  . apply h;
}

theorem add_div_mod_eq: ∀x y: Nat, x % y + x / y * y = x := by {
  intro x y;
  induction x, y using Nat.div.inductionOn with
  | ind x y prems ih => {
    rw [Nat.div_eq, Nat.mod_eq];
    simp [prems];
    conv in _ * y => {
      apply Nat.add_mul;
    };
    simp;
    rw [←Nat.add_assoc, ih, Nat.sub_add_cancel];
    exact prems.right;
  }
  | base x y prems => {
    rw [Nat.div_eq, Nat.mod_eq];
    simp [prems];
  };
}

theorem unfoldPositionalNotationToNat: ∀base, {h: base > 1} →
  ∀rem rest, @PositionalNotation.toNat base h (rem :: rest) = rem + @PositionalNotation.toNat base h rest * base := by {
    intro base h rem rest;
    simp [PositionalNotation.toNat, List.foldr];
  }

theorem toPos_inv: ∀base, {h: base > 1} → ∀n, @PositionalNotation.toNat base h (@toPositionalNotation base h n) = n := by {
  intro base h n;
  let P := fun x => @PositionalNotation.toNat base h (@toPositionalNotation base h x) = x;
  have goal: P n := by {
    apply Nat.lt_wfRel.wf.induction;
    intro x ih;
    unfold toPositionalNotation;
    match Nat.lt_or_ge x base with
    | Or.inl x_lt_base => simp [x_lt_base, PositionalNotation.toNat, List.foldr];
    | Or.inr x_gt_base => {
      have not_x_lt_base: ¬(x < base) := by {
        intro contra;
        apply Nat.not_le_of_gt contra x_gt_base;
      };
      simp [not_x_lt_base, unfoldPositionalNotationToNat];
      have prev: P (x / base) := by {
        apply ih;
        apply div_lt;
        . {
          apply @Nat.lt_of_lt_of_le _ base _;
          . {
            apply Nat.lt_trans;
            . apply Nat.zero_lt_one;
            . assumption;
          }
          . apply x_gt_base;
        }
        . assumption;
      };
      rw [prev];
      apply add_div_mod_eq;
    }
  };
  exact goal;
}

def PositionalNotation.sumDigits {base: Nat} {h: base > 1} (digits: @PositionalNotation base h): Nat :=
  List.foldr (fun digit accum => digit.val + accum) 0 digits

theorem unfoldPositionalNotationSumDigits: ∀base, {h: base > 1} →
  ∀rem rest, @PositionalNotation.sumDigits base h (rem :: rest) = (rem + @PositionalNotation.sumDigits base h rest) := by {
    intro base h rem rest;
    simp [PositionalNotation.sumDigits, List.foldr];
  }

-- From mathlib4
theorem add_mod_right (x z: Nat): (x + z) % z = x % z := by {
  conv => {
    rhs;
    rw [←Nat.add_sub_cancel x z]
  }
  apply Nat.mod_eq_sub_mod;
  apply Nat.le_add_left;
}

theorem add_mod_left (x z: Nat): (x + z) % x = z % x := by {
  rw [Nat.add_comm, add_mod_right];
}

theorem add_mul_mod_self_left (x y z: Nat): (x + y * z) % y = x % y := by {
  induction z with
  | zero => simp;
  | succ z ih => rw [Nat.mul_succ, ←Nat.add_assoc, add_mod_right, ih];
}

theorem add_mul_mod_self_right (x y z: Nat): (x + y * z) % z = x % z := by {
  rw [Nat.mul_comm, add_mul_mod_self_left];
}

theorem mod_add_mod (m n k: Nat): (m % n + k) % n = (m + k) % n := by {
  conv => {
    rhs;
    rw [←add_div_mod_eq m n, Nat.add_right_comm, add_mul_mod_self_right];
  }
}

theorem add_mod_mod (m n k: Nat): (m + n % k) % k = (m + n) % k := by {
  rw [Nat.add_comm, mod_add_mod, Nat.add_comm];
}

theorem add_mod (a b n: Nat): (a + b) % n = (a % n + b % n) % n := by {
  rw [mod_add_mod, add_mod_mod];
}

-- For this theory
theorem mod_add_left_cancel: ∀x n a b: Nat,
  a % n = b % n →
  (x + a) % n = (x + b) % n := by {
    intro x n a b h;
    rw [add_mod];
    apply Eq.symm;
    rw [add_mod];
    rw [h];
  }

theorem mod_sub_1: ∀n, {h: n > 1} → n % (n - 1) = 1 % (n - 1) := by {
  intro n h;
  have expand: n = n - 1 + 1 := by {
    apply Eq.symm;
    apply Nat.sub_add_cancel;
    apply Nat.le_of_lt h;
  }
  conv in n % (n - 1) => {
    lhs;
    rw [expand];
  }
  rw [add_mod_left];
}

theorem mul_mod_eq_mod: ∀x n, {h: n > 1} → x * n % (n - 1) = x % (n - 1) := by {
  intro x n h;
  induction x with
  | zero => simp;
  | succ x ih => {
    conv => {
      lhs;
      rw [Nat.mul_comm, Nat.mul_succ, add_mod, Nat.mul_comm, ih];
    }
    conv => {
      rhs;
      rw [←Nat.add_one, add_mod];
    };
    rw [mod_sub_1];
    assumption;
  }
}

theorem PositionalNotation.mod_eq_mod_sum: ∀base, {h: base > 1} →
  ∀digits, @PositionalNotation.toNat base h digits % (base - 1) = PositionalNotation.sumDigits digits % (base - 1) := by {
    intro base h digits;
    induction digits with
    | nil => simp [PositionalNotation.toNat, PositionalNotation.sumDigits, List.foldr];
    | cons rem rest ih => {
      rw [unfoldPositionalNotationToNat, unfoldPositionalNotationSumDigits];
      apply mod_add_left_cancel;
      rw [mul_mod_eq_mod];
      . exact ih;
      . exact h;
    }
  }


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

import ring_theory.witt_vector.init_tail
import tactic.equiv_rw

/-!

# Truncated Witt vectors

The ring of truncated Witt vectors (of length `n`) is a quotient of the ring of Witt vectors.
It retains the first `n` coefficients of each Witt vector.
In this file, we set up the basic quotient API for this ring.

The ring of Witt vectors is the projective limit of all the rings of truncated Witt vectors.

## Main declarations

- `truncated_witt_vector`: the underlying type of the ring of truncated Witt vectors
- `truncated_witt_vector.comm_ring`: the ring structure on truncated Witt vectors
- `witt_vector.truncate`: the quotient homomorphism that truncates a Witt vector,
  to obtain a truncated Witt vector
- `truncated_witt_vector.truncate`: the homomorphism that truncates
  a truncated Witt vector of length `n` to one of length `m` (for some `m ≤ n`)
- `witt_vector.lift`: the unique ring homomorphism into the ring of Witt vectors
  that is compatible with a family of ring homomorphisms to the truncated Witt vectors:
  this realizes the ring of Witt vectors as projective limit of the rings of truncated Witt vectors

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

open function (injective surjective)

noncomputable theory

variables {p : ℕ} [hp : fact p.prime] (n : ℕ) (R : Type*)

local notation `𝕎` := witt_vector p -- type as `\bbW`

/--
A truncated Witt vector over `R` is a vector of elements of `R`,
i.e., the first `n` coefficients of a Witt vector.
We will define operations on this type that are compatible with the (untruncated) Witt
vector operations.

`truncated_witt_vector p n R` takes a parameter `p : ℕ` that is not used in the definition.
In practice, this number `p` is assumed to be a prime number,
and under this assumption we construct a ring structure on `truncated_witt_vector p n R`.
(`truncated_witt_vector p₁ n R` and `truncated_witt_vector p₂ n R` are definitionally
equal as types but will have different ring operations.)
-/
@[nolint unused_arguments]
def truncated_witt_vector (p : ℕ) (n : ℕ) (R : Type*) := fin n → R

instance (p n : ℕ) (R : Type*) [inhabited R] : inhabited (truncated_witt_vector p n R) :=
⟨λ _, default R⟩

variables {n R}

namespace truncated_witt_vector

variables (p)

/-- Create a `truncated_witt_vector` from a vector `x`. -/
def mk (x : fin n → R) : truncated_witt_vector p n R := x

variables {p}

/-- `x.coeff i` is the `i`th entry of `x`. -/
def coeff (i : fin n) (x : truncated_witt_vector p n R) : R := x i

@[ext]
lemma ext {x y : truncated_witt_vector p n R} (h : ∀ i, x.coeff i = y.coeff i) : x = y :=
funext h

lemma ext_iff {x y : truncated_witt_vector p n R} : x = y ↔ ∀ i, x.coeff i = y.coeff i :=
⟨λ h i, by rw h, ext⟩

@[simp] lemma coeff_mk (x : fin n → R) (i : fin n) :
  (mk p x).coeff i = x i := rfl

@[simp] lemma mk_coeff (x : truncated_witt_vector p n R) :
  mk p (λ i, x.coeff i) = x :=
by { ext i, rw [coeff_mk] }

variable [comm_ring R]

/--
We can turn a truncated Witt vector `x` into a Witt vector
by setting all coefficients after `x` to be 0.
-/
def out (x : truncated_witt_vector p n R) : 𝕎 R :=
witt_vector.mk p $ λ i, if h : i < n then x.coeff ⟨i, h⟩ else 0

@[simp]
lemma coeff_out (x : truncated_witt_vector p n R) (i : fin n) :
  x.out.coeff i = x.coeff i :=
by rw [out, witt_vector.coeff_mk, dif_pos i.is_lt, fin.eta]

lemma out_injective : injective (@out p n R _) :=
begin
  intros x y h,
  ext i,
  rw [witt_vector.ext_iff] at h,
  simpa only [coeff_out] using h ↑i
end

end truncated_witt_vector

namespace witt_vector

variables {p} (n)

section

/-- `truncate_fun n x` uses the first `n` entries of `x` to construct a `truncated_witt_vector`,
which has the same base `p` as `x`.
This function is bundled into a ring homomorphism in `witt_vector.truncate` -/
def truncate_fun (x : 𝕎 R) : truncated_witt_vector p n R :=
truncated_witt_vector.mk p $ λ i, x.coeff i

end

variables {n}

@[simp] lemma coeff_truncate_fun (x : 𝕎 R) (i : fin n) :
  (truncate_fun n x).coeff i = x.coeff i :=
by rw [truncate_fun, truncated_witt_vector.coeff_mk]

variable [comm_ring R]

@[simp] lemma out_truncate_fun (x : 𝕎 R) :
  (truncate_fun n x).out = init n x :=
begin
  ext i,
  dsimp [truncated_witt_vector.out, init, select],
  split_ifs with hi, swap, { refl },
  rw [coeff_truncate_fun, fin.coe_mk],
end

end witt_vector

namespace truncated_witt_vector

variable [comm_ring R]

@[simp] lemma truncate_fun_out (x : truncated_witt_vector p n R) :
  x.out.truncate_fun n = x :=
by simp only [witt_vector.truncate_fun, coeff_out, mk_coeff]

open witt_vector
variables (p n R)

include hp

instance : has_zero (truncated_witt_vector p n R) :=
⟨truncate_fun n 0⟩

instance : has_one (truncated_witt_vector p n R) :=
⟨truncate_fun n 1⟩

instance : has_add (truncated_witt_vector p n R) :=
⟨λ x y, truncate_fun n (x.out + y.out)⟩

instance : has_mul (truncated_witt_vector p n R) :=
⟨λ x y, truncate_fun n (x.out * y.out)⟩

instance : has_neg (truncated_witt_vector p n R) :=
⟨λ x, truncate_fun n (- x.out)⟩

instance : has_sub (truncated_witt_vector p n R) :=
⟨λ x y, truncate_fun n (x.out - y.out)⟩

@[simp] lemma coeff_zero (i : fin n) :
  (0 : truncated_witt_vector p n R).coeff i = 0 :=
begin
  show coeff i (truncate_fun _ 0 : truncated_witt_vector p n R) = 0,
  rw [coeff_truncate_fun, witt_vector.zero_coeff],
end

end truncated_witt_vector

/-- A macro tactic used to prove that `truncate_fun` respects ring operations. -/
meta def tactic.interactive.witt_truncate_fun_tac : tactic unit :=
`[show _ = truncate_fun n _,
  apply truncated_witt_vector.out_injective,
  iterate { rw [out_truncate_fun] },
  rw init_add <|> rw init_mul <|> rw init_neg <|> rw init_sub]

namespace witt_vector

variables (p n R)
variable [comm_ring R]

lemma truncate_fun_surjective :
  surjective (@truncate_fun p n R) :=
function.right_inverse.surjective truncated_witt_vector.truncate_fun_out

include hp

@[simp]
lemma truncate_fun_zero : truncate_fun n (0 : 𝕎 R) = 0 := rfl

@[simp]
lemma truncate_fun_one : truncate_fun n (1 : 𝕎 R) = 1 := rfl

variables {p R}

@[simp]
lemma truncate_fun_add (x y : 𝕎 R) :
  truncate_fun n (x + y) = truncate_fun n x + truncate_fun n y :=
by witt_truncate_fun_tac

@[simp]
lemma truncate_fun_mul (x y : 𝕎 R) :
  truncate_fun n (x * y) = truncate_fun n x * truncate_fun n y :=
by witt_truncate_fun_tac

lemma truncate_fun_neg (x : 𝕎 R) :
  truncate_fun n (-x) = -truncate_fun n x :=
by witt_truncate_fun_tac

lemma truncate_fun_sub (x y : 𝕎 R) :
  truncate_fun n (x - y) = truncate_fun n x - truncate_fun n y :=
by witt_truncate_fun_tac

end witt_vector

namespace truncated_witt_vector
open witt_vector
variables (p n R)
variable [comm_ring R]
include hp

instance : comm_ring (truncated_witt_vector p n R) :=
(truncate_fun_surjective p n R).comm_ring _
  (truncate_fun_zero p n R)
  (truncate_fun_one p n R)
  (truncate_fun_add n)
  (truncate_fun_mul n)
  (truncate_fun_neg n)
  (truncate_fun_sub n)

end truncated_witt_vector

namespace witt_vector
open truncated_witt_vector

variables (n)
variable [comm_ring R]
include hp

/-- `truncate n` is a ring homomorphism that truncates `x` to its first `n` entries
to obtain a `truncated_witt_vector`, which has the same base `p` as `x`. -/
def truncate : 𝕎 R →+* truncated_witt_vector p n R :=
{ to_fun := truncate_fun n,
  map_zero' := truncate_fun_zero p n R,
  map_add' := truncate_fun_add n,
  map_one' := truncate_fun_one p n R,
  map_mul' := truncate_fun_mul n }

variables (p n R)

lemma truncate_surjective : surjective (truncate n : 𝕎 R → truncated_witt_vector p n R) :=
truncate_fun_surjective p n R

variables {p n R}

@[simp] lemma coeff_truncate (x : 𝕎 R) (i : fin n) :
  (truncate n x).coeff i = x.coeff i :=
coeff_truncate_fun _ _

variables (n)

lemma mem_ker_truncate (x : 𝕎 R) :
  x ∈ (@truncate p _ n R _).ker ↔ ∀ i < n, x.coeff i = 0 :=
begin
  simp only [ring_hom.mem_ker, truncate, truncate_fun, ring_hom.coe_mk,
    truncated_witt_vector.ext_iff, truncated_witt_vector.coeff_mk, coeff_zero],
  exact subtype.forall
end

variables (p)

@[simp] lemma truncate_mk (f : ℕ → R) :
  truncate n (mk p f) = truncated_witt_vector.mk _ (λ k, f k) :=
begin
  ext i,
  rw [coeff_truncate, coeff_mk, truncated_witt_vector.coeff_mk],
end

end witt_vector

namespace truncated_witt_vector

variable [comm_ring R]
include hp

/--
A ring homomorphism that truncates a truncated Witt vector of length `m` to
a truncated Witt vector of length `n`, for `n ≤ m`.
-/
def truncate {m : ℕ} (hm : n ≤ m) : truncated_witt_vector p m R →+* truncated_witt_vector p n R :=
ring_hom.lift_of_right_inverse (witt_vector.truncate m) out truncate_fun_out
  ⟨witt_vector.truncate n,
  begin
    intro x,
    simp only [witt_vector.mem_ker_truncate],
    intros h i hi,
    exact h i (lt_of_lt_of_le hi hm)
  end⟩

@[simp] lemma truncate_comp_witt_vector_truncate {m : ℕ} (hm : n ≤ m) :
  (@truncate p _ n R _ m hm).comp (witt_vector.truncate m) = witt_vector.truncate n :=
ring_hom.lift_of_right_inverse_comp _ _ _ _

@[simp] lemma truncate_witt_vector_truncate {m : ℕ} (hm : n ≤ m) (x : 𝕎 R) :
  truncate hm (witt_vector.truncate m x) = witt_vector.truncate n x :=
ring_hom.lift_of_right_inverse_comp_apply _ _ _ _ _

@[simp] lemma truncate_truncate {n₁ n₂ n₃ : ℕ} (h1 : n₁ ≤ n₂) (h2 : n₂ ≤ n₃)
  (x : truncated_witt_vector p n₃ R) :
  (truncate h1) (truncate h2 x) = truncate (h1.trans h2) x :=
begin
  obtain ⟨x, rfl⟩ := witt_vector.truncate_surjective p n₃ R x,
  simp only [truncate_witt_vector_truncate],
end

@[simp] lemma truncate_comp {n₁ n₂ n₃ : ℕ} (h1 : n₁ ≤ n₂) (h2 : n₂ ≤ n₃) :
  (@truncate p _ _ R _ _ h1).comp (truncate h2) = truncate (h1.trans h2) :=
begin
  ext1 x, simp only [truncate_truncate, function.comp_app, ring_hom.coe_comp]
end

lemma truncate_surjective {m : ℕ} (hm : n ≤ m) : surjective (@truncate p _ _ R _ _ hm) :=
begin
  intro x,
  obtain ⟨x, rfl⟩ := witt_vector.truncate_surjective p _ R x,
  exact ⟨witt_vector.truncate _ x, truncate_witt_vector_truncate _ _⟩
end

@[simp] lemma coeff_truncate {m : ℕ} (hm : n ≤ m) (i : fin n) (x : truncated_witt_vector p m R) :
  (truncate hm x).coeff i = x.coeff (fin.cast_le hm i) :=
begin
  obtain ⟨y, rfl⟩ := witt_vector.truncate_surjective p _ _ x,
  simp only [truncate_witt_vector_truncate, witt_vector.coeff_truncate, fin.coe_cast_le],
end

section fintype
omit hp

instance {R : Type*} [fintype R] : fintype (truncated_witt_vector p n R) := pi.fintype

variables (p n R)

lemma card {R : Type*} [fintype R] :
  fintype.card (truncated_witt_vector p n R) = fintype.card R ^ n :=
by simp only [truncated_witt_vector, fintype.card_fin, fintype.card_fun]

end fintype

lemma infi_ker_truncate : (⨅ i : ℕ, (@witt_vector.truncate p _ i R _).ker) = ⊥ :=
begin
  rw [submodule.eq_bot_iff],
  intros x hx,
  ext,
  simp only [witt_vector.mem_ker_truncate, ideal.mem_infi, witt_vector.zero_coeff] at hx ⊢,
  exact hx _ _ (nat.lt_succ_self _)
end

end truncated_witt_vector

namespace witt_vector
open truncated_witt_vector (hiding truncate coeff)

section lift

variable [comm_ring R]
variables {S : Type*} [semiring S]
variable (f : Π k : ℕ, S →+* truncated_witt_vector p k R)
variable f_compat : ∀ (k₁ k₂ : ℕ) (hk : k₁ ≤ k₂),
           (truncated_witt_vector.truncate hk).comp (f k₂) = f k₁
variables {p R}
variable (n)

/--
Given a family `fₖ : S → truncated_witt_vector p k R` and `s : S`, we produce a Witt vector by
defining the `k`th entry to be the final entry of `fₖ s`.
-/
def lift_fun (s : S) : 𝕎 R :=
witt_vector.mk p $ λ k, truncated_witt_vector.coeff (fin.last k) (f (k+1) s)

variables {f}
include f_compat

@[simp] lemma truncate_lift_fun (s : S) :
  witt_vector.truncate n (lift_fun f s) = f n s :=
begin
  ext i,
  simp only [lift_fun, truncated_witt_vector.coeff_mk, witt_vector.truncate_mk],
  rw [← f_compat (i+1) n i.is_lt, ring_hom.comp_apply, truncated_witt_vector.coeff_truncate],
  -- this is a bit unfortunate
  congr' with _,
  simp only [fin.coe_last, fin.coe_cast_le],
end

variable (f)

/--
Given compatible ring homs from `S` into `truncated_witt_vector n` for each `n`, we can lift these
to a ring hom `S → 𝕎 R`.

`lift` defines the universal property of `𝕎 R` as the inverse limit of `truncated_witt_vector n`.
-/
def lift : S →+* 𝕎 R :=
by refine_struct { to_fun := lift_fun f };
   { intros,
     rw [← sub_eq_zero, ← ideal.mem_bot, ← infi_ker_truncate, ideal.mem_infi],
     simp [ring_hom.mem_ker, f_compat] }

variable {f}

@[simp] lemma truncate_lift (s : S) :
  witt_vector.truncate n (lift _ f_compat s) = f n s :=
truncate_lift_fun _ f_compat s

@[simp] lemma truncate_comp_lift :
  (witt_vector.truncate n).comp (lift _ f_compat) = f n :=
by { ext1, rw [ring_hom.comp_apply, truncate_lift] }

/-- The uniqueness part of the universal property of `𝕎 R`. -/
lemma lift_unique (g : S →+* 𝕎 R) (g_compat : ∀ k, (witt_vector.truncate k).comp g = f k) :
  lift _ f_compat = g :=
begin
  ext1 x,
  rw [← sub_eq_zero, ← ideal.mem_bot, ← infi_ker_truncate, ideal.mem_infi],
  intro i,
  simp only [ring_hom.mem_ker, g_compat, ←ring_hom.comp_apply,
    truncate_comp_lift, ring_hom.map_sub, sub_self],
end

omit f_compat
include hp

/-- The universal property of `𝕎 R` as projective limit of truncated Witt vector rings. -/
@[simps] def lift_equiv : {f : Π k, S →+* truncated_witt_vector p k R // ∀ k₁ k₂ (hk : k₁ ≤ k₂),
  (truncated_witt_vector.truncate hk).comp (f k₂) = f k₁} ≃ (S →+* 𝕎 R) :=
{ to_fun := λ f, lift f.1 f.2,
  inv_fun := λ g, ⟨λ k, (truncate k).comp g,
    by { intros _ _ h, simp only [←ring_hom.comp_assoc, truncate_comp_witt_vector_truncate] }⟩,
  left_inv := by { rintro ⟨f, hf⟩, simp only [truncate_comp_lift] },
  right_inv := λ g, lift_unique _ _ $ λ _, rfl }

lemma hom_ext (g₁ g₂ : S →+* 𝕎 R) (h : ∀ k, (truncate k).comp g₁ = (truncate k).comp g₂) :
  g₁ = g₂ :=
lift_equiv.symm.injective $ subtype.ext $ funext h

end lift

end witt_vector