/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import algebra.char_p.invertible
import data.zmod.basic
import ring_theory.localization.fraction_ring
import ring_theory.polynomial.chebyshev
import ring_theory.ideal.local_ring

/-!
# Dickson polynomials

The (generalised) Dickson polynomials are a family of polynomials indexed by `ℕ × ℕ`,
with coefficients in a commutative ring `R` depending on an element `a∈R`. More precisely, the
they satisfy the recursion `dickson k a (n + 2) = X * (dickson k a n + 1) - a * (dickson k a n)`
with starting values `dickson k a 0 = 3 - k` and `dickson k a 1 = X`. In the literature,
`dickson k a n` is called the `n`-th Dickson polynomial of the `k`-th kind associated to the
parameter `a : R`. They are closely related to the Chebyshev polynomials in the case that `a=1`.
When `a=0` they are just the family of monomials `X ^ n`.

## Main definition

* `polynomial.dickson`: the generalised Dickson polynomials.

## Main statements

* `polynomial.dickson_one_one_mul`, the `(m * n)`-th Dickson polynomial of the first kind for
  parameter `1 : R` is the composition of the `m`-th and `n`-th Dickson polynomials of the first
  kind for `1 : R`.
* `polynomial.dickson_one_one_char_p`, for a prime number `p`, the `p`-th Dickson polynomial of the
  first kind associated to parameter `1 : R` is congruent to `X ^ p` modulo `p`.

## References

* [R. Lidl, G. L. Mullen and G. Turnwald, _Dickson polynomials_][MR1237403]

## TODO

* Redefine `dickson` in terms of `linear_recurrence`.
* Show that `dickson 2 1` is equal to the characteristic polynomial of the adjacency matrix of a
  type A Dynkin diagram.
* Prove that the adjacency matrices of simply laced Dynkin diagrams are precisely the adjacency
  matrices of simple connected graphs which annihilate `dickson 2 1`.
-/

noncomputable theory

namespace polynomial
open_locale polynomial

variables {R S : Type*} [comm_ring R] [comm_ring S] (k : ℕ) (a : R)

/-- `dickson` is the `n`the (generalised) Dickson polynomial of the `k`-th kind associated to the
element `a ∈ R`. -/
noncomputable def dickson : ℕ → R[X]
| 0       := 3 - k
| 1       := X
| (n + 2) := X * dickson (n + 1) - (C a) * dickson n

@[simp] lemma dickson_zero : dickson k a 0 = 3 - k := rfl
@[simp] lemma dickson_one : dickson k a 1 = X := rfl
lemma dickson_two : dickson k a 2 = X ^ 2 - C a * (3 - k) :=
by simp only [dickson, sq]
@[simp] lemma dickson_add_two (n : ℕ) :
  dickson k a (n + 2) = X * dickson k a (n + 1) - C a * dickson k a n :=
by rw dickson

