/-
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.tower
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Prime
import Mathbin.RingTheory.AlgebraTower
import Mathbin.LinearAlgebra.Matrix.FiniteDimensional
import Mathbin.LinearAlgebra.Matrix.ToLin

/-!
# Tower of field extensions

In this file we prove the tower law for arbitrary extensions and finite extensions.
Suppose `L` is a field extension of `K` and `K` is a field extension of `F`.
Then `[L:F] = [L:K] [K:F]` where `[E₁:E₂]` means the `E₂`-dimension of `E₁`.

In fact we generalize it to vector spaces, where `L` is not necessarily a field,
but just a vector space over `K`.

## Implementation notes

We prove two versions, since there are two notions of dimensions: `module.rank` which gives
the dimension of an arbitrary vector space as a cardinal, and `finite_dimensional.finrank` which
gives the dimension of a finitely-dimensional vector space as a natural number.

## Tags

tower law

-/

universe u v w u₁ v₁ w₁

open Classical BigOperators

section Field

open Cardinal

variable (F : Type u) (K : Type v) (A : Type w)

variable [Field F] [DivisionRing K] [AddCommGroup A]

variable [Algebra F K] [Module K A] [Module F A] [IsScalarTower F K A]

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim' :
    Cardinal.lift.{w} (Module.rank F K) * Cardinal.lift.{v} (Module.rank K A) =
      Cardinal.lift.{v} (Module.rank F A) :=
  by
  let b := Basis.ofVectorSpace F K
  let c := Basis.ofVectorSpace K A
  rw [← (Module.rank F K).lift_id, ← b.mk_eq_dim, ← (Module.rank K A).lift_id, ← c.mk_eq_dim, ←
    lift_umax.{w, v}, ← (b.smul c).mk_eq_dim, mk_prod, lift_mul, lift_lift, lift_lift, lift_lift,
    lift_lift, lift_umax]
#align dim_mul_dim' dim_mul_dim'

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim (F : Type u) (K A : Type v) [Field F] [Field K] [AddCommGroup A] [Algebra F K]
    [Module K A] [Module F A] [IsScalarTower F K A] :
    Module.rank F K * Module.rank K A = Module.rank F A := by
  convert dim_mul_dim' F K A <;> rw [lift_id]
#align dim_mul_dim dim_mul_dim

namespace FiniteDimensional

open IsNoetherian

theorem trans [FiniteDimensional F K] [FiniteDimensional K A] : FiniteDimensional F A :=
  let b := Basis.ofVectorSpace F K
  let c := Basis.ofVectorSpace K A
  of_fintype_basis <| b.smul c
#align finite_dimensional.trans FiniteDimensional.trans

/-- In a tower of field extensions `L / K / F`, if `L / F` is finite, so is `K / F`.

(In fact, it suffices that `L` is a nontrivial ring.)

Note this cannot be an instance as Lean cannot infer `L`.
-/
theorem left (K L : Type _) [Field K] [Algebra F K] [Ring L] [Nontrivial L] [Algebra F L]
    [Algebra K L] [IsScalarTower F K L] [FiniteDimensional F L] : FiniteDimensional F K :=
  FiniteDimensional.of_injective (IsScalarTower.toAlgHom F K L).toLinearMap (RingHom.injective _)
#align finite_dimensional.left FiniteDimensional.left

theorem right [hf : FiniteDimensional F A] : FiniteDimensional K A :=
  let ⟨⟨b, hb⟩⟩ := hf
  ⟨⟨b,
      Submodule.restrictScalars_injective F _ _ <|
        by
        rw [Submodule.restrictScalars_top, eq_top_iff, ← hb, Submodule.span_le]
        exact Submodule.subset_span⟩⟩
#align finite_dimensional.right FiniteDimensional.right

/-- Tower law: if `A` is a `K`-algebra and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem finrank_mul_finrank [FiniteDimensional F K] : finrank F K * finrank K A = finrank F A :=
  by
  by_cases hA : FiniteDimensional K A
  · skip
    let b := Basis.ofVectorSpace F K
    let c := Basis.ofVectorSpace K A
    rw [finrank_eq_card_basis b, finrank_eq_card_basis c, finrank_eq_card_basis (b.smul c),
      Fintype.card_prod]
  · rw [finrank_of_infinite_dimensional hA, MulZeroClass.mul_zero, finrank_of_infinite_dimensional]
    exact mt (@right F K A _ _ _ _ _ _ _) hA
#align finite_dimensional.finrank_mul_finrank FiniteDimensional.finrank_mul_finrank

theorem Subalgebra.isSimpleOrder_of_finrank_prime (A) [Ring A] [IsDomain A] [Algebra F A]
    (hp : (finrank F A).Prime) : IsSimpleOrder (Subalgebra F A) :=
  { to_nontrivial :=
      ⟨⟨⊥, ⊤, fun he =>
          Nat.not_prime_one ((Subalgebra.bot_eq_top_iff_finrank_eq_one.1 he).subst hp)⟩⟩
    eq_bot_or_eq_top := fun K =>
      by
      haveI := finite_dimensional_of_finrank hp.pos
      letI := divisionRingOfFiniteDimensional F K
      refine' (hp.eq_one_or_self_of_dvd _ ⟨_, (finrank_mul_finrank F K A).symm⟩).imp _ fun h => _
      · exact Subalgebra.eq_bot_of_finrank_one
      ·
        exact
          Algebra.toSubmodule_eq_top.1 (eq_top_of_finrank_eq <| K.finrank_to_submodule.trans h) }
#align finite_dimensional.subalgebra.is_simple_order_of_finrank_prime FiniteDimensional.Subalgebra.isSimpleOrder_of_finrank_prime

-- TODO: `intermediate_field` version
instance linearMap (F : Type u) (V : Type v) (W : Type w) [Field F] [AddCommGroup V] [Module F V]
    [AddCommGroup W] [Module F W] [FiniteDimensional F V] [FiniteDimensional F W] :
    FiniteDimensional F (V →ₗ[F] W) :=
  let b := Basis.ofVectorSpace F V
  let c := Basis.ofVectorSpace F W
  (Matrix.toLin b c).FiniteDimensional
#align finite_dimensional.linear_map FiniteDimensional.linearMap

theorem finrank_linearMap (F : Type u) (V : Type v) (W : Type w) [Field F] [AddCommGroup V]
    [Module F V] [AddCommGroup W] [Module F W] [FiniteDimensional F V] [FiniteDimensional F W] :
    finrank F (V →ₗ[F] W) = finrank F V * finrank F W :=
  by
  let b := Basis.ofVectorSpace F V
  let c := Basis.ofVectorSpace F W
  rw [LinearEquiv.finrank_eq (LinearMap.toMatrix b c), Matrix.finrank_matrix,
    finrank_eq_card_basis b, finrank_eq_card_basis c, mul_comm]
#align finite_dimensional.finrank_linear_map FiniteDimensional.finrank_linearMap

-- TODO: generalize by removing [finite_dimensional F K]
-- V = ⊕F,
-- (V →ₗ[F] K) = ((⊕F) →ₗ[F] K) = (⊕ (F →ₗ[F] K)) = ⊕K
instance linear_map' (F : Type u) (K : Type v) (V : Type w) [Field F] [Field K] [Algebra F K]
    [FiniteDimensional F K] [AddCommGroup V] [Module F V] [FiniteDimensional F V] :
    FiniteDimensional K (V →ₗ[F] K) :=
  right F _ _
#align finite_dimensional.linear_map' FiniteDimensional.linear_map'

theorem finrank_linear_map' (F : Type u) (K : Type v) (V : Type w) [Field F] [Field K] [Algebra F K]
    [FiniteDimensional F K] [AddCommGroup V] [Module F V] [FiniteDimensional F V] :
    finrank K (V →ₗ[F] K) = finrank F V :=
  mul_right_injective₀ finrank_pos.ne' <|
    calc
      finrank F K * finrank K (V →ₗ[F] K) = finrank F (V →ₗ[F] K) := finrank_mul_finrank _ _ _
      _ = finrank F V * finrank F K := (finrank_linearMap F V K)
      _ = finrank F K * finrank F V := mul_comm _ _

#align finite_dimensional.finrank_linear_map' FiniteDimensional.finrank_linear_map'

end FiniteDimensional

end Field


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl

Completion of topological groups:
-/
import topology.uniform_space.completion
import topology.algebra.uniform_group
noncomputable theory

universes u v

section group
open uniform_space Cauchy filter set
variables {α : Type u} [uniform_space α]

instance [has_zero α] : has_zero (completion α) := ⟨(0 : α)⟩
instance [has_neg α] : has_neg (completion α) := ⟨completion.map (λa, -a : α → α)⟩
instance [has_add α] : has_add (completion α) := ⟨completion.map₂ (+)⟩
instance [has_sub α] : has_sub (completion α) := ⟨completion.map₂ has_sub.sub⟩

-- TODO: switch sides once #1103 is fixed
@[norm_cast]
lemma uniform_space.completion.coe_zero [has_zero α] : ((0 : α) : completion α) = 0 := rfl
end group

namespace uniform_space.completion
section uniform_add_group
open uniform_space uniform_space.completion
variables {α : Type*} [uniform_space α] [add_group α] [uniform_add_group α]

@[norm_cast]
lemma coe_neg (a : α) : ((- a : α) : completion α) = - a :=
(map_coe uniform_continuous_neg a).symm

@[norm_cast]
lemma coe_sub (a b : α) : ((a - b : α) : completion α) = a - b :=
(map₂_coe_coe a b has_sub.sub uniform_continuous_sub).symm

@[norm_cast]
lemma coe_add (a b : α) : ((a + b : α) : completion α) = a + b :=
(map₂_coe_coe a b (+) uniform_continuous_add).symm

instance : add_monoid (completion α) :=
{ zero_add     := assume a, completion.induction_on a
   (is_closed_eq (continuous_map₂ continuous_const continuous_id) continuous_id)
    (assume a, show 0 + (a : completion α) = a, by rw_mod_cast zero_add),
  add_zero     := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ continuous_id continuous_const) continuous_id)
    (assume a, show (a : completion α) + 0 = a, by rw_mod_cast add_zero),
  add_assoc    := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous_map₂
        (continuous_map₂ continuous_fst (continuous_fst.comp continuous_snd))
        (continuous_snd.comp continuous_snd))
      (continuous_map₂ continuous_fst
        (continuous_map₂
          (continuous_fst.comp continuous_snd)
          (continuous_snd.comp continuous_snd))))
    (assume a b c, show (a : completion α) + b + c = a + (b + c),
      by repeat { rw_mod_cast add_assoc }),
  .. completion.has_zero, .. completion.has_neg, ..completion.has_add, .. completion.has_sub }