lemma dickson_of_two_le {n : ℕ} (h : 2 ≤ n) :
  dickson k a n = X * dickson k a (n - 1) - C a * dickson k a (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact dickson_add_two k a n
end

variables {R S k a}

lemma map_dickson (f : R →+* S) :
  ∀ (n : ℕ), map f (dickson k a n) = dickson k (f a) n
| 0       := by simp only [dickson_zero, polynomial.map_sub, polynomial.map_nat_cast,
                            bit1, bit0, polynomial.map_add, polynomial.map_one]
| 1       := by simp only [dickson_one, map_X]
| (n + 2) :=
begin
  simp only [dickson_add_two, polynomial.map_sub, polynomial.map_mul, map_X, map_C],
  rw [map_dickson, map_dickson]
end

variable {R}

@[simp] lemma dickson_two_zero :
  ∀ (n : ℕ), dickson 2 (0 : R) n = X ^ n
| 0       := by { simp only [dickson_zero, pow_zero], norm_num }
| 1       := by simp only [dickson_one, pow_one]
| (n + 2) :=
begin
  simp only [dickson_add_two, C_0, zero_mul, sub_zero],
  rw [dickson_two_zero, pow_add X (n + 1) 1, mul_comm, pow_one]
end

section dickson
/-!

### A Lambda structure on `ℤ[X]`

Mathlib doesn't currently know what a Lambda ring is.
But once it does, we can endow `ℤ[X]` with a Lambda structure
in terms of the `dickson 1 1` polynomials defined below.
There is exactly one other Lambda structure on `ℤ[X]` in terms of binomial polynomials.

-/

variables {R}

lemma dickson_one_one_eval_add_inv (x y : R) (h : x * y = 1) :
  ∀ n, (dickson 1 (1 : R) n).eval (x + y) = x ^ n + y ^ n
| 0       := by { simp only [bit0, eval_one, eval_add, pow_zero, dickson_zero], norm_num }
| 1       := by simp only [eval_X, dickson_one, pow_one]
| (n + 2) :=
begin
  simp only [eval_sub, eval_mul, dickson_one_one_eval_add_inv, eval_X, dickson_add_two, C_1,
    eval_one],
  conv_lhs { simp only [pow_succ, add_mul, mul_add, h, ← mul_assoc, mul_comm y x, one_mul] },
  ring_exp
end

variables (R)

lemma dickson_one_one_eq_chebyshev_T [invertible (2 : R)] :
  ∀ n, dickson 1 (1 : R) n = 2 * (chebyshev.T R n).comp (C (⅟2) * X)
| 0       := by { simp only [chebyshev.T_zero, mul_one, one_comp, dickson_zero], norm_num }
| 1       := by rw [dickson_one, chebyshev.T_one, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul,
                    mul_inv_of_self, C_1, one_mul]
| (n + 2) :=
begin
  simp only [dickson_add_two, chebyshev.T_add_two, dickson_one_one_eq_chebyshev_T (n + 1),
    dickson_one_one_eq_chebyshev_T n, sub_comp, mul_comp, add_comp, X_comp, bit0_comp, one_comp],
  simp only [← C_1, ← C_bit0, ← mul_assoc, ← C_mul, mul_inv_of_self],
  rw [C_1, one_mul],
  ring
end

lemma chebyshev_T_eq_dickson_one_one [invertible (2 : R)] (n : ℕ) :
  chebyshev.T R n = C (⅟2) * (dickson 1 1 n).comp (2 * X) :=
begin
  rw dickson_one_one_eq_chebyshev_T,
  simp only [comp_assoc, mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul],
  rw [inv_of_mul_self, C_1, one_mul, one_mul, comp_X]
end

/-- The `(m * n)`-th Dickson polynomial of the first kind is the composition of the `m`-th and
`n`-th. -/
lemma dickson_one_one_mul (m n : ℕ) :
  dickson 1 (1 : R) (m * n) = (dickson 1 1 m).comp (dickson 1 1 n) :=
begin
  have h : (1 : R) = int.cast_ring_hom R (1),
    simp only [eq_int_cast, int.cast_one],
  rw h,
  simp only [← map_dickson (int.cast_ring_hom R), ← map_comp],
  congr' 1,
  apply map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  simp only [map_dickson, map_comp, eq_int_cast, int.cast_one,
    dickson_one_one_eq_chebyshev_T, chebyshev.T_mul, two_mul, ← add_comp],
  simp only [← two_mul, ← comp_assoc],
  apply eval₂_congr rfl rfl,
  rw [comp_assoc],
  apply eval₂_congr rfl _ rfl,
  rw [mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul,
      inv_of_mul_self, C_1, one_mul]
end

lemma dickson_one_one_comp_comm (m n : ℕ) :
  (dickson 1 (1 : R) m).comp (dickson 1 1 n) = (dickson 1 1 n).comp (dickson 1 1 m) :=
by rw [← dickson_one_one_mul, mul_comm, dickson_one_one_mul]

lemma dickson_one_one_zmod_p (p : ℕ) [fact p.prime] :
  dickson 1 (1 : zmod p) p = X ^ p :=
begin
  -- Recall that `dickson_eval_add_inv` characterises `dickson 1 1 p`
  -- as a polynomial that maps `x + x⁻¹` to `x ^ p + (x⁻¹) ^ p`.
  -- Since `X ^ p` also satisfies this property in characteristic `p`,
  -- we can use a variant on `polynomial.funext` to conclude that these polynomials are equal.
  -- For this argument, we need an arbitrary infinite field of characteristic `p`.
  obtain ⟨K, _, _, H⟩ : ∃ (K : Type) (_ : field K), by exactI ∃ (_ : char_p K p), infinite K,
  { let K := fraction_ring (polynomial (zmod p)),
    let f : zmod p →+* K := (algebra_map _ (fraction_ring _)).comp C,
    haveI : char_p K p, { rw ← f.char_p_iff_char_p, apply_instance },
    haveI : infinite K :=
    infinite.of_injective (algebra_map (polynomial (zmod p)) (fraction_ring (polynomial (zmod p))))
      (is_fraction_ring.injective _ _),
    refine ⟨K, _, _, _⟩; apply_instance },
  resetI,
  apply map_injective (zmod.cast_hom (dvd_refl p) K) (ring_hom.injective _),
  rw [map_dickson, polynomial.map_pow, map_X],
  apply eq_of_infinite_eval_eq,
  -- The two polynomials agree on all `x` of the form `x = y + y⁻¹`.
  apply @set.infinite.mono _ {x : K | ∃ y, x = y + y⁻¹ ∧ y ≠ 0},
  { rintro _ ⟨x, rfl, hx⟩,
    simp only [eval_X, eval_pow, set.mem_set_of_eq, @add_pow_char K _ p,
      dickson_one_one_eval_add_inv _ _ (mul_inv_cancel hx), inv_pow, zmod.cast_hom_apply,
      zmod.cast_one'] },
  -- Now we need to show that the set of such `x` is infinite.
  -- If the set is finite, then we will show that `K` is also finite.
  { intro h,
    rw ← set.infinite_univ_iff at H,
    apply H,
    -- To each `x` of the form `x = y + y⁻¹`
    -- we `bind` the set of `y` that solve the equation `x = y + y⁻¹`.
    -- For every `x`, that set is finite (since it is governed by a quadratic equation).
    -- For the moment, we claim that all these sets together cover `K`.
    suffices : (set.univ : set K) =
      {x : K | ∃ (y : K), x = y + y⁻¹ ∧ y ≠ 0} >>= (λ x, {y | x = y + y⁻¹ ∨ y = 0}),
    { rw this, clear this,
      refine h.bUnion (λ x hx, _),
      -- The following quadratic polynomial has as solutions the `y` for which `x = y + y⁻¹`.
      let φ : K[X] := X ^ 2 - C x * X + 1,
      have hφ : φ ≠ 0,
      { intro H,
        have : φ.eval 0 = 0, by rw [H, eval_zero],
        simpa [eval_X, eval_one, eval_pow, eval_sub, sub_zero, eval_add,
          eval_mul, mul_zero, sq, zero_add, one_ne_zero] },
      classical,
      convert (φ.roots ∪ {0}).to_finset.finite_to_set using 1,
      ext1 y,
      simp only [multiset.mem_to_finset, set.mem_set_of_eq, finset.mem_coe, multiset.mem_union,
        mem_roots hφ, is_root, eval_add, eval_sub, eval_pow, eval_mul, eval_X, eval_C, eval_one,
        multiset.mem_singleton],
      by_cases hy : y = 0,
      { simp only [hy, eq_self_iff_true, or_true] },
      apply or_congr _ iff.rfl,
      rw [← mul_left_inj' hy, eq_comm, ← sub_eq_zero, add_mul, inv_mul_cancel hy],
      apply eq_iff_eq_cancel_right.mpr,
      ring },
    -- Finally, we prove the claim that our finite union of finite sets covers all of `K`.
    { apply (set.eq_univ_of_forall _).symm,
      intro x,
      simp only [exists_prop, set.mem_Union, set.bind_def, ne.def, set.mem_set_of_eq],
      by_cases hx : x = 0,
      { simp only [hx, and_true, eq_self_iff_true, inv_zero, or_true],
        exact ⟨_, 1, rfl, one_ne_zero⟩ },
      { simp only [hx, or_false, exists_eq_right],
        exact ⟨_, rfl, hx⟩ } } }
end

lemma dickson_one_one_char_p (p : ℕ) [fact p.prime] [char_p R p] :
  dickson 1 (1 : R) p = X ^ p :=
begin
  have h : (1 : R) = zmod.cast_hom (dvd_refl p) R (1),
    simp only [zmod.cast_hom_apply, zmod.cast_one'],
  rw [h, ← map_dickson (zmod.cast_hom (dvd_refl p) R), dickson_one_one_zmod_p,
      polynomial.map_pow, map_X]
end

end dickson

end polynomial


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.limits.shapes.biproducts
import group_theory.eckmann_hilton

/-!
# Constructing a semiadditive structure from binary biproducts

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

We show that any category with zero morphisms and binary biproducts is enriched over the category
of commutative monoids.

-/

noncomputable theory

universes v u

open category_theory
open category_theory.limits

namespace category_theory.semiadditive_of_binary_biproducts
variables {C : Type u} [category.{v} C] [has_zero_morphisms C] [has_binary_biproducts C]

section
variables (X Y : C)

/-- `f +ₗ g` is the composite `X ⟶ Y ⊞ Y ⟶ Y`, where the first map is `(f, g)` and the second map
    is `(𝟙 𝟙)`. -/
@[simp] def left_add (f g : X ⟶ Y) : X ⟶ Y :=
biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y)

/-- `f +ᵣ g` is the composite `X ⟶ X ⊞ X ⟶ Y`, where the first map is `(𝟙, 𝟙)` and the second map
    is `(f g)`. -/
@[simp] def right_add (f g : X ⟶ Y) : X ⟶ Y :=
biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g

local infixr ` +ₗ `:65 := left_add X Y
local infixr ` +ᵣ `:65 := right_add X Y

lemma is_unital_left_add : eckmann_hilton.is_unital (+ₗ) 0 :=
⟨⟨λ f, by simp [show biprod.lift (0 : X ⟶ Y) f = f ≫ biprod.inr, by ext; simp]⟩,
 ⟨λ f, by simp [show biprod.lift f (0 : X ⟶ Y) = f ≫ biprod.inl, by ext; simp]⟩⟩

lemma is_unital_right_add : eckmann_hilton.is_unital (+ᵣ) 0 :=
⟨⟨λ f, by simp [show biprod.desc (0 : X ⟶ Y) f = biprod.snd ≫ f, by ext; simp]⟩,
 ⟨λ f, by simp [show biprod.desc f (0 : X ⟶ Y) = biprod.fst ≫ f, by ext; simp]⟩⟩

lemma distrib (f g h k : X ⟶ Y) : (f +ᵣ g) +ₗ (h +ᵣ k) = (f +ₗ h) +ᵣ (g +ₗ k) :=
begin
  let diag : X ⊞ X ⟶ Y ⊞ Y := biprod.lift (biprod.desc f g) (biprod.desc h k),
  have hd₁ : biprod.inl ≫ diag = biprod.lift f h := by { ext; simp },
  have hd₂ : biprod.inr ≫ diag = biprod.lift g k := by { ext; simp },
  have h₁ : biprod.lift (f +ᵣ g) (h +ᵣ k) = biprod.lift (𝟙 X) (𝟙 X) ≫ diag := by { ext; simp },
  have h₂ : diag ≫ biprod.desc (𝟙 Y) (𝟙 Y) = biprod.desc (f +ₗ h) (g +ₗ k),
  { ext; simp [reassoc_of hd₁, reassoc_of hd₂] },
  rw [left_add, h₁, category.assoc, h₂, right_add]
end

/-- In a category with binary biproducts, the morphisms form a commutative monoid. -/
def add_comm_monoid_hom_of_has_binary_biproducts : add_comm_monoid (X ⟶ Y) :=
{ add := (+ᵣ),
  add_assoc := (eckmann_hilton.mul_assoc (is_unital_left_add X Y)
    (is_unital_right_add X Y) (distrib X Y)).assoc,
  zero := 0,
  zero_add := (is_unital_right_add X Y).left_id,
  add_zero := (is_unital_right_add X Y).right_id,
  add_comm := (eckmann_hilton.mul_comm (is_unital_left_add X Y)
    (is_unital_right_add X Y) (distrib  X Y)).comm }

end

section
variables {X Y Z : C}

local attribute [instance] add_comm_monoid_hom_of_has_binary_biproducts

lemma add_eq_right_addition (f g : X ⟶ Y) : f + g = biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g :=
rfl

lemma add_eq_left_addition (f g : X ⟶ Y) : f + g = biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y) :=
congr_fun₂
  (eckmann_hilton.mul (is_unital_left_add X Y) (is_unital_right_add X Y) (distrib  X Y)).symm f g

lemma add_comp (f g : X ⟶ Y) (h : Y ⟶ Z) : (f + g) ≫ h = f ≫ h + g ≫ h :=
by { simp only [add_eq_right_addition, category.assoc], congr, ext; simp }

lemma comp_add (f : X ⟶ Y) (g h : Y ⟶ Z) : f ≫ (g + h) = f ≫ g + f ≫ h :=
by { simp only [add_eq_left_addition, ← category.assoc], congr, ext; simp }

end

end category_theory.semiadditive_of_binary_biproducts


def append (as bs : List α) : List α :=
  match as with
  | [] => bs
  | a :: as => a :: append as bs

theorem append_nil (as : List α) : append as [] = as := by
  induction as <;> simp_all!

theorem append_nil' (as : List α) : append as [] = as := by
  induction as <;> simp! [*]

theorem append_assoc (as bs cs : List α) : append (append as bs) cs = append as (append bs cs) := by
  induction as <;> simp_all!

theorem append_assoc' (as bs cs : List α) : append (append as bs) cs = append as (append bs cs) := by
  induction as <;> simp! [*]

def g : Nat → Nat
  | 0   => 1
  | n+1 => n + 2

example (a : Nat) : g a > 0 := by
  cases a <;> simp_arith!

example (a : Nat) : g a > 0 := by
  cases a <;> simp_arith!

example (a : Nat) : g a > 0 := by
  cases a <;> simp_arith! [-g]
  simp_arith!

example (a : Nat) (h : b + 2 = 2) : g a > b := by
  cases a <;> simp_all_arith!

example (a : Nat) (h : b + 2 = 2) : g a > b := by
  cases a <;> simp_all_arith! [-g]
  simp_arith!


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.metric_space.lipschitz
import topology.uniform_space.complete_separated

/-!
# Antilipschitz functions

We say that a map `f : α → β` between two (extended) metric spaces is
`antilipschitz_with K`, `K ≥ 0`, if for all `x, y` we have `edist x y ≤ K * edist (f x) (f y)`.
For a metric space, the latter inequality is equivalent to `dist x y ≤ K * dist (f x) (f y)`.

## Implementation notes

The parameter `K` has type `ℝ≥0`. This way we avoid conjuction in the definition and have
coercions both to `ℝ` and `ℝ≥0∞`. We do not require `0 < K` in the definition, mostly because
we do not have a `posreal` type.
-/

variables {α : Type*} {β : Type*} {γ : Type*}

open_locale nnreal ennreal uniformity
open set filter bornology

/-- We say that `f : α → β` is `antilipschitz_with K` if for any two points `x`, `y` we have
`K * edist x y ≤ edist (f x) (f y)`. -/
def antilipschitz_with [pseudo_emetric_space α] [pseudo_emetric_space β] (K : ℝ≥0) (f : α → β) :=
∀ x y, edist x y ≤ K * edist (f x) (f y)

lemma antilipschitz_with.edist_lt_top [pseudo_emetric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {f : α → β} (h : antilipschitz_with K f) (x y : α) : edist x y < ⊤ :=
(h x y).trans_lt $ ennreal.mul_lt_top ennreal.coe_ne_top (edist_ne_top _ _)

lemma antilipschitz_with.edist_ne_top [pseudo_emetric_space α] [pseudo_metric_space β] {K : ℝ≥0}
  {f : α → β} (h : antilipschitz_with K f) (x y : α) : edist x y ≠ ⊤ :=
(h.edist_lt_top x y).ne

section metric

variables [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0} {f : α → β}

lemma antilipschitz_with_iff_le_mul_nndist :
  antilipschitz_with K f ↔ ∀ x y, nndist x y ≤ K * nndist (f x) (f y) :=
by { simp only [antilipschitz_with, edist_nndist], norm_cast }

alias antilipschitz_with_iff_le_mul_nndist ↔ antilipschitz_with.le_mul_nndist
  antilipschitz_with.of_le_mul_nndist

lemma antilipschitz_with_iff_le_mul_dist :
  antilipschitz_with K f ↔ ∀ x y, dist x y ≤ K * dist (f x) (f y) :=
by { simp only [antilipschitz_with_iff_le_mul_nndist, dist_nndist], norm_cast }

alias antilipschitz_with_iff_le_mul_dist ↔ antilipschitz_with.le_mul_dist
  antilipschitz_with.of_le_mul_dist

namespace antilipschitz_with

lemma mul_le_nndist (hf : antilipschitz_with K f) (x y : α) :
  K⁻¹ * nndist x y ≤ nndist (f x) (f y) :=
by simpa only [div_eq_inv_mul] using nnreal.div_le_of_le_mul' (hf.le_mul_nndist x y)

lemma mul_le_dist (hf : antilipschitz_with K f) (x y : α) :
  (K⁻¹ * dist x y : ℝ) ≤ dist (f x) (f y) :=
by exact_mod_cast hf.mul_le_nndist x y

end antilipschitz_with

end metric

namespace antilipschitz_with

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {K : ℝ≥0} {f : α → β}

open emetric

/-- Extract the constant from `hf : antilipschitz_with K f`. This is useful, e.g.,
if `K` is given by a long formula, and we want to reuse this value. -/
@[nolint unused_arguments] -- uses neither `f` nor `hf`
protected def K (hf : antilipschitz_with K f) : ℝ≥0 := K

protected lemma injective {α : Type*} {β : Type*} [emetric_space α] [pseudo_emetric_space β]
  {K : ℝ≥0} {f : α → β} (hf : antilipschitz_with K f) : function.injective f :=
λ x y h, by simpa only [h, edist_self, mul_zero, edist_le_zero] using hf x y

lemma mul_le_edist (hf : antilipschitz_with K f) (x y : α) :
  (K⁻¹ * edist x y : ℝ≥0∞) ≤ edist (f x) (f y) :=
begin
  rw [mul_comm, ← div_eq_mul_inv],
  exact ennreal.div_le_of_le_mul' (hf x y)
end

lemma ediam_preimage_le (hf : antilipschitz_with K f) (s : set β) : diam (f ⁻¹' s) ≤ K * diam s :=
diam_le $ λ x hx y hy, (hf x y).trans $ mul_le_mul_left' (edist_le_diam_of_mem hx hy) K

lemma le_mul_ediam_image (hf : antilipschitz_with K f) (s : set α) : diam s ≤ K * diam (f '' s) :=
(diam_mono (subset_preimage_image _ _)).trans (hf.ediam_preimage_le (f '' s))

protected lemma id : antilipschitz_with 1 (id : α → α) :=
λ x y, by simp only [ennreal.coe_one, one_mul, id, le_refl]

lemma comp {Kg : ℝ≥0} {g : β → γ} (hg : antilipschitz_with Kg g)
  {Kf : ℝ≥0} {f : α → β} (hf : antilipschitz_with Kf f) :
  antilipschitz_with (Kf * Kg) (g ∘ f) :=
λ x y,
calc edist x y ≤ Kf * edist (f x) (f y) : hf x y
... ≤ Kf * (Kg * edist (g (f x)) (g (f y))) : ennreal.mul_left_mono (hg _ _)
... = _ : by rw [ennreal.coe_mul, mul_assoc]

lemma restrict (hf : antilipschitz_with K f) (s : set α) :
  antilipschitz_with K (s.restrict f) :=
λ x y, hf x y

lemma cod_restrict (hf : antilipschitz_with K f) {s : set β} (hs : ∀ x, f x ∈ s) :
  antilipschitz_with K (s.cod_restrict f hs) :=
λ x y, hf x y

lemma to_right_inv_on' {s : set α} (hf : antilipschitz_with K (s.restrict f))
  {g : β → α} {t : set β} (g_maps : maps_to g t s) (g_inv : right_inv_on g f t) :
  lipschitz_with K (t.restrict g) :=
λ x y, by simpa only [restrict_apply, g_inv x.mem, g_inv y.mem, subtype.edist_eq, subtype.coe_mk]
  using hf ⟨g x, g_maps x.mem⟩ ⟨g y, g_maps y.mem⟩

lemma to_right_inv_on (hf : antilipschitz_with K f) {g : β → α} {t : set β}
  (h : right_inv_on g f t) :
  lipschitz_with K (t.restrict g) :=
(hf.restrict univ).to_right_inv_on' (maps_to_univ g t) h

lemma to_right_inverse (hf : antilipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) :
  lipschitz_with K g :=
begin
  intros x y,
  have := hf (g x) (g y),
  rwa [hg x, hg y] at this
end

lemma comap_uniformity_le (hf : antilipschitz_with K f) :
  (𝓤 β).comap (prod.map f f) ≤ 𝓤 α :=
begin
  refine ((uniformity_basis_edist.comap _).le_basis_iff uniformity_basis_edist).2 (λ ε h₀, _),
  refine ⟨K⁻¹ * ε, ennreal.mul_pos (ennreal.inv_ne_zero.2 ennreal.coe_ne_top) h₀.ne', _⟩,
  refine λ x hx, (hf x.1 x.2).trans_lt _,
  rw [mul_comm, ← div_eq_mul_inv] at hx,
  rw mul_comm,
  exact ennreal.mul_lt_of_lt_div hx
end

protected lemma uniform_inducing (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  uniform_inducing f :=
⟨le_antisymm hf.comap_uniformity_le hfc.le_comap⟩

protected lemma uniform_embedding {α : Type*} {β : Type*} [emetric_space α] [pseudo_emetric_space β]
  {K : ℝ≥0} {f : α → β} (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  uniform_embedding f :=
⟨hf.uniform_inducing hfc, hf.injective⟩

lemma is_complete_range [complete_space α] (hf : antilipschitz_with K f)
  (hfc : uniform_continuous f) : is_complete (range f) :=
(hf.uniform_inducing hfc).is_complete_range

lemma is_closed_range {α β : Type*} [pseudo_emetric_space α] [emetric_space β] [complete_space α]
  {f : α → β} {K : ℝ≥0} (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  is_closed (range f) :=
(hf.is_complete_range hfc).is_closed

lemma closed_embedding {α : Type*} {β : Type*} [emetric_space α] [emetric_space β] {K : ℝ≥0}
  {f : α → β} [complete_space α] (hf : antilipschitz_with K f) (hfc : uniform_continuous f) :
  closed_embedding f :=
{ closed_range := hf.is_closed_range hfc,
  .. (hf.uniform_embedding hfc).embedding }

lemma subtype_coe (s : set α) : antilipschitz_with 1 (coe : s → α) :=
antilipschitz_with.id.restrict s

lemma of_subsingleton [subsingleton α] {K : ℝ≥0} : antilipschitz_with K f :=
λ x y, by simp only [subsingleton.elim x y, edist_self, zero_le]

/-- If `f : α → β` is `0`-antilipschitz, then `α` is a `subsingleton`. -/
protected lemma subsingleton {α β} [emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (h : antilipschitz_with 0 f) : subsingleton α :=
⟨λ x y, edist_le_zero.1 $ (h x y).trans_eq $ zero_mul _⟩

end antilipschitz_with

namespace antilipschitz_with

open metric

variables [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0} {f : α → β}

lemma bounded_preimage (hf : antilipschitz_with K f)
  {s : set β} (hs : bounded s) :
  bounded (f ⁻¹' s) :=
exists.intro (K * diam s) $ λ x hx y hy,
calc dist x y ≤ K * dist (f x) (f y) : hf.le_mul_dist x y
... ≤ K * diam s : mul_le_mul_of_nonneg_left (dist_le_diam_of_mem hs hx hy) K.2

lemma tendsto_cobounded (hf : antilipschitz_with K f) : tendsto f (cobounded α) (cobounded β) :=
compl_surjective.forall.2 $ λ s (hs : is_bounded s), metric.is_bounded_iff.2 $
  hf.bounded_preimage $ metric.is_bounded_iff.1 hs

/-- The image of a proper space under an expanding onto map is proper. -/
protected lemma proper_space {α : Type*} [metric_space α] {K : ℝ≥0} {f : α → β} [proper_space α]
  (hK : antilipschitz_with K f) (f_cont : continuous f) (hf : function.surjective f) :
  proper_space β :=
begin
  apply proper_space_of_compact_closed_ball_of_le 0 (λx₀ r hr, _),
  let K := f ⁻¹' (closed_ball x₀ r),
  have A : is_closed K := is_closed_ball.preimage f_cont,
  have B : bounded K := hK.bounded_preimage bounded_closed_ball,
  have : is_compact K := compact_iff_closed_bounded.2 ⟨A, B⟩,
  convert this.image f_cont,
  exact (hf.image_preimage _).symm
end

end antilipschitz_with

lemma lipschitz_with.to_right_inverse [pseudo_emetric_space α] [pseudo_emetric_space β] {K : ℝ≥0}
  {f : α → β} (hf : lipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) :
  antilipschitz_with K g :=
λ x y, by simpa only [hg _] using hf (g x) (g y)


import data.zmod.basic
import .normal_series

namespace nat

lemma pos_left_of_mul_pos {m n : ℕ} (h : 0 < m * n) : 0 < m :=
nat.pos_of_ne_zero $ λ h2, by simpa [h2] using h

lemma pos_right_of_mul_pos {m n : ℕ} (h : 0 < m * n) : 0 < n :=
by { rw mul_comm at h, exact pos_left_of_mul_pos h }

lemma prod_pos_of_cons {l : list ℕ} {n : ℕ} : 0 < (n :: l).prod → 0 < l.prod :=
λ h, by { rw list.prod_cons at h, exact pos_right_of_mul_pos h }

lemma modeq.modeq_mul_right'_iff {n a b c : ℕ} (hc : c ≠ 0) :
  a * c ≡ b * c [MOD n * c] ↔ a ≡ b [MOD n] :=
⟨λ h, begin
  rw modeq.modeq_iff_dvd at *,
  rcases h with ⟨q, hq⟩, use q,
  simp only [int.coe_nat_mul] at hq,
  rw [←sub_mul, mul_assoc, mul_comm ↑c, ←mul_assoc] at hq,
  have : (c : ℤ) ≠ 0 := by simp [hc],
  exact mul_right_cancel' this hq,
end, modeq.modeq_mul_right' c⟩

end nat

open list add_normal_embedding add_normal_series add_composition_series zmod nat

def normal_embedding_to_mul (l : list ℕ) (m : ℕ) (h : 0 < m * l.prod) :
  add_normal_embedding (zmod l.prod) (zmod (m :: l).prod) :=
have hl : 0 < l.prod := nat.pos_right_of_mul_pos h,
have hm : m ≠ 0 := ne_of_gt $ nat.pos_left_of_mul_pos h,
{ to_fun := λ x, ↑(x.val * m),
  map_zero' := by simp,
  map_add' := λ x y, begin
    rw [←nat.cast_add, ←add_mul, zmod.eq_iff_modeq_nat, prod_cons, mul_comm m],
    apply modeq.modeq_mul_right' m,
    rw [←zmod.eq_iff_modeq_nat, @zmod.val_add _ ⟨hl⟩, zmod.nat_cast_mod],
  end,
  inj := λ x y h1, begin
    rw [add_monoid_hom.coe_mk, eq_iff_modeq_nat, prod_cons, mul_comm m,
      modeq.modeq_mul_right'_iff hm, ←eq_iff_modeq_nat] at h1,
    simpa [@nat_cast_val _ _ _ ⟨hl⟩] using h1,
  end,
  norm := infer_instance }

def normal_series_of_factors : Π {l : list ℕ} (hl : 0 < l.prod),
  add_normal_series (AddGroup.of $ zmod l.prod)
| [] _ := add_normal_series.trivial (by { simp, apply_instance })
| (m::l) hl := add_normal_series.cons
  (AddGroup.of (zmod l.prod)) (AddGroup.of (zmod (m::l).prod))
  (normal_embedding_to_mul l m (by simpa using hl))
  (normal_series_of_factors (pos_right_of_mul_pos (by simpa using hl)))

local attribute [instance] classical.prop_decidable

lemma finite_factors : Π {l : list ℕ} (hl : l.prod > 0),
  ∀ G ∈ (normal_series_of_factors hl).factors, is_finite_add_class G
| [] _ := λ G hG, by { exfalso, simpa [normal_series_of_factors] using hG }
| (m::l) hl := λ G hG, begin
  simp [normal_series_of_factors] at hG, rcases hG with rfl | hG,
  { apply is_finite_add_class_mk', change fintype (quotient_add_group.quotient _),
    apply @quotient.fintype _ (@zmod.fintype _ ⟨hl⟩) },
  exact finite_factors (prod_pos_of_cons hl) _ hG,
end

lemma card_factors_of_normal_series_of_factors : Π {l : list ℕ} (hl : 0 < l.prod),
  (normal_series_of_factors hl).factors.pmap add_class_card (finite_factors hl)
  = quotient.mk' l
| [] _ := by { simp [normal_series_of_factors], refl }
| (m::l) hl := show _ = m ::ₘ quotient.mk' l, begin
  haveI : fact (0 < (m::l).prod) := ⟨hl⟩,
  simp [normal_series_of_factors, multiset.cons_eq_cons], left, split, swap,
  { exact card_factors_of_normal_series_of_factors (prod_pos_of_cons hl) },
  rw add_class_card_mk', simp only [AddGroup.coe_of], rw prod_cons at hl,
  have h := card_eq_card_quotient_mul_card_add_subgroup (normal_embedding_to_mul l m hl).φ.range,
  swap, { apply_instance }, rw zmod.card at h,
  suffices : fintype.card ↥((normal_embedding_to_mul l m hl).φ.range) = l.prod,
  { simp only [this, prod_cons, mul_eq_mul_right_iff] at h,
    cases h, { exact h.symm }, exact absurd h (ne_of_gt $ pos_right_of_mul_pos hl) },
  haveI : fact (0 < l.prod) := ⟨pos_right_of_mul_pos hl⟩,
  rw [←fintype.card_congr (normal_embedding_to_mul l m hl).equiv_range.to_equiv, zmod.card],
end

lemma card_factors {l : list ℕ} (hl : 0 < l.prod)
  {G : _} (hG : G ∈ (normal_series_of_factors hl).factors) :
  add_class_card G (finite_factors hl G hG) ∈ l :=
suffices h : add_class_card G (finite_factors hl G hG) ∈
  (normal_series_of_factors hl).factors.pmap add_class_card (finite_factors hl),
by { rw card_factors_of_normal_series_of_factors hl at h, exact h },
multiset.mem_pmap.mpr ⟨G, hG, rfl⟩

def composition_series_of_prime_factors {l : list ℕ} (h : ∀ p ∈ l, nat.prime p) :
  add_composition_series (AddGroup.of $ zmod l.prod) :=
have hl : 0 < l.prod := nat.pos_of_ne_zero $ prod_ne_zero (λ h0, nat.not_prime_zero $ h 0 h0),
⟨normal_series_of_factors hl, λ G hG,
  ⟨is_simple_add_class_of_prime_card (finite_factors hl _ hG) (h _ $ card_factors hl hG),
  not_is_trivial_add_class_of_prime_card (finite_factors hl _ hG) (h _ $ card_factors hl hG)⟩⟩

theorem eq_prime_factors {s t : list ℕ} (hs : ∀ p ∈ s, nat.prime p) (ht : ∀ p ∈ t, nat.prime p) :
  s.prod = t.prod → s ~ t :=
have hs' : 0 < s.prod := nat.pos_of_ne_zero $ prod_ne_zero (λ h0, nat.not_prime_zero $ hs 0 h0),
have ht' : 0 < t.prod := nat.pos_of_ne_zero $ prod_ne_zero (λ h0, nat.not_prime_zero $ ht 0 h0),
λ h, show setoid.r s t, begin
  rw [←quotient.eq', ←card_factors_of_normal_series_of_factors hs',
    ←card_factors_of_normal_series_of_factors ht'],
  let σ := composition_series_of_prime_factors hs,
  let τ := composition_series_of_prime_factors ht,
  conv in (normal_series_of_factors hs') { change σ.val },
  conv in (normal_series_of_factors ht') { change τ.val },
  haveI : fact (0 < s.prod) := ⟨hs'⟩,
  haveI : fact (0 < t.prod) := ⟨ht'⟩,
  have iso : (AddGroup.of (zmod t.prod)) ≃+ (AddGroup.of (zmod s.prod)) := by rw h,
  congr' 1, rw [←add_composition_series.factors_of_add_equiv iso τ, eq_factors],
end


import tactic

import data.nat.basic
import data.zmod.basic

example
  (a b c : zmod 5)
  (ha : a = 1)
  (hb : b = 3)
  (hc : c = 4) :
  (a^2 + (b + 2*c)^3) = 2 :=
begin
  rw [ha, hb, hc],
  ring,
end


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

! This file was ported from Lean 3 source module group_theory.group_action.sigma
! leanprover-community/mathlib commit f1a2caaf51ef593799107fe9a8d5e411599f3996
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.GroupAction.Defs

/-!
# Sigma instances for additive and multiplicative actions

This file defines instances for arbitrary sum of additive and multiplicative actions.

## See also

* `GroupTheory.GroupAction.Pi`
* `GroupTheory.GroupAction.Prod`
* `GroupTheory.GroupAction.Sum`
-/

variable {ι : Type _} {M N : Type _} {α : ι → Type _}

namespace Sigma

section SMul

variable [∀ i, SMul M (α i)] [∀ i, SMul N (α i)] (a : M) (i : ι) (b : α i) (x : Σi, α i)

@[to_additive Sigma.VAdd]
instance : SMul M (Σi, α i) :=
  ⟨fun a => (Sigma.map id) fun _ => (· • ·) a⟩

@[to_additive]
theorem smul_def : a • x = x.map id fun _ => (· • ·) a :=
  rfl
#align sigma.smul_def Sigma.smul_def
#align sigma.vadd_def Sigma.vadd_def

@[to_additive (attr := simp)]
theorem smul_mk : a • mk i b = ⟨i, a • b⟩ :=
  rfl
#align sigma.smul_mk Sigma.smul_mk
#align sigma.vadd_mk Sigma.vadd_mk

@[to_additive]
instance [SMul M N] [∀ i, IsScalarTower M N (α i)] : IsScalarTower M N (Σi, α i) :=
  ⟨fun a b x => by
    cases x
    rw [smul_mk, smul_mk, smul_mk, smul_assoc]⟩

@[to_additive]
instance [∀ i, SMulCommClass M N (α i)] : SMulCommClass M N (Σi, α i) :=
  ⟨fun a b x => by
    cases x
    rw [smul_mk, smul_mk, smul_mk, smul_mk, smul_comm]⟩

@[to_additive]
instance [∀ i, SMul Mᵐᵒᵖ (α i)] [∀ i, IsCentralScalar M (α i)] : IsCentralScalar M (Σi, α i) :=
  ⟨fun a x => by
    cases x
    rw [smul_mk, smul_mk, op_smul_eq_smul]⟩

/-- This is not an instance because `i` becomes a metavariable. -/
@[to_additive "This is not an instance because `i` becomes a metavariable."]
protected theorem FaithfulSMul' [FaithfulSMul M (α i)] : FaithfulSMul M (Σi, α i) :=
  ⟨fun h => eq_of_smul_eq_smul fun a : α i => heq_iff_eq.1 (ext_iff.1 <| h <| mk i a).2⟩
#align sigma.has_faithful_smul' Sigma.FaithfulSMul'
#align sigma.has_faithful_vadd' Sigma.FaithfulVAdd'

@[to_additive]
instance [Nonempty ι] [∀ i, FaithfulSMul M (α i)] : FaithfulSMul M (Σi, α i) :=
  (Nonempty.elim ‹_›) fun i => Sigma.FaithfulSMul' i

end SMul

@[to_additive]
instance {m : Monoid M} [∀ i, MulAction M (α i)] :
    MulAction M (Σi, α i) where
  mul_smul a b x := by
    cases x
    rw [smul_mk, smul_mk, smul_mk, mul_smul]
  one_smul x := by
    cases x
    rw [smul_mk, one_smul]

end Sigma


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_13
  (a b :ℝ)
  (h₀ : ∀ x, (x - 3 ≠ 0 ∧ x - 5 ≠ 0) → 4 * x / (x^2 - 8 * x + 15) = a / (x - 3) + b / (x - 5)) :
  a = -6 ∧ b = 10 :=
begin
  have h₁ := h₀ 1,
  have h := h₀ (1 / 2),
  norm_num [*, add_comm] at *,
  split,
  all_goals { field_simp at *; linarith },
end


import tactic

-- True or false? n = 3 ↔ n^2-2n-3=0. If you think it's false
-- then you'll have to modify the statement by putting it in brackets
-- and adding a ¬ in front of it.
lemma part_a : ∀ n : ℤ, n = 3 → n ^ 2 - 2 * n - 3 = 0 :=
begin
  norm_num,
end

lemma part_b : ¬ (∀ n : ℤ, n ^ 2 - 2 * n - 3 = 0 → n = 3) :=
begin
  intro h,
  specialize h(-1),
  norm_num at h,
end

lemma part_c : ¬ (∀ n : ℤ, n ^ 2 - 2 * n - 3 = 0 → n = 3) :=
begin
  intro h,
  specialize h(-1),
  norm_num at h,
end

lemma part_d : ¬ (∀ a b : ℤ, is_square (a * b) → is_square a ∧ is_square b) :=
begin
  intro h,
  specialize h (-1) (-1),
  norm_num at h,
  unfold is_square at h,
  cases h with m hm,
  nlinarith,
end

lemma part_e : ∀ a b : ℤ, (is_square a ∧ is_square b) → is_square (a * b) :=
begin
  intros a b h,
  unfold is_square at h,
  rcases h with ⟨⟨x, hx⟩,⟨y, hy⟩⟩,
  unfold is_square,
  use x*y,
  rw hx,
  rw hy,
  ring,
end


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

! This file was ported from Lean 3 source module topology.instances.int
! leanprover-community/mathlib commit f47581155c818e6361af4e4fda60d27d020c226b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Interval
import Mathbin.Topology.MetricSpace.Basic
import Mathbin.Order.Filter.Archimedean

/-!
# Topology on the integers

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

The structure of a metric space on `ℤ` is introduced in this file, induced from `ℝ`.
-/

noncomputable section

open Metric Set Filter

namespace Int

instance : Dist ℤ :=
  ⟨fun x y => dist (x : ℝ) y⟩

/- warning: int.dist_eq -> Int.dist_eq is a dubious translation:
lean 3 declaration is
  forall (x : Int) (y : Int), Eq.{1} Real (Dist.dist.{0} Int Int.hasDist x y) (Abs.abs.{0} Real (Neg.toHasAbs.{0} Real Real.hasNeg Real.hasSup) (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) y)))
but is expected to have type
  forall (x : Int) (y : Int), Eq.{1} Real (Dist.dist.{0} Int Int.instDistInt x y) (Abs.abs.{0} Real (Neg.toHasAbs.{0} Real Real.instNegReal Real.instSupReal) (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.instSubReal) (Int.cast.{0} Real Real.intCast x) (Int.cast.{0} Real Real.intCast y)))
Case conversion may be inaccurate. Consider using '#align int.dist_eq Int.dist_eqₓ'. -/
theorem dist_eq (x y : ℤ) : dist x y = |x - y| :=
  rfl
#align int.dist_eq Int.dist_eq

/- warning: int.dist_cast_real -> Int.dist_cast_real is a dubious translation:
lean 3 declaration is
  forall (x : Int) (y : Int), Eq.{1} Real (Dist.dist.{0} Real (PseudoMetricSpace.toHasDist.{0} Real Real.pseudoMetricSpace) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) y)) (Dist.dist.{0} Int Int.hasDist x y)
but is expected to have type
  forall (x : Int) (y : Int), Eq.{1} Real (Dist.dist.{0} Real (PseudoMetricSpace.toDist.{0} Real Real.pseudoMetricSpace) (Int.cast.{0} Real Real.intCast x) (Int.cast.{0} Real Real.intCast y)) (Dist.dist.{0} Int Int.instDistInt x y)
Case conversion may be inaccurate. Consider using '#align int.dist_cast_real Int.dist_cast_realₓ'. -/
@[norm_cast, simp]
theorem dist_cast_real (x y : ℤ) : dist (x : ℝ) y = dist x y :=
  rfl
#align int.dist_cast_real Int.dist_cast_real

/- warning: int.pairwise_one_le_dist -> Int.pairwise_one_le_dist is a dubious translation:
lean 3 declaration is
  Pairwise.{0} Int (fun (m : Int) (n : Int) => LE.le.{0} Real Real.hasLe (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) (Dist.dist.{0} Int Int.hasDist m n))
but is expected to have type
  Pairwise.{0} Int (fun (m : Int) (n : Int) => LE.le.{0} Real Real.instLEReal (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) (Dist.dist.{0} Int Int.instDistInt m n))
Case conversion may be inaccurate. Consider using '#align int.pairwise_one_le_dist Int.pairwise_one_le_distₓ'. -/
theorem pairwise_one_le_dist : Pairwise fun m n : ℤ => 1 ≤ dist m n :=
  by
  intro m n hne
  rw [dist_eq]; norm_cast; rwa [← zero_add (1 : ℤ), Int.add_one_le_iff, abs_pos, sub_ne_zero]
#align int.pairwise_one_le_dist Int.pairwise_one_le_dist

/- warning: int.uniform_embedding_coe_real -> Int.uniformEmbedding_coe_real is a dubious translation:
lean 3 declaration is
  UniformEmbedding.{0, 0} Int Real Int.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))))
but is expected to have type
  UniformEmbedding.{0, 0} Int Real instUniformSpaceInt (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) (Int.cast.{0} Real Real.intCast)
Case conversion may be inaccurate. Consider using '#align int.uniform_embedding_coe_real Int.uniformEmbedding_coe_realₓ'. -/
theorem uniformEmbedding_coe_real : UniformEmbedding (coe : ℤ → ℝ) :=
  uniformEmbedding_bot_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist
#align int.uniform_embedding_coe_real Int.uniformEmbedding_coe_real

/- warning: int.closed_embedding_coe_real -> Int.closedEmbedding_coe_real is a dubious translation:
lean 3 declaration is
  ClosedEmbedding.{0, 0} Int Real Int.topologicalSpace (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))))
but is expected to have type
  ClosedEmbedding.{0, 0} Int Real instTopologicalSpaceInt (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) (Int.cast.{0} Real Real.intCast)
Case conversion may be inaccurate. Consider using '#align int.closed_embedding_coe_real Int.closedEmbedding_coe_realₓ'. -/
theorem closedEmbedding_coe_real : ClosedEmbedding (coe : ℤ → ℝ) :=
  closedEmbedding_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist
#align int.closed_embedding_coe_real Int.closedEmbedding_coe_real

instance : MetricSpace ℤ :=
  Int.uniformEmbedding_coe_real.comapMetricSpace _

/- warning: int.preimage_ball -> Int.preimage_ball is a dubious translation:
lean 3 declaration is
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Set.preimage.{0, 0} Int Real ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast)))) (Metric.ball.{0} Real Real.pseudoMetricSpace ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) r)) (Metric.ball.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.metricSpace) x r)
but is expected to have type
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Set.preimage.{0, 0} Int Real (Int.cast.{0} Real Real.intCast) (Metric.ball.{0} Real Real.pseudoMetricSpace (Int.cast.{0} Real Real.intCast x) r)) (Metric.ball.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.instMetricSpaceInt) x r)
Case conversion may be inaccurate. Consider using '#align int.preimage_ball Int.preimage_ballₓ'. -/
theorem preimage_ball (x : ℤ) (r : ℝ) : coe ⁻¹' ball (x : ℝ) r = ball x r :=
  rfl
#align int.preimage_ball Int.preimage_ball

/- warning: int.preimage_closed_ball -> Int.preimage_closedBall is a dubious translation:
lean 3 declaration is
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Set.preimage.{0, 0} Int Real ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast)))) (Metric.closedBall.{0} Real Real.pseudoMetricSpace ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) r)) (Metric.closedBall.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.metricSpace) x r)
but is expected to have type
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Set.preimage.{0, 0} Int Real (Int.cast.{0} Real Real.intCast) (Metric.closedBall.{0} Real Real.pseudoMetricSpace (Int.cast.{0} Real Real.intCast x) r)) (Metric.closedBall.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.instMetricSpaceInt) x r)
Case conversion may be inaccurate. Consider using '#align int.preimage_closed_ball Int.preimage_closedBallₓ'. -/
theorem preimage_closedBall (x : ℤ) (r : ℝ) : coe ⁻¹' closedBall (x : ℝ) r = closedBall x r :=
  rfl
#align int.preimage_closed_ball Int.preimage_closedBall

/- warning: int.ball_eq_Ioo -> Int.ball_eq_Ioo is a dubious translation:
lean 3 declaration is
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Metric.ball.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.metricSpace) x r) (Set.Ioo.{0} Int (PartialOrder.toPreorder.{0} Int (OrderedAddCommGroup.toPartialOrder.{0} Int (StrictOrderedRing.toOrderedAddCommGroup.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))))) (Int.floor.{0} Real Real.linearOrderedRing Real.floorRing (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) r)) (Int.ceil.{0} Real Real.linearOrderedRing Real.floorRing (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.hasAdd) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) r)))
but is expected to have type
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Metric.ball.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.instMetricSpaceInt) x r) (Set.Ioo.{0} Int (PartialOrder.toPreorder.{0} Int (StrictOrderedRing.toPartialOrder.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing)))) (Int.floor.{0} Real Real.instLinearOrderedRingReal Real.instFloorRingRealInstLinearOrderedRingReal (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.instSubReal) (Int.cast.{0} Real Real.intCast x) r)) (Int.ceil.{0} Real Real.instLinearOrderedRingReal Real.instFloorRingRealInstLinearOrderedRingReal (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.instAddReal) (Int.cast.{0} Real Real.intCast x) r)))
Case conversion may be inaccurate. Consider using '#align int.ball_eq_Ioo Int.ball_eq_Iooₓ'. -/
theorem ball_eq_Ioo (x : ℤ) (r : ℝ) : ball x r = Ioo ⌊↑x - r⌋ ⌈↑x + r⌉ := by
  rw [← preimage_ball, Real.ball_eq_Ioo, preimage_Ioo]