instance : sub_neg_monoid (completion α) :=
{ sub_eq_add_neg := λ a b, completion.induction_on₂ a b
    (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
      (continuous_map₂ continuous_fst (continuous_map.comp continuous_snd)))
   (λ a b, by exact_mod_cast congr_arg coe (sub_eq_add_neg a b)),
  .. completion.add_monoid, .. completion.has_neg, .. completion.has_sub }

instance : add_group (completion α) :=
{ add_left_neg := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ completion.continuous_map continuous_id) continuous_const)
    (assume a, show - (a : completion α) + a = 0, by { rw_mod_cast add_left_neg, refl }),
  .. completion.sub_neg_monoid }

instance : uniform_add_group (completion α) :=
⟨uniform_continuous_map₂ has_sub.sub⟩

instance is_add_group_hom_coe : is_add_group_hom (coe : α → completion α) :=
{ map_add := coe_add }

variables {β : Type v} [uniform_space β] [add_group β] [uniform_add_group β]

lemma is_add_group_hom_extension  [complete_space β] [separated_space β] {f : α → β}
  [is_add_group_hom f] (hf : continuous f) : is_add_group_hom (completion.extension f) :=
have hf : uniform_continuous f, from uniform_continuous_of_continuous hf,
{ map_add := assume a b, completion.induction_on₂ a b
  (is_closed_eq
    (continuous_extension.comp continuous_add)
    ((continuous_extension.comp continuous_fst).add (continuous_extension.comp continuous_snd)))
  (λ a b, by rw_mod_cast [extension_coe hf, extension_coe hf, extension_coe hf,
    is_add_hom.map_add f]) }

lemma is_add_group_hom_map
  {f : α → β} [is_add_group_hom f] (hf : continuous f) : is_add_group_hom (completion.map f) :=
@is_add_group_hom_extension _ _ _ _ _ _ _ _ _ _ _ (is_add_group_hom.comp _ _)
  ((continuous_coe _).comp hf)

instance {α : Type u} [uniform_space α] [add_comm_group α] [uniform_add_group α] :
  add_comm_group (completion α) :=
{ add_comm  := assume a b, completion.induction_on₂ a b
    (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
      (continuous_map₂ continuous_snd continuous_fst))
    (assume x y, by { change ↑x + ↑y = ↑y + ↑x, rw [← coe_add, ← coe_add, add_comm]}),
  .. completion.add_group }
end uniform_add_group

end uniform_space.completion


/-
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 data.equiv.basic
import data.set.basic
import data.sigma.basic
import data.pprod

/-!
# Injective functions
-/

universes u v w x

namespace function