#align int.ball_eq_Ioo Int.ball_eq_Ioo

/- warning: int.closed_ball_eq_Icc -> Int.closedBall_eq_Icc is a dubious translation:
lean 3 declaration is
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Metric.closedBall.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.metricSpace) x r) (Set.Icc.{0} Int (PartialOrder.toPreorder.{0} Int (OrderedAddCommGroup.toPartialOrder.{0} Int (StrictOrderedRing.toOrderedAddCommGroup.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))))) (Int.ceil.{0} Real Real.linearOrderedRing Real.floorRing (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) r)) (Int.floor.{0} Real Real.linearOrderedRing Real.floorRing (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.hasAdd) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) x) r)))
but is expected to have type
  forall (x : Int) (r : Real), Eq.{1} (Set.{0} Int) (Metric.closedBall.{0} Int (MetricSpace.toPseudoMetricSpace.{0} Int Int.instMetricSpaceInt) x r) (Set.Icc.{0} Int (PartialOrder.toPreorder.{0} Int (StrictOrderedRing.toPartialOrder.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing)))) (Int.ceil.{0} Real Real.instLinearOrderedRingReal Real.instFloorRingRealInstLinearOrderedRingReal (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.instSubReal) (Int.cast.{0} Real Real.intCast x) r)) (Int.floor.{0} Real Real.instLinearOrderedRingReal Real.instFloorRingRealInstLinearOrderedRingReal (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.instAddReal) (Int.cast.{0} Real Real.intCast x) r)))
Case conversion may be inaccurate. Consider using '#align int.closed_ball_eq_Icc Int.closedBall_eq_Iccₓ'. -/
theorem closedBall_eq_Icc (x : ℤ) (r : ℝ) : closedBall x r = Icc ⌈↑x - r⌉ ⌊↑x + r⌋ := by
  rw [← preimage_closed_ball, Real.closedBall_eq_Icc, preimage_Icc]
#align int.closed_ball_eq_Icc Int.closedBall_eq_Icc

instance : ProperSpace ℤ :=
  ⟨by
    intro x r
    rw [closed_ball_eq_Icc]
    exact (Set.finite_Icc _ _).IsCompact⟩

#print Int.cocompact_eq /-
@[simp]
theorem cocompact_eq : cocompact ℤ = atBot ⊔ atTop := by
  simp only [← comap_dist_right_atTop_eq_cocompact (0 : ℤ), dist_eq, sub_zero, cast_zero, ←
    cast_abs, ← @comap_comap _ _ _ _ abs, Int.comap_cast_atTop, comap_abs_at_top]
#align int.cocompact_eq Int.cocompact_eq
-/

/- warning: int.cofinite_eq -> Int.cofinite_eq is a dubious translation:
lean 3 declaration is
  Eq.{1} (Filter.{0} Int) (Filter.cofinite.{0} Int) (Sup.sup.{0} (Filter.{0} Int) (SemilatticeSup.toHasSup.{0} (Filter.{0} Int) (Lattice.toSemilatticeSup.{0} (Filter.{0} Int) (ConditionallyCompleteLattice.toLattice.{0} (Filter.{0} Int) (CompleteLattice.toConditionallyCompleteLattice.{0} (Filter.{0} Int) (Filter.completeLattice.{0} Int))))) (Filter.atBot.{0} Int (PartialOrder.toPreorder.{0} Int (OrderedAddCommGroup.toPartialOrder.{0} Int (StrictOrderedRing.toOrderedAddCommGroup.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing)))))) (Filter.atTop.{0} Int (PartialOrder.toPreorder.{0} Int (OrderedAddCommGroup.toPartialOrder.{0} Int (StrictOrderedRing.toOrderedAddCommGroup.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing)))))))