/-- `α ↪ β` is a bundled injective function. -/
@[nolint has_inhabited_instance] -- depending on cardinalities, an injective function may not exist
structure embedding (α : Sort*) (β : Sort*) :=
(to_fun : α → β)
(inj'   : injective to_fun)

infixr ` ↪ `:25 := embedding

instance {α : Sort u} {β : Sort v} : has_coe_to_fun (α ↪ β) (λ _, α → β) := ⟨embedding.to_fun⟩

initialize_simps_projections embedding (to_fun → apply)

end function

section equiv

variables {α : Sort u} {β : Sort v} (f : α ≃ β)

/-- Convert an `α ≃ β` to `α ↪ β`.

This is also available as a coercion `equiv.coe_embedding`.
The explicit `equiv.to_embedding` version is preferred though, since the coercion can have issues
inferring the type of the resulting embedding. For example:

```lean
-- Works:
example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f.to_embedding = s.map f := by simp
-- Error, `f` has type `fin 3 ≃ fin 3` but is expected to have type `fin 3 ↪ ?m_1 : Type ?`
example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f = s.map f.to_embedding := by simp
```
-/
@[simps] protected def equiv.to_embedding : α ↪ β := ⟨f, f.injective⟩

instance equiv.coe_embedding : has_coe (α ≃ β) (α ↪ β) := ⟨equiv.to_embedding⟩

@[reducible]
instance equiv.perm.coe_embedding : has_coe (equiv.perm α) (α ↪ α) := equiv.coe_embedding

@[simp] lemma equiv.coe_eq_to_embedding  : ↑f = f.to_embedding := rfl

/-- Given an equivalence to a subtype, produce an embedding to the elements of the corresponding
set. -/
@[simps]
def equiv.as_embedding {p : β → Prop} (e : α ≃ subtype p) : α ↪ β :=
⟨coe ∘ e, subtype.coe_injective.comp e.injective⟩

@[simp]
lemma equiv.as_embedding_range {α β : Sort*} {p : β → Prop} (e : α ≃ subtype p) :
  set.range e.as_embedding = set_of p :=
set.ext $ λ x, ⟨λ ⟨y, h⟩, h ▸ subtype.coe_prop (e y), λ hs, ⟨e.symm ⟨x, hs⟩, by simp⟩⟩

end equiv

namespace function
namespace embedding

lemma coe_injective {α β} : @function.injective (α ↪ β) (α → β) coe_fn
| ⟨x, _⟩ ⟨y, _⟩ rfl := rfl

@[ext] lemma ext {α β} {f g : embedding α β} (h : ∀ x, f x = g x) : f = g :=
coe_injective (funext h)

lemma ext_iff {α β} {f g : embedding α β} : (∀ x, f x = g x) ↔ f = g :=
⟨ext, λ h _, by rw h⟩

@[simp] theorem to_fun_eq_coe {α β} (f : α ↪ β) : to_fun f = f := rfl

@[simp] theorem coe_fn_mk {α β} (f : α → β) (i) :
  (@mk _ _ f i : α → β) = f := rfl

@[simp] lemma mk_coe {α β : Type*} (f : α ↪ β) (inj) : (⟨f, inj⟩ : α ↪ β) = f :=
by { ext, simp }

protected theorem injective {α β} (f : α ↪ β) : injective f := f.inj'

@[simp] lemma apply_eq_iff_eq {α β} (f : α ↪ β) (x y : α) : f x = f y ↔ x = y :=
f.injective.eq_iff

/-- The identity map as a `function.embedding`. -/
@[refl, simps {simp_rhs := tt}]
protected def refl (α : Sort*) : α ↪ α :=
⟨id, injective_id⟩

/-- Composition of `f : α ↪ β` and `g : β ↪ γ`. -/
@[trans, simps {simp_rhs := tt}]
protected def trans {α β γ} (f : α ↪ β) (g : β ↪ γ) : α ↪ γ :=
⟨g ∘ f, g.injective.comp f.injective⟩

@[simp]
lemma equiv_to_embedding_trans_symm_to_embedding {α β : Sort*} (e : α ≃ β) :
  e.to_embedding.trans e.symm.to_embedding = embedding.refl _ :=
by { ext, simp, }

@[simp]
lemma equiv_symm_to_embedding_trans_to_embedding {α β : Sort*} (e : α ≃ β) :
  e.symm.to_embedding.trans e.to_embedding = embedding.refl _ :=
by { ext, simp, }

/-- Transfer an embedding along a pair of equivalences. -/
@[simps { fully_applied := ff }]
protected def congr {α : Sort u} {β : Sort v} {γ : Sort w} {δ : Sort x}
  (e₁ : α ≃ β) (e₂ : γ ≃ δ) (f : α ↪ γ) : (β ↪ δ) :=
(equiv.to_embedding e₁.symm).trans (f.trans e₂.to_embedding)

/-- A right inverse `surj_inv` of a surjective function as an `embedding`. -/
protected noncomputable def of_surjective {α β} (f : β → α) (hf : surjective f) :
  α ↪ β :=
⟨surj_inv hf, injective_surj_inv _⟩

/-- Convert a surjective `embedding` to an `equiv` -/
protected noncomputable def equiv_of_surjective {α β} (f : α ↪ β) (hf : surjective f) :
  α ≃ β :=
equiv.of_bijective f ⟨f.injective, hf⟩

/-- There is always an embedding from an empty type. --/
protected def of_is_empty {α β} [is_empty α] : α ↪ β :=
⟨is_empty_elim, is_empty_elim⟩

/-- Change the value of an embedding `f` at one point. If the prescribed image
is already occupied by some `f a'`, then swap the values at these two points. -/
def set_value {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
  [∀ a', decidable (f a' = b)] : α ↪ β :=
⟨λ a', if a' = a then b else if f a' = b then f a else f a',
  begin
    intros x y h,
    dsimp at h,
    split_ifs at h; try { substI b }; try { simp only [f.injective.eq_iff] at * }; cc
  end⟩

theorem set_value_eq {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
  [∀ a', decidable (f a' = b)] : set_value f a b a = b :=
by simp [set_value]

/-- Embedding into `option α` using `some`. -/
@[simps { fully_applied := ff }] protected def some {α} : α ↪ option α :=
⟨some, option.some_injective α⟩

/-- Embedding into `option α` using `coe`. Usually the correct synctatical form for `simp`. -/
@[simps { fully_applied := ff }]
def coe_option {α} : α ↪ option α := ⟨coe, option.some_injective α⟩

/-- Embedding into `with_top α`. -/
@[simps]
def coe_with_top {α} : α ↪ with_top α := { to_fun := coe, ..embedding.some}

/-- Given an embedding `f : α ↪ β` and a point outside of `set.range f`, construct an embedding
`option α ↪ β`. -/
@[simps] def option_elim {α β} (f : α ↪ β) (x : β) (h : x ∉ set.range f) :
  option α ↪ β :=
⟨λ o, o.elim x f, option.injective_iff.2 ⟨f.2, h⟩⟩

/-- Embedding of a `subtype`. -/
def subtype {α} (p : α → Prop) : subtype p ↪ α :=
⟨coe, λ _ _, subtype.ext_val⟩

@[simp] lemma coe_subtype {α} (p : α → Prop) : ⇑(subtype p) = coe := rfl

/-- Choosing an element `b : β` gives an embedding of `punit` into `β`. -/
def punit {β : Sort*} (b : β) : punit ↪ β :=
⟨λ _, b, by { rintros ⟨⟩ ⟨⟩ _, refl, }⟩

/-- Fixing an element `b : β` gives an embedding `α ↪ α × β`. -/
def sectl (α : Sort*) {β : Sort*} (b : β) : α ↪ α × β :=
⟨λ a, (a, b), λ a a' h, congr_arg prod.fst h⟩

/-- Fixing an element `a : α` gives an embedding `β ↪ α × β`. -/
def sectr {α : Sort*} (a : α) (β : Sort*): β ↪ α × β :=
⟨λ b, (a, b), λ b b' h, congr_arg prod.snd h⟩

/-- Restrict the codomain of an embedding. -/
def cod_restrict {α β} (p : set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
⟨λ a, ⟨f a, H a⟩, λ a b h, f.injective (@congr_arg _ _ _ _ subtype.val h)⟩

@[simp] theorem cod_restrict_apply {α β} (p) (f : α ↪ β) (H a) :
  cod_restrict p f H a = ⟨f a, H a⟩ := rfl

/-- If `e₁` and `e₂` are embeddings, then so is `prod.map e₁ e₂ : (a, b) ↦ (e₁ a, e₂ b)`. -/
def prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α × γ ↪ β × δ :=
⟨prod.map e₁ e₂, e₁.injective.prod_map e₂.injective⟩

@[simp] lemma coe_prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
  ⇑(e₁.prod_map e₂) = prod.map e₁ e₂ :=
rfl

/-- If `e₁` and `e₂` are embeddings, then so is `λ ⟨a, b⟩, ⟨e₁ a, e₂ b⟩ : pprod α γ → pprod β δ`. -/
def pprod_map {α β γ δ : Sort*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : pprod α γ ↪ pprod β δ :=
⟨λ x, ⟨e₁ x.1, e₂ x.2⟩, e₁.injective.pprod_map e₂.injective⟩

section sum
open sum

/-- If `e₁` and `e₂` are embeddings, then so is `sum.map e₁ e₂`. -/
def sum_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α ⊕ γ ↪ β ⊕ δ :=
⟨sum.map e₁ e₂,
    assume s₁ s₂ h, match s₁, s₂, h with
    | inl a₁, inl a₂, h := congr_arg inl $ e₁.injective $ inl.inj h
    | inr b₁, inr b₂, h := congr_arg inr $ e₂.injective $ inr.inj h
    end⟩

@[simp] theorem coe_sum_map {α β γ δ} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
  ⇑(sum_map e₁ e₂) = sum.map e₁ e₂ :=
rfl

/-- The embedding of `α` into the sum `α ⊕ β`. -/
@[simps] def inl {α β : Type*} : α ↪ α ⊕ β :=
⟨sum.inl, λ a b, sum.inl.inj⟩

/-- The embedding of `β` into the sum `α ⊕ β`. -/
@[simps] def inr {α β : Type*} : β ↪ α ⊕ β :=
⟨sum.inr, λ a b, sum.inr.inj⟩

end sum

section sigma

variables {α α' : Type*} {β : α → Type*} {β' : α' → Type*}

/-- `sigma.mk` as an `function.embedding`. -/
@[simps apply] def sigma_mk (a : α) : β a ↪ Σ x, β x :=
⟨sigma.mk a, sigma_mk_injective⟩

/-- If `f : α ↪ α'` is an embedding and `g : Π a, β α ↪ β' (f α)` is a family
of embeddings, then `sigma.map f g` is an embedding. -/
@[simps apply] def sigma_map (f : α ↪ α') (g : Π a, β a ↪ β' (f a)) :
  (Σ a, β a) ↪ Σ a', β' a' :=
⟨sigma.map f (λ a, g a), f.injective.sigma_map (λ a, (g a).injective)⟩

end sigma

/-- Define an embedding `(Π a : α, β a) ↪ (Π a : α, γ a)` from a family of embeddings
`e : Π a, (β a ↪ γ a)`. This embedding sends `f` to `λ a, e a (f a)`. -/
@[simps] def Pi_congr_right {α : Sort*} {β γ : α → Sort*} (e : ∀ a, β a ↪ γ a) :
  (Π a, β a) ↪ (Π a, γ a) :=
⟨λf a, e a (f a), λ f₁ f₂ h, funext $ λ a, (e a).injective (congr_fun h a)⟩

/-- An embedding `e : α ↪ β` defines an embedding `(γ → α) ↪ (γ → β)` that sends each `f`
to `e ∘ f`. -/
def arrow_congr_right {α : Sort u} {β : Sort v} {γ : Sort w}
  (e : α ↪ β) : (γ → α) ↪ (γ → β) :=
Pi_congr_right (λ _, e)

@[simp] lemma arrow_congr_right_apply {α : Sort u} {β : Sort v} {γ : Sort w}
  (e : α ↪ β) (f : γ ↪ α) : arrow_congr_right e f = e ∘ f := rfl

/-- An embedding `e : α ↪ β` defines an embedding `(α → γ) ↪ (β → γ)` for any inhabited type `γ`.
This embedding sends each `f : α → γ` to a function `g : β → γ` such that `g ∘ e = f` and
`g y = default γ` whenever `y ∉ range e`. -/
noncomputable def arrow_congr_left {α : Sort u} {β : Sort v} {γ : Sort w} [inhabited γ]
  (e : α ↪ β) : (α → γ) ↪ (β → γ) :=
⟨λ f, extend e f (λ _, default γ), λ f₁ f₂ h, funext $ λ x,
  by simpa only [extend_apply e.injective] using congr_fun h (e x)⟩

/-- Restrict both domain and codomain of an embedding. -/
protected def subtype_map {α β} {p : α → Prop} {q : β → Prop} (f : α ↪ β)
  (h : ∀{{x}}, p x → q (f x)) : {x : α // p x} ↪ {y : β // q y} :=
⟨subtype.map f h, subtype.map_injective h f.2⟩

open set

/-- `set.image` as an embedding `set α ↪ set β`. -/
@[simps apply] protected def image {α β} (f : α ↪ β) : set α ↪ set β :=
⟨image f, f.2.image_injective⟩

lemma swap_apply {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y z : α) :
  equiv.swap (f x) (f y) (f z) = f (equiv.swap x y z) :=
f.injective.swap_apply x y z

lemma swap_comp {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y : α) :
  equiv.swap (f x) (f y) ∘ f = f ∘ equiv.swap x y :=
f.injective.swap_comp x y

end embedding
end function

namespace equiv

open function.embedding

/-- The type of embeddings `α ↪ β` is equivalent to
    the subtype of all injective functions `α → β`. -/
def subtype_injective_equiv_embedding (α β : Sort*) :
  {f : α → β // function.injective f} ≃ (α ↪ β) :=
{ to_fun := λ f, ⟨f.val, f.property⟩,
  inv_fun := λ f, ⟨f, f.injective⟩,
  left_inv := λ f, by simp,
  right_inv := λ f, by {ext, refl} }

/-- If `α₁ ≃ α₂` and `β₁ ≃ β₂`, then the type of embeddings `α₁ ↪ β₁`
is equivalent to the type of embeddings `α₂ ↪ β₂`. -/
@[congr, simps apply] def embedding_congr {α β γ δ : Sort*}
  (h : α ≃ β) (h' : γ ≃ δ) : (α ↪ γ) ≃ (β ↪ δ) :=
{ to_fun := λ f, f.congr h h',
  inv_fun := λ f, f.congr h.symm h'.symm,
  left_inv := λ x, by {ext, simp},
  right_inv := λ x, by {ext, simp} }

@[simp] lemma embedding_congr_refl {α β : Sort*} :
  embedding_congr (equiv.refl α) (equiv.refl β) = equiv.refl (α ↪ β) :=
by {ext, refl}

@[simp] lemma embedding_congr_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Sort*}
  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
  embedding_congr (e₁.trans e₂) (e₁'.trans e₂') =
  (embedding_congr e₁ e₁').trans (embedding_congr e₂ e₂') :=
rfl

@[simp] lemma embedding_congr_symm {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
  (embedding_congr e₁ e₂).symm = embedding_congr e₁.symm e₂.symm :=
rfl

lemma embedding_congr_apply_trans {α₁ β₁ γ₁ α₂ β₂ γ₂ : Sort*}
  (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) (ec : γ₁ ≃ γ₂) (f : α₁ ↪ β₁) (g : β₁ ↪ γ₁) :
  equiv.embedding_congr ea ec (f.trans g) =
  (equiv.embedding_congr ea eb f).trans (equiv.embedding_congr eb ec g) :=
by {ext, simp}

@[simp]
lemma refl_to_embedding {α : Type*} : (equiv.refl α).to_embedding = function.embedding.refl α := rfl

@[simp]
lemma trans_to_embedding {α β γ : Type*} (e : α ≃ β) (f : β ≃ γ) :
  (e.trans f).to_embedding = e.to_embedding.trans f.to_embedding := rfl

end equiv

namespace set

/-- The injection map is an embedding between subsets. -/
@[simps apply] def embedding_of_subset {α} (s t : set α) (h : s ⊆ t) : s ↪ t :=
⟨λ x, ⟨x.1, h x.2⟩, λ ⟨x, hx⟩ ⟨y, hy⟩ h, by { congr, injection h }⟩

end set

section subtype

variable {α : Type*}

/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` can be injectively split
into a sum of subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right. -/
def subtype_or_left_embedding (p q : α → Prop) [decidable_pred p] :
  {x // p x ∨ q x} ↪ {x // p x} ⊕ {x // q x} :=
⟨λ x, if h : p x then sum.inl ⟨x, h⟩ else sum.inr ⟨x, x.prop.resolve_left h⟩,
  begin
    intros x y,
    dsimp only,
    split_ifs;
    simp [subtype.ext_iff]
  end⟩

lemma subtype_or_left_embedding_apply_left {p q : α → Prop} [decidable_pred p]
  (x : {x // p x ∨ q x}) (hx : p x) : subtype_or_left_embedding p q x = sum.inl ⟨x, hx⟩ :=
dif_pos hx

lemma subtype_or_left_embedding_apply_right {p q : α → Prop} [decidable_pred p]
  (x : {x // p x ∨ q x}) (hx : ¬ p x) :
  subtype_or_left_embedding p q x = sum.inr ⟨x, x.prop.resolve_left hx⟩ :=
dif_neg hx

/-- A subtype `{x // p x}` can be injectively sent to into a subtype `{x // q x}`,
if `p x → q x` for all `x : α`. -/
@[simps] def subtype.imp_embedding (p q : α → Prop) (h : p ≤ q) :
  {x // p x} ↪ {x // q x} :=
⟨λ x, ⟨x, h x x.prop⟩, λ x y, by simp [subtype.ext_iff]⟩

/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` is equivalent to a sum of
subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right, when
`disjoint p q`.

See also `equiv.sum_compl`, for when `is_compl p q`.  -/
@[simps apply] def subtype_or_equiv (p q : α → Prop) [decidable_pred p] (h : disjoint p q) :
  {x // p x ∨ q x} ≃ {x // p x} ⊕ {x // q x} :=
{ to_fun := subtype_or_left_embedding p q,
  inv_fun := sum.elim
    (subtype.imp_embedding _ _ (λ x hx, (or.inl hx : p x ∨ q x)))
    (subtype.imp_embedding _ _ (λ x hx, (or.inr hx : p x ∨ q x))),
  left_inv := λ x, begin
    by_cases hx : p x,
    { rw subtype_or_left_embedding_apply_left _ hx,
      simp [subtype.ext_iff] },
    { rw subtype_or_left_embedding_apply_right _ hx,
      simp [subtype.ext_iff] },
  end,
  right_inv := λ x, begin
    cases x,
    { simp only [sum.elim_inl],
      rw subtype_or_left_embedding_apply_left,
      { simp },
      { simpa using x.prop } },
    { simp only [sum.elim_inr],
      rw subtype_or_left_embedding_apply_right,
      { simp },
      { suffices : ¬ p x,
        { simpa },
        intro hp,
        simpa using h x ⟨hp, x.prop⟩ } }
  end }

@[simp] lemma subtype_or_equiv_symm_inl (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
  (x : {x // p x}) : (subtype_or_equiv p q h).symm (sum.inl x) = ⟨x, or.inl x.prop⟩ :=
rfl

@[simp] lemma subtype_or_equiv_symm_inr (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
  (x : {x // q x}) : (subtype_or_equiv p q h).symm (sum.inr x) = ⟨x, or.inr x.prop⟩ :=
rfl

end subtype


/-
Copyright (c) 2022 Julian Berman. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Berman
-/

import group_theory.exponent
import group_theory.order_of_element
import group_theory.p_group
import group_theory.quotient_group
import group_theory.submonoid.operations

/-!
# Torsion groups

This file defines torsion groups, i.e. groups where all elements have finite order.

## Main definitions

* `monoid.is_torsion` a predicate asserting `G` is torsion, i.e. that all
  elements are of finite order.
* `comm_group.torsion G`, the torsion subgroup of an abelian group `G`
* `comm_monoid.torsion G`, the above stated for commutative monoids
* `monoid.is_torsion_free`, asserting no nontrivial elements have finite order in `G`
* `add_monoid.is_torsion` and `add_monoid.is_torsion_free` the additive versions of the above

## Implementation

All torsion monoids are really groups (which is proven here as `monoid.is_torsion.group`), but since
the definition can be stated on monoids it is implemented on `monoid` to match other declarations in
the group theory library.

## Tags

periodic group, aperiodic group, torsion subgroup, torsion abelian group

## Future work

* generalize to π-torsion(-free) groups for a set of primes π
* free, free solvable and free abelian groups are torsion free
* complete direct and free products of torsion free groups are torsion free
* groups which are residually finite p-groups with respect to 2 distinct primes are torsion free
-/

variables {G H : Type*}

namespace monoid

variables (G) [monoid G]

/-- A predicate on a monoid saying that all elements are of finite order. -/
@[to_additive "A predicate on an additive monoid saying that all elements are of finite order."]
def is_torsion := ∀ g : G, is_of_fin_order g

/-- A monoid is not a torsion monoid if it has an element of infinite order. -/
@[simp, to_additive
  "An additive monoid is not a torsion monoid if it has an element of infinite order."]
lemma not_is_torsion_iff : ¬ is_torsion G ↔ ∃ g : G, ¬is_of_fin_order g :=
by rw [is_torsion, not_forall]

end monoid

open monoid

/-- Torsion monoids are really groups. -/
@[to_additive "Torsion additive monoids are really additive groups"]
noncomputable def is_torsion.group [monoid G] (tG : is_torsion G) : group G :=
{ inv := λ g, g ^ (order_of g - 1),
  mul_left_inv := λ g,
  begin
    erw [←pow_succ', tsub_add_cancel_of_le, pow_order_of_eq_one],
    exact order_of_pos' (tG g)
  end,
  ..‹monoid G› }

section group

variables [group G] {N : subgroup G} [group H]

/-- Subgroups of torsion groups are torsion groups. -/
@[to_additive "Subgroups of additive torsion groups are additive torsion groups."]
lemma is_torsion.subgroup (tG : is_torsion G) (H : subgroup G) : is_torsion H :=
λ h, (is_of_fin_order_iff_coe H.to_submonoid h).mpr $ tG h

/-- The image of a surjective torsion group homomorphism is torsion. -/
@[to_additive add_is_torsion.of_surjective
  "The image of a surjective additive torsion group homomorphism is torsion."]
lemma is_torsion.of_surjective {f : G →* H} (hf : function.surjective f) (tG : is_torsion G) :
  is_torsion H :=
λ h, begin
  obtain ⟨g, hg⟩ := hf h,
  rw ←hg,
  exact f.is_of_fin_order (tG g),
end

/-- Torsion groups are closed under extensions. -/
@[to_additive add_is_torsion.extension_closed
  "Additive torsion groups are closed under extensions."]
lemma is_torsion.extension_closed
  {f : G →* H} (hN : N = f.ker) (tH : is_torsion H) (tN : is_torsion N) :
  is_torsion G :=
λ g, (is_of_fin_order_iff_pow_eq_one _).mpr $ begin
  obtain ⟨ngn, ngnpos, hngn⟩ := (is_of_fin_order_iff_pow_eq_one _).mp (tH $ f g),
  have hmem := f.mem_ker.mpr ((f.map_pow g ngn).trans hngn),
  lift g ^ ngn to N using hN.symm ▸ hmem with gn,
  obtain ⟨nn, nnpos, hnn⟩ := (is_of_fin_order_iff_pow_eq_one _).mp (tN gn),
  exact ⟨ngn * nn, mul_pos ngnpos nnpos, by rw [pow_mul, ←h, ←subgroup.coe_pow,
                                                hnn, subgroup.coe_one]⟩
end

/-- The image of a quotient is torsion iff the group is torsion. -/
@[to_additive add_is_torsion.quotient_iff
  "The image of a quotient is additively torsion iff the group is torsion."]
lemma is_torsion.quotient_iff
  {f : G →* H} (hf : function.surjective f) (hN : N = f.ker) (tN : is_torsion N) :
  is_torsion H ↔ is_torsion G :=
⟨λ tH, is_torsion.extension_closed hN tH tN, λ tG, is_torsion.of_surjective hf tG⟩

/-- If a group exponent exists, the group is torsion. -/
@[to_additive exponent_exists.is_add_torsion
  "If a group exponent exists, the group is additively torsion."]
lemma exponent_exists.is_torsion (h : exponent_exists G) : is_torsion G := λ g, begin
  obtain ⟨n, npos, hn⟩ := h,
  exact (is_of_fin_order_iff_pow_eq_one g).mpr ⟨n, npos, hn g⟩,
end

/-- The group exponent exists for any bounded torsion group. -/
@[to_additive is_add_torsion.exponent_exists
  "The group exponent exists for any bounded additive torsion group."]
lemma is_torsion.exponent_exists
  (tG : is_torsion G) (bounded : (set.range (λ g : G, order_of g)).finite) :
  exponent_exists G :=
exponent_exists_iff_ne_zero.mpr $
  (exponent_ne_zero_iff_range_order_of_finite (λ g, order_of_pos' (tG g))).mpr bounded

/-- Finite groups are torsion groups. -/
@[to_additive is_add_torsion_of_finite "Finite additive groups are additive torsion groups."]
lemma is_torsion_of_finite [finite G] : is_torsion G :=
exponent_exists.is_torsion $ exponent_exists_iff_ne_zero.mpr exponent_ne_zero_of_finite

end group

section module

-- A (semi/)ring of scalars and a commutative monoid of elements
variables (R M : Type*) [add_comm_monoid M]

namespace add_monoid

/-- A module whose scalars are additively torsion is additively torsion. -/
lemma is_torsion.module_of_torsion [semiring R] [module R M] (tR : is_torsion R) :
is_torsion M := λ f, (is_of_fin_add_order_iff_nsmul_eq_zero _).mpr $ begin
  obtain ⟨n, npos, hn⟩ := (is_of_fin_add_order_iff_nsmul_eq_zero _).mp (tR 1),
  exact ⟨n, npos, by simp only [nsmul_eq_smul_cast R _ f, ←nsmul_one, hn, zero_smul]⟩,
end

/-- A module with a finite ring of scalars is additively torsion. -/
lemma is_torsion.module_of_finite [ring R] [finite R] [module R M] : is_torsion M :=
(is_add_torsion_of_finite : is_torsion R).module_of_torsion _ _

end add_monoid

end module

section comm_monoid

variables (G) [comm_monoid G]

namespace comm_monoid

/--
The torsion submonoid of a commutative monoid.

(Note that by `monoid.is_torsion.group` torsion monoids are truthfully groups.)
-/
@[to_additive add_torsion "The torsion submonoid of an additive commutative monoid."]
def torsion : submonoid G :=
{ carrier := {x | is_of_fin_order x},
  one_mem' := is_of_fin_order_one,
  mul_mem' := λ _ _ hx hy, hx.mul hy }

variable {G}

/-- Torsion submonoids are torsion. -/
@[to_additive "Additive torsion submonoids are additively torsion."]
lemma torsion.is_torsion : is_torsion $ torsion G :=
λ ⟨_, n, npos, hn⟩,
  ⟨n, npos, subtype.ext $
    by rw [mul_left_iterate, _root_.mul_one, submonoid.coe_pow,
           subtype.coe_mk, submonoid.coe_one, (is_periodic_pt_mul_iff_pow_eq_one _).mp hn]⟩

variables (G) (p : ℕ) [hp : fact p.prime]
include hp

/-- The `p`-primary component is the submonoid of elements with order prime-power of `p`. -/
@[to_additive
  "The `p`-primary component is the submonoid of elements with additive order prime-power of `p`.",
  simps]
def primary_component : submonoid G :=
{ carrier := {g | ∃ n : ℕ, order_of g = p ^ n},
  one_mem' := ⟨0, by rw [pow_zero, order_of_one]⟩,
  mul_mem' := λ g₁ g₂ hg₁ hg₂, exists_order_of_eq_prime_pow_iff.mpr $ begin
    obtain ⟨m, hm⟩ := exists_order_of_eq_prime_pow_iff.mp hg₁,
    obtain ⟨n, hn⟩ := exists_order_of_eq_prime_pow_iff.mp hg₂,
    exact ⟨m + n, by rw [mul_pow, pow_add, pow_mul, hm, one_pow, monoid.one_mul,
                         mul_comm, pow_mul, hn, one_pow]⟩,
  end }

variables {G} {p}

/-- Elements of the `p`-primary component have order `p^n` for some `n`. -/
@[to_additive "Elements of the `p`-primary component have additive order `p^n` for some `n`"]
lemma primary_component.exists_order_of_eq_prime_pow (g : comm_monoid.primary_component G p) :
  ∃ n : ℕ, order_of g = p ^ n :=
by simpa [primary_component] using g.property

/-- The `p`- and `q`-primary components are disjoint for `p ≠ q`. -/
@[to_additive "The `p`- and `q`-primary components are disjoint for `p ≠ q`."]
lemma primary_component.disjoint {p' : ℕ} [hp' : fact p'.prime] (hne : p ≠ p') :
  disjoint (comm_monoid.primary_component G p) (comm_monoid.primary_component G p') :=
submonoid.disjoint_def.mpr $
begin
  rintro g ⟨(_|n), hn⟩ ⟨n', hn'⟩,
  { rwa [pow_zero, order_of_eq_one_iff] at hn },
  { exact absurd (eq_of_prime_pow_eq hp.out.prime hp'.out.prime n.succ_pos
      (hn.symm.trans hn')) hne }
end

end comm_monoid

open comm_monoid (torsion)

namespace monoid.is_torsion

variable {G}

/-- The torsion submonoid of a torsion monoid is `⊤`. -/
@[simp, to_additive "The additive torsion submonoid of an additive torsion monoid is `⊤`."]
lemma torsion_eq_top (tG : is_torsion G) : torsion G = ⊤ := by ext; tauto

/-- A torsion monoid is isomorphic to its torsion submonoid. -/
@[to_additive "An additive torsion monoid is isomorphic to its torsion submonoid."]
def torsion_mul_equiv (tG : is_torsion G) : torsion G ≃* G :=
(mul_equiv.submonoid_congr tG.torsion_eq_top).trans submonoid.top_equiv

@[to_additive] lemma torsion_mul_equiv_apply (tG : is_torsion G) (a : torsion G) :
  tG.torsion_mul_equiv a = mul_equiv.submonoid_congr tG.torsion_eq_top a := rfl

@[to_additive] lemma torsion_mul_equiv_symm_apply_coe (tG : is_torsion G) (a : G) :
  tG.torsion_mul_equiv.symm a = ⟨submonoid.top_equiv.symm a, tG _⟩ := rfl

end monoid.is_torsion

/-- Torsion submonoids of a torsion submonoid are isomorphic to the submonoid. -/
@[simp, to_additive add_comm_monoid.torsion.of_torsion
  "Additive torsion submonoids of an additive torsion submonoid are isomorphic to the submonoid."]
def torsion.of_torsion : (torsion (torsion G)) ≃* (torsion G) :=
monoid.is_torsion.torsion_mul_equiv comm_monoid.torsion.is_torsion

end comm_monoid

section comm_group

variables (G) [comm_group G]

namespace comm_group

/-- The torsion subgroup of an abelian group. -/
@[to_additive "The torsion subgroup of an additive abelian group."]
def torsion : subgroup G := { comm_monoid.torsion G with inv_mem' := λ x, is_of_fin_order.inv }

/-- The torsion submonoid of an abelian group equals the torsion subgroup as a submonoid. -/
@[to_additive add_torsion_eq_add_torsion_submonoid
  "The additive torsion submonoid of an abelian group equals the torsion subgroup as a submonoid."]
lemma torsion_eq_torsion_submonoid : comm_monoid.torsion G = (torsion G).to_submonoid := rfl

variables (p : ℕ) [hp : fact p.prime]
include hp

/-- The `p`-primary component is the subgroup of elements with order prime-power of `p`. -/
@[to_additive
  "The `p`-primary component is the subgroup of elements with additive order prime-power of `p`.",
  simps]
def primary_component : subgroup G :=
{ comm_monoid.primary_component G p with inv_mem' := λ g ⟨n, hn⟩, ⟨n, (order_of_inv g).trans hn⟩ }

variables {G} {p}

/-- The `p`-primary component is a `p` group. -/
lemma primary_component.is_p_group : is_p_group p $ primary_component G p :=
λ g, (propext exists_order_of_eq_prime_pow_iff.symm).mpr
  (comm_monoid.primary_component.exists_order_of_eq_prime_pow g)

end comm_group

end comm_group

namespace monoid

variables (G) [monoid G]

/-- A predicate on a monoid saying that only 1 is of finite order. -/
@[to_additive "A predicate on an additive monoid saying that only 0 is of finite order."]
def is_torsion_free := ∀ g : G, g ≠ 1 → ¬is_of_fin_order g

/-- A nontrivial monoid is not torsion-free if any nontrivial element has finite order. -/
@[simp, to_additive
  "An additive monoid is not torsion free if any nontrivial element has finite order."]
lemma not_is_torsion_free_iff : ¬ (is_torsion_free G) ↔ ∃ g : G, g ≠ 1 ∧ is_of_fin_order g :=
by simp_rw [is_torsion_free, ne.def, not_forall, not_not, exists_prop]

end monoid

section group

open monoid

variables [group G]

/-- A nontrivial torsion group is not torsion-free. -/
@[to_additive add_monoid.is_torsion.not_torsion_free
  "A nontrivial additive torsion group is not torsion-free."]
lemma is_torsion.not_torsion_free [hN : nontrivial G] : is_torsion G → ¬is_torsion_free G :=
λ tG, (not_is_torsion_free_iff _).mpr $ begin
  obtain ⟨x, hx⟩ := (nontrivial_iff_exists_ne (1 : G)).mp hN,
  exact ⟨x, hx, tG x⟩,
end

/-- A nontrivial torsion-free group is not torsion. -/
@[to_additive add_monoid.is_torsion_free.not_torsion
  "A nontrivial torsion-free additive group is not torsion."]
lemma is_torsion_free.not_torsion [hN : nontrivial G] : is_torsion_free G → ¬is_torsion G :=
λ tfG, (not_is_torsion_iff _).mpr $ begin
  obtain ⟨x, hx⟩ := (nontrivial_iff_exists_ne (1 : G)).mp hN,
  exact ⟨x, (tfG x) hx⟩,
end

/-- Subgroups of torsion-free groups are torsion-free. -/
@[to_additive "Subgroups of additive torsion-free groups are additively torsion-free."]
lemma is_torsion_free.subgroup (tG : is_torsion_free G) (H : subgroup G) : is_torsion_free H :=
λ h hne, (is_of_fin_order_iff_coe H.to_submonoid h).not.mpr $
  tG h $ by norm_cast; simp [hne, not_false_iff]

/-- Direct products of torsion free groups are torsion free. -/
@[to_additive add_monoid.is_torsion_free.prod
  "Direct products of additive torsion free groups are torsion free."]
lemma is_torsion_free.prod
  {η : Type*} {Gs : η → Type*} [∀ i, group (Gs i)] (tfGs : ∀ i, is_torsion_free (Gs i)) :
is_torsion_free $ Π i, Gs i :=
λ w hne h, hne $ funext $ λ i, not_not.mp $ mt (tfGs i (w i)) $ not_not.mpr $ h.apply i

end group

section comm_group

open monoid (is_torsion_free)
open comm_group (torsion)

variables (G) [comm_group G]

/-- Quotienting a group by its torsion subgroup yields a torsion free group. -/
@[to_additive add_is_torsion_free.quotient_torsion
  "Quotienting a group by its additive torsion subgroup yields an additive torsion free group."]
lemma is_torsion_free.quotient_torsion : is_torsion_free $ G ⧸ torsion G :=
λ g hne hfin, hne $ begin
  induction g using quotient_group.induction_on',
  obtain ⟨m, mpos, hm⟩ := (is_of_fin_order_iff_pow_eq_one _).mp hfin,
  obtain ⟨n, npos, hn⟩ :=
    (is_of_fin_order_iff_pow_eq_one _).mp ((quotient_group.eq_one_iff _).mp hm),
  exact (quotient_group.eq_one_iff g).mpr
    ((is_of_fin_order_iff_pow_eq_one _).mpr ⟨m * n, mul_pos mpos npos, (pow_mul g m n).symm ▸ hn⟩),
end

end comm_group


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Joey van Langen, Casper Putz
-/

import algebra.hom.iterate
import data.int.modeq
import data.nat.choose.dvd
import data.nat.choose.sum
import group_theory.order_of_element
import ring_theory.nilpotent
/-!
# Characteristic of semirings
-/

universes u v

variables (R : Type u)

/-- The generator of the kernel of the unique homomorphism ℕ → R for a semiring R.

*Warning*: for a semiring `R`, `char_p R 0` and `char_zero R` need not coincide.
* `char_p R 0` asks that only `0 : ℕ` maps to `0 : R` under the map `ℕ → R`;
* `char_zero R` requires an injection `ℕ ↪ R`.

For instance, endowing `{0, 1}` with addition given by `max` (i.e. `1` is absorbing), shows that
`char_zero {0, 1}` does not hold and yet `char_p {0, 1} 0` does.
 -/
class char_p [add_monoid R] [has_one R] (p : ℕ) : Prop :=
(cast_eq_zero_iff [] : ∀ x:ℕ, (x:R) = 0 ↔ p ∣ x)

theorem char_p.cast_eq_zero [add_monoid R] [has_one R] (p : ℕ) [char_p R p] :
  (p:R) = 0 :=
(char_p.cast_eq_zero_iff R p p).2 (dvd_refl p)

@[simp] lemma char_p.cast_card_eq_zero [add_group R] [has_one R] [fintype R] :
  (fintype.card R : R) = 0 :=
by rw [← nsmul_one, card_nsmul_eq_zero]

lemma char_p.int_cast_eq_zero_iff [add_group R] [has_one R] (p : ℕ) [char_p R p]
  (a : ℤ) :
  (a : R) = 0 ↔ (p:ℤ) ∣ a :=
begin
  rcases lt_trichotomy a 0 with h|rfl|h,
  { rw [← neg_eq_zero, ← int.cast_neg, ← dvd_neg],
    lift -a to ℕ using neg_nonneg.mpr (le_of_lt h) with b,
    rw [int.cast_coe_nat, char_p.cast_eq_zero_iff R p, int.coe_nat_dvd] },
  { simp only [int.cast_zero, eq_self_iff_true, dvd_zero] },
  { lift a to ℕ using (le_of_lt h) with b,
    rw [int.cast_coe_nat, char_p.cast_eq_zero_iff R p, int.coe_nat_dvd] }
end

lemma char_p.int_coe_eq_int_coe_iff [add_group R] [has_one R] (p : ℕ) [char_p R p] (a b : ℤ) :
  (a : R) = (b : R) ↔ a ≡ b [ZMOD p] :=
by rw [eq_comm, ←sub_eq_zero, ←int.cast_sub,
       char_p.int_cast_eq_zero_iff R p, int.modeq_iff_dvd]

theorem char_p.eq [add_monoid R] [has_one R] {p q : ℕ} (c1 : char_p R p) (c2 : char_p R q) :
  p = q :=
nat.dvd_antisymm
  ((char_p.cast_eq_zero_iff R p q).1 (char_p.cast_eq_zero _ _))
  ((char_p.cast_eq_zero_iff R q p).1 (char_p.cast_eq_zero _ _))

instance char_p.of_char_zero [add_monoid R] [has_one R] [char_zero R] : char_p R 0 :=
⟨λ x, by rw [zero_dvd_iff, ← nat.cast_zero, nat.cast_inj]⟩

theorem char_p.exists [non_assoc_semiring R] : ∃ p, char_p R p :=
by letI := classical.dec_eq R; exact
classical.by_cases
  (assume H : ∀ p:ℕ, (p:R) = 0 → p = 0, ⟨0,
    ⟨λ x, by rw [zero_dvd_iff]; exact ⟨H x, by rintro rfl; refl⟩⟩⟩)
  (λ H, ⟨nat.find (not_forall.1 H), ⟨λ x,
    ⟨λ H1, nat.dvd_of_mod_eq_zero (by_contradiction $ λ H2,
      nat.find_min (not_forall.1 H)
        (nat.mod_lt x $ nat.pos_of_ne_zero $ not_of_not_imp $
          nat.find_spec (not_forall.1 H))
        (not_imp_of_and_not ⟨by rwa [← nat.mod_add_div x (nat.find (not_forall.1 H)),
          nat.cast_add, nat.cast_mul, of_not_not (not_not_of_not_imp $ nat.find_spec
            (not_forall.1 H)),
          zero_mul, add_zero] at H1, H2⟩)),
    λ H1, by rw [← nat.mul_div_cancel' H1, nat.cast_mul,
      of_not_not (not_not_of_not_imp $ nat.find_spec (not_forall.1 H)), zero_mul]⟩⟩⟩)

theorem char_p.exists_unique [non_assoc_semiring R] : ∃! p, char_p R p :=
let ⟨c, H⟩ := char_p.exists R in ⟨c, H, λ y H2, char_p.eq R H2 H⟩

theorem char_p.congr {R : Type u} [add_monoid R] [has_one R] {p : ℕ} (q : ℕ) [hq : char_p R q]
  (h : q = p) :
  char_p R p :=
h ▸ hq

/-- Noncomputable function that outputs the unique characteristic of a semiring. -/
noncomputable def ring_char [non_assoc_semiring R] : ℕ :=
classical.some (char_p.exists_unique R)

namespace ring_char
variables [non_assoc_semiring R]

theorem spec : ∀ x:ℕ, (x:R) = 0 ↔ ring_char R ∣ x :=
by letI := (classical.some_spec (char_p.exists_unique R)).1;
unfold ring_char; exact char_p.cast_eq_zero_iff R (ring_char R)

theorem eq (p : ℕ) [C : char_p R p] : ring_char R = p :=
((classical.some_spec (char_p.exists_unique R)).2 p C).symm

instance char_p : char_p R (ring_char R) :=
⟨spec R⟩

variables {R}

theorem of_eq {p : ℕ} (h : ring_char R = p) : char_p R p :=
char_p.congr (ring_char R) h

theorem eq_iff {p : ℕ} : ring_char R = p ↔ char_p R p :=
⟨of_eq, @eq R _ p⟩

theorem dvd {x : ℕ} (hx : (x : R) = 0) : ring_char R ∣ x :=
(spec R x).1 hx

@[simp]
lemma eq_zero [char_zero R] : ring_char R = 0 := eq R 0

end ring_char

theorem add_pow_char_of_commute [semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) (h : commute x y) :
  (x + y)^p = x^p + y^p :=
begin
  rw [commute.add_pow h, finset.sum_range_succ_comm, tsub_self, pow_zero, nat.choose_self],
  rw [nat.cast_one, mul_one, mul_one], congr' 1,
  convert finset.sum_eq_single 0 _ _,
  { simp only [mul_one, one_mul, nat.choose_zero_right, tsub_zero, nat.cast_one, pow_zero] },
  { intros b h1 h2,
    suffices : (p.choose b : R) = 0, { rw this, simp },
    rw char_p.cast_eq_zero_iff R p,
    refine nat.prime.dvd_choose_self (pos_iff_ne_zero.mpr h2) _ (fact.out _),
    rwa ← finset.mem_range },
  { intro h1,
    contrapose! h1,
    rw finset.mem_range,
    exact nat.prime.pos (fact.out _) }
end

theorem add_pow_char_pow_of_commute [semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) (h : commute x y) :
  (x + y) ^ (p ^ n) = x ^ (p ^ n) + y ^ (p ^ n) :=
begin
  induction n, { simp, },
  rw [pow_succ', pow_mul, pow_mul, pow_mul, n_ih],
  apply add_pow_char_of_commute, apply commute.pow_pow h,
end

theorem sub_pow_char_of_commute [ring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) (h : commute x y) :
  (x - y)^p = x^p - y^p :=
begin
  rw [eq_sub_iff_add_eq, ← add_pow_char_of_commute _ _ _ (commute.sub_left h rfl)],
  simp, repeat {apply_instance},
end

theorem sub_pow_char_pow_of_commute [ring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) (h : commute x y) :
  (x - y) ^ (p ^ n) = x ^ (p ^ n) - y ^ (p ^ n) :=
begin
  induction n, { simp, },
  rw [pow_succ', pow_mul, pow_mul, pow_mul, n_ih],
  apply sub_pow_char_of_commute, apply commute.pow_pow h,
end

theorem add_pow_char [comm_semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) : (x + y)^p = x^p + y^p :=
add_pow_char_of_commute _ _ _ (commute.all _ _)

theorem add_pow_char_pow [comm_semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) :
  (x + y) ^ (p ^ n) = x ^ (p ^ n) + y ^ (p ^ n) :=
add_pow_char_pow_of_commute _ _ _ (commute.all _ _)

theorem sub_pow_char [comm_ring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) : (x - y)^p = x^p - y^p :=
sub_pow_char_of_commute _ _ _ (commute.all _ _)

theorem sub_pow_char_pow [comm_ring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) :
  (x - y) ^ (p ^ n) = x ^ (p ^ n) - y ^ (p ^ n) :=
sub_pow_char_pow_of_commute _ _ _ (commute.all _ _)

lemma eq_iff_modeq_int [ring R] (p : ℕ) [char_p R p] (a b : ℤ) :
  (a : R) = b ↔ a ≡ b [ZMOD p] :=
by rw [eq_comm, ←sub_eq_zero, ←int.cast_sub,
       char_p.int_cast_eq_zero_iff R p, int.modeq_iff_dvd]

lemma char_p.neg_one_ne_one [ring R] (p : ℕ) [char_p R p] [fact (2 < p)] :
  (-1 : R) ≠ (1 : R) :=
begin
  suffices : (2 : R) ≠ 0,
  { symmetry, rw [ne.def, ← sub_eq_zero, sub_neg_eq_add], exact this },
  assume h,
  rw [show (2 : R) = (2 : ℕ), by norm_cast] at h,
  have := (char_p.cast_eq_zero_iff R p 2).mp h,
  have := nat.le_of_dvd dec_trivial this,
  rw fact_iff at *, linarith,
end

lemma char_p.neg_one_pow_char [comm_ring R] (p : ℕ) [char_p R p] [fact p.prime] :
  (-1 : R) ^ p = -1 :=
begin
  rw eq_neg_iff_add_eq_zero,
  nth_rewrite 1 ← one_pow p,
  rw [← add_pow_char, add_left_neg, zero_pow (fact.out (nat.prime p)).pos],
end

lemma char_p.neg_one_pow_char_pow [comm_ring R] (p n : ℕ) [char_p R p] [fact p.prime] :
  (-1 : R) ^ p ^ n = -1 :=
begin
  rw eq_neg_iff_add_eq_zero,
  nth_rewrite 1 ← one_pow (p ^ n),
  rw [← add_pow_char_pow, add_left_neg, zero_pow (pow_pos (fact.out (nat.prime p)).pos _)],
end

lemma ring_hom.char_p_iff_char_p {K L : Type*} [division_ring K] [semiring L] [nontrivial L]
  (f : K →+* L) (p : ℕ) :
  char_p K p ↔ char_p L p :=
begin
  split;
  { introI _c, constructor, intro n,
    rw [← @char_p.cast_eq_zero_iff _ _ _ p _c n, ← f.injective.eq_iff, map_nat_cast f, f.map_zero] }
end

section frobenius

section comm_semiring

variables [comm_semiring R] {S : Type v} [comm_semiring S] (f : R →* S) (g : R →+* S)
  (p : ℕ) [fact p.prime] [char_p R p] [char_p S p] (x y : R)

/-- The frobenius map that sends x to x^p -/
def frobenius : R →+* R :=
{ to_fun := λ x, x^p,
  map_one' := one_pow p,
  map_mul' := λ x y, mul_pow x y p,
  map_zero' := zero_pow (fact.out (nat.prime p)).pos,
  map_add' := add_pow_char R }

variable {R}

theorem frobenius_def : frobenius R p x = x ^ p := rfl

theorem iterate_frobenius (n : ℕ) : (frobenius R p)^[n] x = x ^ p ^ n :=
begin
  induction n, {simp},
  rw [function.iterate_succ', pow_succ', pow_mul, function.comp_apply, frobenius_def, n_ih]
end

theorem frobenius_mul : frobenius R p (x * y) = frobenius R p x * frobenius R p y :=
(frobenius R p).map_mul x y

theorem frobenius_one : frobenius R p 1 = 1 := one_pow _

theorem monoid_hom.map_frobenius : f (frobenius R p x) = frobenius S p (f x) :=
f.map_pow x p

theorem ring_hom.map_frobenius : g (frobenius R p x) = frobenius S p (g x) :=
g.map_pow x p

theorem monoid_hom.map_iterate_frobenius (n : ℕ) :
  f (frobenius R p^[n] x) = (frobenius S p^[n] (f x)) :=
function.semiconj.iterate_right (f.map_frobenius p) n x

theorem ring_hom.map_iterate_frobenius (n : ℕ) :
  g (frobenius R p^[n] x) = (frobenius S p^[n] (g x)) :=
g.to_monoid_hom.map_iterate_frobenius p x n

theorem monoid_hom.iterate_map_frobenius (f : R →* R) (p : ℕ) [fact p.prime] [char_p R p] (n : ℕ) :
  f^[n] (frobenius R p x) = frobenius R p (f^[n] x) :=
f.iterate_map_pow _ _ _

theorem ring_hom.iterate_map_frobenius (f : R →+* R) (p : ℕ) [fact p.prime] [char_p R p] (n : ℕ) :
  f^[n] (frobenius R p x) = frobenius R p (f^[n] x) :=
f.iterate_map_pow _ _ _

variable (R)

theorem frobenius_zero : frobenius R p 0 = 0 := (frobenius R p).map_zero

theorem frobenius_add : frobenius R p (x + y) = frobenius R p x + frobenius R p y :=
(frobenius R p).map_add x y

theorem frobenius_nat_cast (n : ℕ) : frobenius R p n = n := map_nat_cast (frobenius R p) n

open_locale big_operators
variables {R}

lemma list_sum_pow_char (l : list R) : l.sum ^ p = (l.map (^ p)).sum :=
(frobenius R p).map_list_sum _

lemma multiset_sum_pow_char (s : multiset R) : s.sum ^ p = (s.map (^ p)).sum :=
(frobenius R p).map_multiset_sum _

lemma sum_pow_char {ι : Type*} (s : finset ι) (f : ι → R) :
  (∑ i in s, f i) ^ p = ∑ i in s, f i ^ p :=
(frobenius R p).map_sum _ _

end comm_semiring

section comm_ring

variables [comm_ring R] {S : Type v} [comm_ring S] (f : R →* S) (g : R →+* S)
  (p : ℕ) [fact p.prime] [char_p R p]  [char_p S p] (x y : R)

theorem frobenius_neg : frobenius R p (-x) = -frobenius R p x := (frobenius R p).map_neg x

theorem frobenius_sub : frobenius R p (x - y) = frobenius R p x - frobenius R p y :=
(frobenius R p).map_sub x y

end comm_ring

end frobenius

theorem frobenius_inj [comm_ring R] [is_reduced R]
  (p : ℕ) [fact p.prime] [char_p R p] :
  function.injective (frobenius R p) :=
λ x h H, by { rw ← sub_eq_zero at H ⊢, rw ← frobenius_sub at H, exact is_reduced.eq_zero _ ⟨_,H⟩ }

namespace char_p

section
variables [ring R]

lemma char_p_to_char_zero (R : Type*) [add_left_cancel_monoid R] [has_one R] [char_p R 0] :
  char_zero R :=
char_zero_of_inj_zero $
  λ n h0, eq_zero_of_zero_dvd ((cast_eq_zero_iff R 0 n).mp h0)

lemma cast_eq_mod (p : ℕ) [char_p R p] (k : ℕ) : (k : R) = (k % p : ℕ) :=
calc (k : R) = ↑(k % p + p * (k / p)) : by rw [nat.mod_add_div]
         ... = ↑(k % p)               : by simp [cast_eq_zero]

theorem char_ne_zero_of_fintype (p : ℕ) [hc : char_p R p] [fintype R] : p ≠ 0 :=
assume h : p = 0,
have char_zero R := @char_p_to_char_zero R _ _ (h ▸ hc),
absurd (@nat.cast_injective R _ _ this) (not_injective_infinite_fintype coe)

end

section semiring
open nat

variables [non_assoc_semiring R]

theorem char_ne_one [nontrivial R] (p : ℕ) [hc : char_p R p] : p ≠ 1 :=
assume hp : p = 1,
have ( 1 : R) = 0, by simpa using (cast_eq_zero_iff R p 1).mpr (hp ▸ dvd_refl p),
absurd this one_ne_zero

section no_zero_divisors

variable [no_zero_divisors R]

theorem char_is_prime_of_two_le (p : ℕ) [hc : char_p R p] (hp : 2 ≤ p) : nat.prime p :=
suffices ∀d ∣ p, d = 1 ∨ d = p, from nat.prime_def_lt''.mpr ⟨hp, this⟩,
assume (d : ℕ) (hdvd : ∃ e, p = d * e),
let ⟨e, hmul⟩ := hdvd in
have (p : R) = 0, from (cast_eq_zero_iff R p p).mpr (dvd_refl p),
have (d : R) * e = 0, from (@cast_mul R _ d e) ▸ (hmul ▸ this),
or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this)
  (assume hd : (d : R) = 0,
  have p ∣ d, from (cast_eq_zero_iff R p d).mp hd,
  show d = 1 ∨ d = p, from or.inr (dvd_antisymm ⟨e, hmul⟩ this))
  (assume he : (e : R) = 0,
  have p ∣ e, from (cast_eq_zero_iff R p e).mp he,
  have e ∣ p, from dvd_of_mul_left_eq d (eq.symm hmul),
  have e = p, from dvd_antisymm ‹e ∣ p› ‹p ∣ e›,
  have h₀ : p > 0, from gt_of_ge_of_gt hp (nat.zero_lt_succ 1),
  have d * p = 1 * p, by rw ‹e = p› at hmul; rw [one_mul]; exact eq.symm hmul,
  show d = 1 ∨ d = p, from or.inl (eq_of_mul_eq_mul_right h₀ this))

section nontrivial

variables [nontrivial R]

theorem char_is_prime_or_zero (p : ℕ) [hc : char_p R p] : nat.prime p ∨ p = 0 :=
match p, hc with
| 0,     _  := or.inr rfl
| 1,     hc := absurd (eq.refl (1 : ℕ)) (@char_ne_one R _ _ (1 : ℕ) hc)
| (m+2), hc := or.inl (@char_is_prime_of_two_le R _ _ (m+2) hc (nat.le_add_left 2 m))
end

lemma char_is_prime_of_pos (p : ℕ) [h : fact (0 < p)] [char_p R p] : fact p.prime :=
⟨(char_p.char_is_prime_or_zero R _).resolve_right (pos_iff_ne_zero.1 h.1)⟩

end nontrivial

end no_zero_divisors

end semiring

section ring

variables (R) [ring R] [no_zero_divisors R] [nontrivial R] [fintype R]

theorem char_is_prime (p : ℕ) [char_p R p] :
  p.prime :=
or.resolve_right (char_is_prime_or_zero R p) (char_ne_zero_of_fintype R p)

end ring

section char_one

variables {R} [non_assoc_semiring R]

@[priority 100]  -- see Note [lower instance priority]
instance [char_p R 1] : subsingleton R :=
subsingleton.intro $
suffices ∀ (r : R), r = 0,
  from assume a b, show a = b, by rw [this a, this b],
assume r,
calc r = 1 * r       : by rw one_mul
   ... = (1 : ℕ) * r : by rw nat.cast_one
   ... = 0 * r       : by rw char_p.cast_eq_zero
   ... = 0           : by rw zero_mul

lemma false_of_nontrivial_of_char_one [nontrivial R] [char_p R 1] : false :=
false_of_nontrivial_of_subsingleton R

lemma ring_char_ne_one [nontrivial R] : ring_char R ≠ 1 :=
by { intros h, apply @zero_ne_one R, symmetry, rw [←nat.cast_one, ring_char.spec, h], }

lemma nontrivial_of_char_ne_one {v : ℕ} (hv : v ≠ 1) [hr : char_p R v] :
  nontrivial R :=
⟨⟨(1 : ℕ), 0, λ h, hv $ by rwa [char_p.cast_eq_zero_iff _ v, nat.dvd_one] at h; assumption ⟩⟩

lemma ring_char_of_prime_eq_zero [nontrivial R] {p : ℕ}
  (hprime : nat.prime p) (hp0 : (p : R) = 0) : ring_char R = p :=
or.resolve_left ((nat.dvd_prime hprime).1 (ring_char.dvd hp0)) ring_char_ne_one

end char_one

end char_p

section

variables (R) [comm_ring R] [fintype R] (n : ℕ)

lemma char_p_of_ne_zero (hn : fintype.card R = n) (hR : ∀ i < n, (i : R) = 0 → i = 0) :
  char_p R n :=
{ cast_eq_zero_iff :=
  begin
    have H : (n : R) = 0, by { rw [← hn, char_p.cast_card_eq_zero] },
    intro k,
    split,
    { intro h,
      rw [← nat.mod_add_div k n, nat.cast_add, nat.cast_mul, H, zero_mul, add_zero] at h,
      rw nat.dvd_iff_mod_eq_zero,
      apply hR _ (nat.mod_lt _ _) h,
      rw [← hn, fintype.card_pos_iff],
      exact ⟨0⟩, },
    { rintro ⟨k, rfl⟩, rw [nat.cast_mul, H, zero_mul] }
  end }

lemma char_p_of_prime_pow_injective (p : ℕ) [hp : fact p.prime] (n : ℕ)
  (hn : fintype.card R = p ^ n) (hR : ∀ i ≤ n, (p ^ i : R) = 0 → i = n) :
  char_p R (p ^ n) :=
begin
  obtain ⟨c, hc⟩ := char_p.exists R, resetI,
  have hcpn : c ∣ p ^ n,
  { rw [← char_p.cast_eq_zero_iff R c, ← hn, char_p.cast_card_eq_zero], },
  obtain ⟨i, hi, hc⟩ : ∃ i ≤ n, c = p ^ i, by rwa nat.dvd_prime_pow hp.1 at hcpn,
  obtain rfl : i = n,
  { apply hR i hi, rw [← nat.cast_pow, ← hc, char_p.cast_eq_zero] },
  rwa ← hc
end

end

section prod

variables (S : Type v) [semiring R] [semiring S] (p q : ℕ) [char_p R p]

/-- The characteristic of the product of rings is the least common multiple of the
characteristics of the two rings. -/
instance [char_p S q] : char_p (R × S) (nat.lcm p q) :=
{ cast_eq_zero_iff :=
    by simp [prod.ext_iff, char_p.cast_eq_zero_iff R p,
      char_p.cast_eq_zero_iff S q, nat.lcm_dvd_iff] }

/-- The characteristic of the product of two rings of the same characteristic
  is the same as the characteristic of the rings -/
instance prod.char_p [char_p S p] : char_p (R × S) p :=
by convert nat.lcm.char_p R S p p; simp

end prod


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.monoid_algebra.division
import data.mv_polynomial.basic

/-!
# Division of `mv_polynomial` by monomials

## Main definitions

* `mv_polynomial.div_monomial x s`: divides `x` by the monomial `mv_polynomial.monomial 1 s`
* `mv_polynomial.mod_monomial x s`: the remainder upon dividing `x` by the monomial
  `mv_polynomial.monomial 1 s`.

## Main results

* `mv_polynomial.div_monomial_add_mod_monomial`, `mv_polynomial.mod_monomial_add_div_monomial`:
  `div_monomial` and `mod_monomial` are well-behaved as quotient and remainder operators.

## Implementation notes

Where possible, the results in this file should be first proved in the generality of
`add_monoid_algebra`, and then the versions specialized to `mv_polynomial` proved in terms of these.

-/

variables {σ R : Type*} [comm_semiring R]

namespace mv_polynomial

section copied_declarations
/-! Please ensure the declarations in this section are direct translations of `add_monoid_algebra`
results. -/

/-- Divide by `monomial 1 s`, discarding terms not divisible by this. -/
noncomputable def div_monomial (p : mv_polynomial σ R) (s : σ →₀ ℕ) : mv_polynomial σ R :=
add_monoid_algebra.div_of p s

local infix ` /ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := div_monomial

@[simp] lemma coeff_div_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R) (s' : σ →₀ ℕ) :
  coeff s' (x /ᵐᵒⁿᵒᵐⁱᵃˡ s) = coeff (s + s') x := rfl

@[simp] lemma support_div_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R)  :
  (x /ᵐᵒⁿᵒᵐⁱᵃˡ s).support = x.support.preimage _ ((add_right_injective s).inj_on _) := rfl

@[simp] lemma zero_div_monomial (s : σ →₀ ℕ) : (0 : mv_polynomial σ R) /ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 :=
add_monoid_algebra.zero_div_of _

lemma div_monomial_zero (x : mv_polynomial σ R) : x /ᵐᵒⁿᵒᵐⁱᵃˡ 0 = x :=
x.div_of_zero

lemma add_div_monomial (x y : mv_polynomial σ R) (s : σ →₀ ℕ) :
  (x + y) /ᵐᵒⁿᵒᵐⁱᵃˡ s = x /ᵐᵒⁿᵒᵐⁱᵃˡ s + y /ᵐᵒⁿᵒᵐⁱᵃˡ s :=
map_add _ _ _

lemma div_monomial_add (a b : σ →₀ ℕ) (x : mv_polynomial σ R)  :
  x /ᵐᵒⁿᵒᵐⁱᵃˡ (a + b) = (x /ᵐᵒⁿᵒᵐⁱᵃˡ a) /ᵐᵒⁿᵒᵐⁱᵃˡ b :=
x.div_of_add _ _

@[simp] lemma div_monomial_monomial_mul (a : σ →₀ ℕ) (x : mv_polynomial σ R) :
  (monomial a 1 * x) /ᵐᵒⁿᵒᵐⁱᵃˡ a = x :=
x.of'_mul_div_of _

@[simp] lemma div_monomial_mul_monomial (a : σ →₀ ℕ) (x : mv_polynomial σ R) :
  (x * monomial a 1) /ᵐᵒⁿᵒᵐⁱᵃˡ a = x :=
x.mul_of'_div_of _

@[simp] lemma div_monomial_monomial (a : σ →₀ ℕ) :
  (monomial a 1) /ᵐᵒⁿᵒᵐⁱᵃˡ a = (1 : mv_polynomial σ R) :=
add_monoid_algebra.of'_div_of _

/-- The remainder upon division by `monomial 1 s`. -/
noncomputable def mod_monomial (x : mv_polynomial σ R) (s : σ →₀ ℕ) : mv_polynomial σ R :=
x.mod_of s

local infix ` %ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := mod_monomial

@[simp] lemma coeff_mod_monomial_of_not_le {s' s : σ →₀ ℕ} (x : mv_polynomial σ R) (h : ¬s ≤ s') :
  coeff s' (x %ᵐᵒⁿᵒᵐⁱᵃˡ s) = coeff s' x :=
x.mod_of_apply_of_not_exists_add s s' begin
  rintro ⟨d, rfl⟩,
  exact h le_self_add,
end

@[simp] lemma coeff_mod_monomial_of_le {s' s : σ →₀ ℕ} (x : mv_polynomial σ R) (h : s ≤ s') :
  coeff s' (x %ᵐᵒⁿᵒᵐⁱᵃˡ s) = 0 :=
x.mod_of_apply_of_exists_add _ _ $ exists_add_of_le h

@[simp] lemma monomial_mul_mod_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R) :
  (monomial s 1 * x) %ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 :=
x.of'_mul_mod_of _

@[simp] lemma mul_monomial_mod_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R):
  (x * monomial s 1) %ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 :=
x.mul_of'_mod_of _

@[simp] lemma monomial_mod_monomial (s : σ →₀ ℕ) : (monomial s (1 : R)) %ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 :=
add_monoid_algebra.of'_mod_of _

lemma div_monomial_add_mod_monomial (x : mv_polynomial σ R) (s : σ →₀ ℕ) :
  monomial s 1 * (x /ᵐᵒⁿᵒᵐⁱᵃˡ s) + x %ᵐᵒⁿᵒᵐⁱᵃˡ s = x :=
add_monoid_algebra.div_of_add_mod_of x s

lemma mod_monomial_add_div_monomial (x : mv_polynomial σ R) (s : σ →₀ ℕ) :
  x %ᵐᵒⁿᵒᵐⁱᵃˡ s + monomial s 1 * (x /ᵐᵒⁿᵒᵐⁱᵃˡ s) = x :=
add_monoid_algebra.mod_of_add_div_of x s

lemma monomial_one_dvd_iff_mod_monomial_eq_zero {i : σ →₀ ℕ} {x : mv_polynomial σ R} :
  monomial i (1 : R) ∣ x ↔ x %ᵐᵒⁿᵒᵐⁱᵃˡ i = 0  :=
add_monoid_algebra.of'_dvd_iff_mod_of_eq_zero

end copied_declarations

section X_lemmas

local infix ` /ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := div_monomial
local infix ` %ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := mod_monomial

@[simp] lemma X_mul_div_monomial (i : σ) (x : mv_polynomial σ R) :
   (X i * x) /ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = x :=
div_monomial_monomial_mul _ _

@[simp] lemma X_div_monomial (i : σ) :
  (X i : mv_polynomial σ R) /ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1)  = 1 :=
(div_monomial_monomial (finsupp.single i 1))

@[simp] lemma mul_X_div_monomial (x : mv_polynomial σ R) (i : σ) :
  (x * X i) /ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = x :=
div_monomial_mul_monomial _ _

@[simp] lemma X_mul_mod_monomial (i : σ) (x : mv_polynomial σ R) :
  (X i * x) %ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1)  = 0 :=
monomial_mul_mod_monomial _ _

@[simp] lemma mul_X_mod_monomial (x : mv_polynomial σ R) (i : σ) :
  (x * X i) %ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1)  = 0 :=
mul_monomial_mod_monomial _ _

@[simp] lemma mod_monomial_X (i : σ) :
  (X i : mv_polynomial σ R) %ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = 0 :=
monomial_mod_monomial _

lemma div_monomial_add_mod_monomial_single (x : mv_polynomial σ R) (i : σ) :
  X i * (x /ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1) + x %ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1 = x :=
div_monomial_add_mod_monomial _ _

lemma mod_monomial_add_div_monomial_single (x : mv_polynomial σ R) (i : σ) :
  x %ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1 + X i * (x /ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1) = x :=
mod_monomial_add_div_monomial _ _

lemma X_dvd_iff_mod_monomial_eq_zero {i : σ} {x : mv_polynomial σ R} :
  X i ∣ x ↔ x %ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1 = 0  :=
monomial_one_dvd_iff_mod_monomial_eq_zero

end X_lemmas

/-! ### Some results about dvd (`∣`) on `monomial` and `X` -/

lemma monomial_dvd_monomial {r s : R} {i j : σ →₀ ℕ} :
  monomial i r ∣ monomial j s ↔ (s = 0 ∨ i ≤ j) ∧ r ∣ s :=
begin
  split,
  { rintro ⟨x, hx⟩,
    rw mv_polynomial.ext_iff at hx,
    have hj := hx j,
    have hi := hx i,
    classical,
    simp_rw [coeff_monomial, if_pos] at hj hi,
    simp_rw [coeff_monomial_mul', if_pos] at hi hj,
    split_ifs at hi hj with hi hi,
    { exact ⟨or.inr hi, _, hj⟩ },
    { exact ⟨or.inl hj, hj.symm ▸ dvd_zero _⟩ } },
  { rintro ⟨h | hij, d, rfl⟩,
    { simp_rw [h, monomial_zero, dvd_zero] },
    { refine ⟨monomial (j - i) d, _⟩,
      rw [monomial_mul, add_tsub_cancel_of_le hij] } }
end

@[simp] lemma monomial_one_dvd_monomial_one [nontrivial R] {i j : σ →₀ ℕ} :
  monomial i (1 : R) ∣ monomial j 1 ↔ i ≤ j :=
begin
  rw monomial_dvd_monomial,
  simp_rw [one_ne_zero, false_or, dvd_rfl, and_true],
end

@[simp] lemma X_dvd_X [nontrivial R] {i j : σ} :
  (X i : mv_polynomial σ R) ∣ (X j : mv_polynomial σ R) ↔ i = j :=
begin
  refine monomial_one_dvd_monomial_one.trans _,
  simp_rw [finsupp.single_le_iff, nat.one_le_iff_ne_zero, finsupp.single_apply_ne_zero,
    ne.def, one_ne_zero, not_false_iff, and_true],
end

@[simp] lemma X_dvd_monomial {i : σ} {j : σ →₀ ℕ} {r : R} :
  (X i : mv_polynomial σ R) ∣ monomial j r ↔ (r = 0 ∨ j i ≠ 0) :=
begin
  refine monomial_dvd_monomial.trans _,
  simp_rw [one_dvd, and_true, finsupp.single_le_iff, nat.one_le_iff_ne_zero],
end

end mv_polynomial