but is expected to have type
  Eq.{1} (Filter.{0} Int) (Filter.cofinite.{0} Int) (Sup.sup.{0} (Filter.{0} Int) (SemilatticeSup.toSup.{0} (Filter.{0} Int) (Lattice.toSemilatticeSup.{0} (Filter.{0} Int) (ConditionallyCompleteLattice.toLattice.{0} (Filter.{0} Int) (CompleteLattice.toConditionallyCompleteLattice.{0} (Filter.{0} Int) (Filter.instCompleteLatticeFilter.{0} Int))))) (Filter.atBot.{0} Int (PartialOrder.toPreorder.{0} Int (StrictOrderedRing.toPartialOrder.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))))) (Filter.atTop.{0} Int (PartialOrder.toPreorder.{0} Int (StrictOrderedRing.toPartialOrder.{0} Int (LinearOrderedRing.toStrictOrderedRing.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))))))
Case conversion may be inaccurate. Consider using '#align int.cofinite_eq Int.cofinite_eqₓ'. -/
@[simp]
theorem cofinite_eq : (cofinite : Filter ℤ) = atBot ⊔ atTop := by
  rw [← cocompact_eq_cofinite, cocompact_eq]
#align int.cofinite_eq Int.cofinite_eq

end Int


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

/-!

# 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⟩

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_nat_cast (truncated_witt_vector p n R) :=
⟨λ i, truncate_fun n i⟩

instance : has_int_cast (truncated_witt_vector p n R) :=
⟨λ i, truncate_fun n i⟩

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)⟩

instance has_nat_scalar : has_smul ℕ (truncated_witt_vector p n R) :=
⟨λ m x, truncate_fun n (m • x.out)⟩

instance has_int_scalar : has_smul ℤ (truncated_witt_vector p n R) :=
⟨λ m x, truncate_fun n (m • x.out)⟩

instance has_nat_pow : has_pow (truncated_witt_vector p n R) ℕ :=
⟨λ x m, truncate_fun n (x.out ^ m)⟩

@[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] }]

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, rw init_add }

@[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, rw init_mul }

lemma truncate_fun_neg (x : 𝕎 R) :
  truncate_fun n (-x) = -truncate_fun n x :=
by { witt_truncate_fun_tac, rw init_neg }

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, rw init_sub }

lemma truncate_fun_nsmul (x : 𝕎 R) (m : ℕ) :
  truncate_fun n (m • x) = m • truncate_fun n x :=
by { witt_truncate_fun_tac, rw init_nsmul }

lemma truncate_fun_zsmul (x : 𝕎 R) (m : ℤ) :
  truncate_fun n (m • x) = m • truncate_fun n x :=
by { witt_truncate_fun_tac, rw init_zsmul }

lemma truncate_fun_pow (x : 𝕎 R) (m : ℕ) :
  truncate_fun n (x ^ m) = truncate_fun n x ^ m :=
by { witt_truncate_fun_tac, rw init_pow }

lemma truncate_fun_nat_cast (m : ℕ) : truncate_fun n (m : 𝕎 R) = m := rfl

lemma truncate_fun_int_cast (m : ℤ) : truncate_fun n (m : 𝕎 R) = m := rfl

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)
  (truncate_fun_nsmul n)
  (truncate_fun_zsmul n)
  (truncate_fun_pow n)
  (truncate_fun_nat_cast n)
  (truncate_fun_int_cast 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`. -/
noncomputable! 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 fin.forall_iff
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