/-
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 data.int.modeq
import data.nat.multiplicity
import group_theory.order_of_element
import ring_theory.nilpotent

/-!
# Characteristic of semirings

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

universes u v

open finset
open_locale big_operators

variables {R : Type*}

namespace commute
variables [semiring R] {p : ℕ} {x y : R}

protected lemma add_pow_prime_pow_eq (hp : p.prime) (h : commute x y) (n : ℕ) :
  (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n +
    p * ∑ k in Ioo 0 (p ^ n), x ^ k * y ^ (p ^ n - k) * ↑((p ^ n).choose k / p) :=
begin
  transitivity
    x ^ p ^ n + y ^ p ^ n + ∑ k in Ioo 0 (p ^ n), x ^ k * y ^ (p ^ n - k) * (p ^ n).choose k,
  { simp_rw [h.add_pow, ←nat.Ico_zero_eq_range, nat.Ico_succ_right, Icc_eq_cons_Ico (zero_le _),
      finset.sum_cons, Ico_eq_cons_Ioo (pow_pos hp.pos _), finset.sum_cons, tsub_self, tsub_zero,
      pow_zero, nat.choose_zero_right, nat.choose_self, nat.cast_one, mul_one, one_mul,
      ←add_assoc] },
  { congr' 1,
    simp_rw [finset.mul_sum, nat.cast_comm, mul_assoc _ _ (p : R), ←nat.cast_mul],
    refine finset.sum_congr rfl (λ i hi, _),
    rw mem_Ioo at hi,
    rw nat.div_mul_cancel (hp.dvd_choose_pow hi.1.ne' hi.2.ne) },
end

protected lemma add_pow_prime_eq (hp : p.prime) (h : commute x y) :
  (x + y) ^ p = x ^ p + y ^ p +
    p * ∑ k in finset.Ioo 0 p, x ^ k * y ^ (p - k) * ↑(p.choose k / p) :=
by simpa using h.add_pow_prime_pow_eq hp 1

protected lemma exists_add_pow_prime_pow_eq (hp : p.prime) (h : commute x y) (n : ℕ) :
  ∃ r, (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n + p * r :=
⟨_, h.add_pow_prime_pow_eq hp n⟩

protected lemma exists_add_pow_prime_eq (hp : p.prime) (h : commute x y) :
  ∃ r, (x + y) ^ p = x ^ p + y ^ p + p * r :=
⟨_, h.add_pow_prime_eq hp⟩

end commute

section comm_semiring
variables [comm_semiring R] {p : ℕ} {x y : R}

lemma add_pow_prime_pow_eq (hp : p.prime) (x y : R) (n : ℕ) :
  (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n +
    p * ∑ k in finset.Ioo 0 (p ^ n), x ^ k * y ^ (p ^ n - k) * ↑((p ^ n).choose k / p) :=
(commute.all x y).add_pow_prime_pow_eq hp n

lemma add_pow_prime_eq (hp : p.prime) (x y : R) :
  (x + y) ^ p = x ^ p + y ^ p +
    p * ∑ k in finset.Ioo 0 p, x ^ k * y ^ (p - k) * ↑(p.choose k / p) :=
(commute.all x y).add_pow_prime_eq hp

lemma exists_add_pow_prime_pow_eq (hp : p.prime) (x y : R) (n : ℕ) :
  ∃ r, (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n + p * r :=
(commute.all x y).exists_add_pow_prime_pow_eq hp n

lemma exists_add_pow_prime_eq (hp : p.prime) (x y : R) :
  ∃ r, (x + y) ^ p = x ^ p + y ^ p + p * r :=
(commute.all x y).exists_add_pow_prime_eq hp

end comm_semiring

variables (R)

/-- 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.
This example is formalized in `counterexamples/char_p_zero_ne_char_zero`.
 -/
@[mk_iff]
class char_p [add_monoid_with_one R] (p : ℕ) : Prop :=
(cast_eq_zero_iff [] : ∀ x:ℕ, (x:R) = 0 ↔ p ∣ x)

@[simp]
theorem char_p.cast_eq_zero [add_monoid_with_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_with_one R] [fintype R] :
  (fintype.card R : R) = 0 :=
by rw [← nsmul_one, card_nsmul_eq_zero]

lemma char_p.add_order_of_one (R) [semiring R] : char_p R (add_order_of (1 : R)) :=
⟨λ n, by rw [← nat.smul_one_eq_coe, add_order_of_dvd_iff_nsmul_eq_zero]⟩

lemma char_p.int_cast_eq_zero_iff [add_group_with_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_with_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_with_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_with_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; simp⟩⟩⟩)
  (λ 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_with_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

@[simp]
lemma nat.cast_ring_char : (ring_char R : R) = 0 :=
by rw ring_char.spec

end ring_char

theorem add_pow_char_of_commute [semiring R] {p : ℕ} [hp : fact p.prime]
  [char_p R p] (x y : R) (h : commute x y) :
  (x + y)^p = x^p + y^p :=
let ⟨r, hr⟩ := h.exists_add_pow_prime_eq hp.out in by simp [hr]

theorem add_pow_char_pow_of_commute [semiring R] {p n : ℕ} [hp : fact p.prime] [char_p R p]
  (x y : R) (h : commute x y) :
  (x + y) ^ (p ^ n) = x ^ (p ^ n) + y ^ (p ^ n) :=
let ⟨r, hr⟩ := h.exists_add_pow_prime_pow_eq hp.out n in by simp [hr]

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 :=
by simp only [char_p_iff, ← f.injective.eq_iff, map_nat_cast f, f.map_zero]

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

/-- If `ring_char R = 2`, where `R` is a finite reduced commutative ring,
then every `a : R` is a square. -/
lemma is_square_of_char_two' {R : Type*} [finite R] [comm_ring R] [is_reduced R] [char_p R 2]
 (a : R) : is_square a :=
by { casesI nonempty_fintype R, exact exists_imp_exists (λ b h, pow_two b ▸ eq.symm h)
  (((fintype.bijective_iff_injective_and_card _).mpr ⟨frobenius_inj R 2, rfl⟩).surjective a) }

namespace char_p

section
variables [non_assoc_ring R]

lemma char_p_to_char_zero (R : Type*) [add_group_with_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]

/-- The characteristic of a finite ring cannot be zero. -/
theorem char_ne_zero_of_finite (p : ℕ) [char_p R p] [finite R] : p ≠ 0 :=
begin
  unfreezingI { rintro rfl },
  haveI : char_zero R := char_p_to_char_zero R,
  casesI nonempty_fintype R,
  exact absurd nat.cast_injective (not_injective_infinite_finite (coe : ℕ → R))
end

lemma ring_char_ne_zero_of_finite [finite R] : ring_char R ≠ 0 :=
char_ne_zero_of_finite R (ring_char R)

end

section comm_ring

variables [comm_ring R] [is_reduced R] {R}

@[simp]
lemma pow_prime_pow_mul_eq_one_iff (p k m : ℕ) [fact p.prime]
  [char_p R p] (x : R) :
  x ^ (p ^ k * m) = 1 ↔ x ^ m = 1 :=
begin
  induction k with k hk,
  { rw [pow_zero, one_mul] },
  { refine ⟨λ h, _, λ h, _⟩,
    { rw [pow_succ, mul_assoc, pow_mul', ← frobenius_def, ← frobenius_one p] at h,
      exact hk.1 (frobenius_inj R p h) },
    { rw [pow_mul', h, one_pow] } }
end

end comm_ring

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₀ : 0 < p, from two_pos.trans_le hp,
  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 (mul_right_cancel₀ h₀.ne' 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 : ℕ) [ne_zero p] [char_p R p] : fact p.prime :=
⟨(char_p.char_is_prime_or_zero R _).resolve_right $ ne_zero.ne p⟩

end nontrivial

end no_zero_divisors

end semiring

section ring

variables (R) [ring R] [no_zero_divisors R] [nontrivial R] [finite 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_finite 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

/-- We have `2 ≠ 0` in a nontrivial ring whose characteristic is not `2`. -/
@[protected]
lemma ring.two_ne_zero {R : Type*} [non_assoc_semiring R] [nontrivial R] (hR : ring_char R ≠ 2) :
  (2 : R) ≠ 0 :=
begin
  rw [ne.def, (by norm_cast : (2 : R) = (2 : ℕ)), ring_char.spec, nat.dvd_prime nat.prime_two],
  exact mt (or_iff_left hR).mp char_p.ring_char_ne_one,
end

/-- Characteristic `≠ 2` and nontrivial implies that `-1 ≠ 1`. -/
-- We have `char_p.neg_one_ne_one`, which assumes `[ring R] (p : ℕ) [char_p R p] [fact (2 < p)]`.
-- This is a version using `ring_char` instead.
lemma ring.neg_one_ne_one_of_char_ne_two {R : Type*} [non_assoc_ring R] [nontrivial R]
 (hR : ring_char R ≠ 2) :
  (-1 : R) ≠ 1 :=
λ h, ring.two_ne_zero hR (neg_eq_iff_add_eq_zero.mp h)

/-- Characteristic `≠ 2` in a domain implies that `-a = a` iff `a = 0`. -/
lemma ring.eq_self_iff_eq_zero_of_char_ne_two {R : Type*} [non_assoc_ring R] [nontrivial R]
 [no_zero_divisors R] (hR : ring_char R ≠ 2) {a : R} :
  -a = a ↔ a = 0 :=
⟨λ h, (mul_eq_zero.mp $ (two_mul a).trans $ neg_eq_iff_add_eq_zero.mp h).resolve_left
         (ring.two_ne_zero hR),
 λ h, ((congr_arg (λ x, - x) h).trans neg_zero).trans h.symm⟩

end

section

variables (R) [non_assoc_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 (R) [ring R] [fintype R] (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) [add_monoid_with_one R] [add_monoid_with_one 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

instance ulift.char_p [add_monoid_with_one R] (p : ℕ) [char_p R p] : char_p (ulift.{v} R) p :=
{ cast_eq_zero_iff := λ n, iff.trans (ulift.ext_iff _ _) $ char_p.cast_eq_zero_iff R p n }

instance mul_opposite.char_p [add_monoid_with_one R] (p : ℕ) [char_p R p] : char_p (Rᵐᵒᵖ) p :=
{ cast_eq_zero_iff := λ n, mul_opposite.unop_inj.symm.trans  $ char_p.cast_eq_zero_iff R p n }

section

/-- If two integers from `{0, 1, -1}` result in equal elements in a ring `R`
that is nontrivial and of characteristic not `2`, then they are equal. -/
lemma int.cast_inj_on_of_ring_char_ne_two {R : Type*} [non_assoc_ring R] [nontrivial R]
  (hR : ring_char R ≠ 2) :
  ({0, 1, -1} : set ℤ).inj_on (coe : ℤ → R) :=
begin
  intros a ha b hb h,
  apply eq_of_sub_eq_zero,
  by_contra hf,
  change a = 0 ∨ a = 1 ∨ a = -1 at ha,
  change b = 0 ∨ b = 1 ∨ b = -1 at hb,
  have hh : a - b = 1 ∨ b - a = 1 ∨ a - b = 2 ∨ b - a = 2 := by
  { rcases ha with ha | ha | ha; rcases hb with hb | hb | hb,
    swap 5, swap 9, -- move goals with `a = b` to the front
    iterate 3 { rw [ha, hb, sub_self] at hf, tauto, }, -- 6 goals remain
    all_goals { rw [ha, hb], norm_num, }, },
  have h' : ((a - b : ℤ) : R) = 0 := by exact_mod_cast sub_eq_zero_of_eq h,
  have h'' : ((b - a : ℤ) : R) = 0 := by exact_mod_cast sub_eq_zero_of_eq h.symm,
  rcases hh with hh | hh | hh | hh,
  { rw [hh, (by norm_cast : ((1 : ℤ) : R) = 1)] at h', exact one_ne_zero h', },
  { rw [hh, (by norm_cast : ((1 : ℤ) : R) = 1)] at h'', exact one_ne_zero h'', },
  { rw [hh, (by norm_cast : ((2 : ℤ) : R) = 2)] at h', exact ring.two_ne_zero hR h', },
  { rw [hh, (by norm_cast : ((2 : ℤ) : R) = 2)] at h'', exact ring.two_ne_zero hR h'', },
end

end

namespace ne_zero

variables (R) [add_monoid_with_one R] {r : R} {n p : ℕ} {a : ℕ+}

lemma of_not_dvd [char_p R p] (h : ¬ p ∣ n) : ne_zero (n : R) :=
⟨(char_p.cast_eq_zero_iff R p n).not.mpr h⟩

lemma not_char_dvd  (p : ℕ) [char_p R p] (k : ℕ) [h : ne_zero (k : R)] : ¬ p ∣ k :=
by rwa [←char_p.cast_eq_zero_iff R p k, ←ne.def, ←ne_zero_iff]

end ne_zero


open nat

inductive vector (A : Type) : nat → Type :=
| nil {} : vector A zero
| cons   : Π {n}, A → vector A n → vector A (succ n)

open vector

notation h :: t := cons h t

-- defining map with only recursors

definition head_aux {A : Type} {m n : nat} (v : vector A m) : (m = succ n) → A :=
  vector.cases_on v
    (assume H : 0 = succ n, nat.no_confusion H)
    (λ c a tv,
      (assume H : succ c = succ n, a))

definition head {A : Type} : Π {n}, vector A (succ n) → A :=
  (λ n v, head_aux v rfl)

definition tail_aux {A : Type} {n m : nat} (v : vector A m) :
      m = succ n → vector A n :=
  vector.cases_on v
    (assume H : 0 = succ n, nat.no_confusion H)
    (take m (a : A) w : vector A m,
      assume H : succ m = succ n,
      have H1 : m = n, from (nat.no_confusion H) (fun e : m = n, e),
      eq.rec_on H1 w)

definition tail {A : Type} {n : nat} (v : vector A (succ n)) : vector A n :=
  tail_aux v rfl

-- defining map without recursors
--  we can use head and tail (the tail example is already covered in the book,
--  so we only have to worry about head)
definition map {A B C : Type} (f : A → B → C)
    : Π {n : nat}, vector A n → vector B n → vector C n :=
  (λ n : nat,
    nat.rec (λ vecA vecB, nil)
      (λ n tf,
        (λ vecA vecB,
          have ele_a : A, from head vecA,
          have ele_b : B, from head vecB,
          have tl_a : vector A n, from tail vecA,
          have tl_b : vector B n, from tail vecB,
          f ele_a ele_b :: tf tl_a tl_b))
      n)


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

! This file was ported from Lean 3 source module number_theory.padics.padic_integers
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.Padics.PadicNumbers
import Mathbin.RingTheory.DiscreteValuationRing
import Mathbin.Topology.MetricSpace.CauSeqFilter

/-!
# p-adic integers

This file defines the `p`-adic integers `ℤ_[p]` as the subtype of `ℚ_[p]` with norm `≤ 1`.
We show that `ℤ_[p]`
* is complete,
* is nonarchimedean,
* is a normed ring,
* is a local ring, and
* is a discrete valuation ring.

The relation between `ℤ_[p]` and `zmod p` is established in another file.

## Important definitions

* `padic_int` : the type of `p`-adic integers

## Notation

We introduce the notation `ℤ_[p]` for the `p`-adic integers.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact p.prime]` as a type class argument.

Coercions into `ℤ_[p]` are set up to work with the `norm_cast` tactic.

## References

* [F. Q. Gouvêa, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, p-adic integer
-/

open Padic Metric LocalRing

noncomputable section

open Classical

/-- The `p`-adic integers `ℤ_[p]` are the `p`-adic numbers with norm `≤ 1`. -/
def PadicInt (p : ℕ) [Fact p.Prime] :=
  { x : ℚ_[p] // ‖x‖ ≤ 1 }
#align padic_int PadicInt

-- mathport name: «exprℤ_[ ]»
notation "ℤ_[" p "]" => PadicInt p

namespace PadicInt

/-! ### Ring structure and coercion to `ℚ_[p]` -/

variable {p : ℕ} [Fact p.Prime]

instance : Coe ℤ_[p] ℚ_[p] :=
  ⟨Subtype.val⟩

theorem ext {x y : ℤ_[p]} : (x : ℚ_[p]) = y → x = y :=
  Subtype.ext
#align padic_int.ext PadicInt.ext

variable (p)

/-- The `p`-adic integers as a subring of `ℚ_[p]`. -/
def subring : Subring ℚ_[p] where
  carrier := { x : ℚ_[p] | ‖x‖ ≤ 1 }
  zero_mem' := by norm_num
  one_mem' := by norm_num
  add_mem' x y hx hy := (padicNormE.nonarchimedean _ _).trans <| max_le_iff.2 ⟨hx, hy⟩
  mul_mem' x y hx hy := (padicNormE.mul _ _).trans_le <| mul_le_one hx (norm_nonneg _) hy
  neg_mem' x hx := (norm_neg _).trans_le hx
#align padic_int.subring PadicInt.subring

@[simp]
theorem mem_subring_iff {x : ℚ_[p]} : x ∈ subring p ↔ ‖x‖ ≤ 1 :=
  Iff.rfl
#align padic_int.mem_subring_iff PadicInt.mem_subring_iff

variable {p}

/-- Addition on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
instance : Add ℤ_[p] :=
  (by infer_instance : Add (subring p))

/-- Multiplication on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
instance : Mul ℤ_[p] :=
  (by infer_instance : Mul (subring p))

/-- Negation on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
instance : Neg ℤ_[p] :=
  (by infer_instance : Neg (subring p))

/-- Subtraction on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
instance : Sub ℤ_[p] :=
  (by infer_instance : Sub (subring p))

/-- Zero on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
instance : Zero ℤ_[p] :=
  (by infer_instance : Zero (subring p))

instance : Inhabited ℤ_[p] :=
  ⟨0⟩

/-- One on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
instance : One ℤ_[p] :=
  ⟨⟨1, by norm_num⟩⟩

@[simp]
theorem mk_zero {h} : (⟨0, h⟩ : ℤ_[p]) = (0 : ℤ_[p]) :=
  rfl
#align padic_int.mk_zero PadicInt.mk_zero

@[simp]
theorem val_eq_coe (z : ℤ_[p]) : z.val = z :=
  rfl
#align padic_int.val_eq_coe PadicInt.val_eq_coe

@[simp, norm_cast]
theorem coe_add (z1 z2 : ℤ_[p]) : ((z1 + z2 : ℤ_[p]) : ℚ_[p]) = z1 + z2 :=
  rfl
#align padic_int.coe_add PadicInt.coe_add

@[simp, norm_cast]
theorem coe_mul (z1 z2 : ℤ_[p]) : ((z1 * z2 : ℤ_[p]) : ℚ_[p]) = z1 * z2 :=
  rfl
#align padic_int.coe_mul PadicInt.coe_mul

@[simp, norm_cast]
theorem coe_neg (z1 : ℤ_[p]) : ((-z1 : ℤ_[p]) : ℚ_[p]) = -z1 :=
  rfl
#align padic_int.coe_neg PadicInt.coe_neg

@[simp, norm_cast]
theorem coe_sub (z1 z2 : ℤ_[p]) : ((z1 - z2 : ℤ_[p]) : ℚ_[p]) = z1 - z2 :=
  rfl
#align padic_int.coe_sub PadicInt.coe_sub

@[simp, norm_cast]
theorem coe_one : ((1 : ℤ_[p]) : ℚ_[p]) = 1 :=
  rfl
#align padic_int.coe_one PadicInt.coe_one

@[simp, norm_cast]
theorem coe_zero : ((0 : ℤ_[p]) : ℚ_[p]) = 0 :=
  rfl
#align padic_int.coe_zero PadicInt.coe_zero

theorem coe_eq_zero (z : ℤ_[p]) : (z : ℚ_[p]) = 0 ↔ z = 0 := by rw [← coe_zero, Subtype.coe_inj]
#align padic_int.coe_eq_zero PadicInt.coe_eq_zero

theorem coe_ne_zero (z : ℤ_[p]) : (z : ℚ_[p]) ≠ 0 ↔ z ≠ 0 :=
  z.val_eq_zero.Not
#align padic_int.coe_ne_zero PadicInt.coe_ne_zero

instance : AddCommGroup ℤ_[p] :=
  (by infer_instance : AddCommGroup (subring p))

instance : CommRing ℤ_[p] :=
  (by infer_instance : CommRing (subring p))

@[simp, norm_cast]
theorem coe_nat_cast (n : ℕ) : ((n : ℤ_[p]) : ℚ_[p]) = n :=
  rfl
#align padic_int.coe_nat_cast PadicInt.coe_nat_cast

@[simp, norm_cast]
theorem coe_int_cast (z : ℤ) : ((z : ℤ_[p]) : ℚ_[p]) = z :=
  rfl
#align padic_int.coe_int_cast PadicInt.coe_int_cast

/-- The coercion from `ℤ_[p]` to `ℚ_[p]` as a ring homomorphism. -/
def Coe.ringHom : ℤ_[p] →+* ℚ_[p] :=
  (subring p).Subtype
#align padic_int.coe.ring_hom PadicInt.Coe.ringHom

@[simp, norm_cast]
theorem coe_pow (x : ℤ_[p]) (n : ℕ) : (↑(x ^ n) : ℚ_[p]) = (↑x : ℚ_[p]) ^ n :=
  rfl
#align padic_int.coe_pow PadicInt.coe_pow

@[simp]
theorem mk_coe (k : ℤ_[p]) : (⟨k, k.2⟩ : ℤ_[p]) = k :=
  Subtype.coe_eta _ _
#align padic_int.mk_coe PadicInt.mk_coe

/-- The inverse of a `p`-adic integer with norm equal to `1` is also a `p`-adic integer.
Otherwise, the inverse is defined to be `0`. -/
def inv : ℤ_[p] → ℤ_[p]
  | ⟨k, _⟩ => if h : ‖k‖ = 1 then ⟨k⁻¹, by simp [h]⟩ else 0
#align padic_int.inv PadicInt.inv

instance : CharZero ℤ_[p]
    where cast_injective m n h :=
    Nat.cast_injective <|
      show (m : ℚ_[p]) = n by
        rw [Subtype.ext_iff] at h
        norm_cast  at h
        exact h

@[simp, norm_cast]
theorem coe_int_eq (z1 z2 : ℤ) : (z1 : ℤ_[p]) = z2 ↔ z1 = z2 :=
  by
  suffices (z1 : ℚ_[p]) = z2 ↔ z1 = z2 from Iff.trans (by norm_cast) this
  norm_cast
#align padic_int.coe_int_eq PadicInt.coe_int_eq

/-- A sequence of integers that is Cauchy with respect to the `p`-adic norm converges to a `p`-adic
integer. -/
def ofIntSeq (seq : ℕ → ℤ) (h : IsCauSeq (padicNorm p) fun n => seq n) : ℤ_[p] :=
  ⟨⟦⟨_, h⟩⟧,
    show ↑(PadicSeq.norm _) ≤ (1 : ℝ) by
      rw [PadicSeq.norm]
      split_ifs with hne <;> norm_cast
      · exact zero_le_one
      · apply padicNorm.of_int⟩
#align padic_int.of_int_seq PadicInt.ofIntSeq

end PadicInt

namespace PadicInt

/-! ### Instances

We now show that `ℤ_[p]` is a
* complete metric space
* normed ring
* integral domain
-/

variable (p : ℕ) [Fact p.Prime]

instance : MetricSpace ℤ_[p] :=
  Subtype.metricSpace

instance completeSpace : CompleteSpace ℤ_[p] :=
  have : IsClosed { x : ℚ_[p] | ‖x‖ ≤ 1 } := isClosed_le continuous_norm continuous_const
  this.completeSpace_coe
#align padic_int.complete_space PadicInt.completeSpace

instance : Norm ℤ_[p] :=
  ⟨fun z => ‖(z : ℚ_[p])‖⟩

variable {p}

theorem norm_def {z : ℤ_[p]} : ‖z‖ = ‖(z : ℚ_[p])‖ :=
  rfl
#align padic_int.norm_def PadicInt.norm_def

variable (p)

instance : NormedCommRing ℤ_[p] :=
  { PadicInt.commRing,
    PadicInt.metricSpace p with
    dist_eq := fun ⟨_, _⟩ ⟨_, _⟩ => rfl
    norm_mul := by simp [norm_def]
    norm := norm }

instance : NormOneClass ℤ_[p] :=
  ⟨norm_def.trans norm_one⟩

instance isAbsoluteValue : IsAbsoluteValue fun z : ℤ_[p] => ‖z‖
    where
  abv_nonneg := norm_nonneg
  abv_eq_zero := fun ⟨_, _⟩ => by simp [norm_eq_zero]
  abv_add := fun ⟨_, _⟩ ⟨_, _⟩ => norm_add_le _ _
  abv_mul _ _ := by simp only [norm_def, padicNormE.mul, PadicInt.coe_mul]
#align padic_int.is_absolute_value PadicInt.isAbsoluteValue

variable {p}

instance : IsDomain ℤ_[p] :=
  Function.Injective.isDomain (subring p).Subtype Subtype.coe_injective

end PadicInt

namespace PadicInt

/-! ### Norm -/

variable {p : ℕ} [Fact p.Prime]

theorem norm_le_one (z : ℤ_[p]) : ‖z‖ ≤ 1 :=
  z.2
#align padic_int.norm_le_one PadicInt.norm_le_one

@[simp]
theorem norm_mul (z1 z2 : ℤ_[p]) : ‖z1 * z2‖ = ‖z1‖ * ‖z2‖ := by simp [norm_def]
#align padic_int.norm_mul PadicInt.norm_mul

@[simp]
theorem norm_pow (z : ℤ_[p]) : ∀ n : ℕ, ‖z ^ n‖ = ‖z‖ ^ n
  | 0 => by simp
  | k + 1 => by
    rw [pow_succ, pow_succ, norm_mul]
    congr
    apply norm_pow
#align padic_int.norm_pow PadicInt.norm_pow

theorem nonarchimedean (q r : ℤ_[p]) : ‖q + r‖ ≤ max ‖q‖ ‖r‖ :=
  padicNormE.nonarchimedean _ _
#align padic_int.nonarchimedean PadicInt.nonarchimedean

theorem norm_add_eq_max_of_ne {q r : ℤ_[p]} : ‖q‖ ≠ ‖r‖ → ‖q + r‖ = max ‖q‖ ‖r‖ :=
  padicNormE.add_eq_max_of_ne
#align padic_int.norm_add_eq_max_of_ne PadicInt.norm_add_eq_max_of_ne

theorem norm_eq_of_norm_add_lt_right {z1 z2 : ℤ_[p]} (h : ‖z1 + z2‖ < ‖z2‖) : ‖z1‖ = ‖z2‖ :=
  by_contradiction fun hne =>
    not_lt_of_ge (by rw [norm_add_eq_max_of_ne hne] <;> apply le_max_right) h
#align padic_int.norm_eq_of_norm_add_lt_right PadicInt.norm_eq_of_norm_add_lt_right

theorem norm_eq_of_norm_add_lt_left {z1 z2 : ℤ_[p]} (h : ‖z1 + z2‖ < ‖z1‖) : ‖z1‖ = ‖z2‖ :=
  by_contradiction fun hne =>
    not_lt_of_ge (by rw [norm_add_eq_max_of_ne hne] <;> apply le_max_left) h
#align padic_int.norm_eq_of_norm_add_lt_left PadicInt.norm_eq_of_norm_add_lt_left

@[simp]
theorem padic_norm_e_of_padicInt (z : ℤ_[p]) : ‖(z : ℚ_[p])‖ = ‖z‖ := by simp [norm_def]
#align padic_int.padic_norm_e_of_padic_int PadicInt.padic_norm_e_of_padicInt

theorem norm_int_cast_eq_padic_norm (z : ℤ) : ‖(z : ℤ_[p])‖ = ‖(z : ℚ_[p])‖ := by simp [norm_def]
#align padic_int.norm_int_cast_eq_padic_norm PadicInt.norm_int_cast_eq_padic_norm

@[simp]
theorem norm_eq_padic_norm {q : ℚ_[p]} (hq : ‖q‖ ≤ 1) : @norm ℤ_[p] _ ⟨q, hq⟩ = ‖q‖ :=
  rfl
#align padic_int.norm_eq_padic_norm PadicInt.norm_eq_padic_norm

@[simp]
theorem norm_p : ‖(p : ℤ_[p])‖ = p⁻¹ :=
  padicNormE.norm_p
#align padic_int.norm_p PadicInt.norm_p

@[simp]
theorem norm_p_pow (n : ℕ) : ‖(p : ℤ_[p]) ^ n‖ = p ^ (-n : ℤ) :=
  padicNormE.norm_p_pow n
#align padic_int.norm_p_pow PadicInt.norm_p_pow

private def cau_seq_to_rat_cau_seq (f : CauSeq ℤ_[p] norm) : CauSeq ℚ_[p] fun a => ‖a‖ :=
  ⟨fun n => f n, fun _ hε => by simpa [norm, norm_def] using f.cauchy hε⟩
#align padic_int.cau_seq_to_rat_cau_seq padic_int.cau_seq_to_rat_cau_seq

variable (p)

instance complete : CauSeq.IsComplete ℤ_[p] norm :=
  ⟨fun f =>
    have hqn : ‖CauSeq.lim (cauSeqToRatCauSeq f)‖ ≤ 1 :=
      padic_norm_e_lim_le zero_lt_one fun _ => norm_le_one _
    ⟨⟨_, hqn⟩, fun ε => by
      simpa [norm, norm_def] using CauSeq.equiv_lim (cau_seq_to_rat_cau_seq f) ε⟩⟩
#align padic_int.complete PadicInt.complete

end PadicInt

namespace PadicInt

variable (p : ℕ) [hp : Fact p.Prime]

include hp

theorem exists_pow_neg_lt {ε : ℝ} (hε : 0 < ε) : ∃ k : ℕ, ↑p ^ (-(k : ℤ)) < ε :=
  by
  obtain ⟨k, hk⟩ := exists_nat_gt ε⁻¹
  use k
  rw [← inv_lt_inv hε (_root_.zpow_pos_of_pos _ _)]
  · rw [zpow_neg, inv_inv, zpow_ofNat]
    apply lt_of_lt_of_le hk
    norm_cast
    apply le_of_lt
    convert Nat.lt_pow_self _ _ using 1
    exact hp.1.one_lt
  · exact_mod_cast hp.1.Pos
#align padic_int.exists_pow_neg_lt PadicInt.exists_pow_neg_lt

theorem exists_pow_neg_lt_rat {ε : ℚ} (hε : 0 < ε) : ∃ k : ℕ, ↑p ^ (-(k : ℤ)) < ε :=
  by
  obtain ⟨k, hk⟩ := @exists_pow_neg_lt p _ ε (by exact_mod_cast hε)
  use k
  rw [show (p : ℝ) = (p : ℚ) by simp] at hk
  exact_mod_cast hk
#align padic_int.exists_pow_neg_lt_rat PadicInt.exists_pow_neg_lt_rat

variable {p}

theorem norm_int_lt_one_iff_dvd (k : ℤ) : ‖(k : ℤ_[p])‖ < 1 ↔ (p : ℤ) ∣ k :=
  suffices ‖(k : ℚ_[p])‖ < 1 ↔ ↑p ∣ k by rwa [norm_int_cast_eq_padic_norm]
  padicNormE.norm_int_lt_one_iff_dvd k
#align padic_int.norm_int_lt_one_iff_dvd PadicInt.norm_int_lt_one_iff_dvd

theorem norm_int_le_pow_iff_dvd {k : ℤ} {n : ℕ} : ‖(k : ℤ_[p])‖ ≤ p ^ (-n : ℤ) ↔ (p ^ n : ℤ) ∣ k :=
  suffices ‖(k : ℚ_[p])‖ ≤ p ^ (-n : ℤ) ↔ ↑(p ^ n) ∣ k by simpa [norm_int_cast_eq_padic_norm]
  padicNormE.norm_int_le_pow_iff_dvd _ _
#align padic_int.norm_int_le_pow_iff_dvd PadicInt.norm_int_le_pow_iff_dvd

/-! ### Valuation on `ℤ_[p]` -/

/-- `padic_int.valuation` lifts the `p`-adic valuation on `ℚ` to `ℤ_[p]`.  -/
def valuation (x : ℤ_[p]) :=
  Padic.valuation (x : ℚ_[p])
#align padic_int.valuation PadicInt.valuation

theorem norm_eq_pow_val {x : ℤ_[p]} (hx : x ≠ 0) : ‖x‖ = (p : ℝ) ^ (-x.Valuation) :=
  by
  convert Padic.norm_eq_pow_val _
  contrapose! hx
  exact Subtype.val_injective hx
#align padic_int.norm_eq_pow_val PadicInt.norm_eq_pow_val

@[simp]
theorem valuation_zero : valuation (0 : ℤ_[p]) = 0 :=
  Padic.valuation_zero
#align padic_int.valuation_zero PadicInt.valuation_zero

@[simp]
theorem valuation_one : valuation (1 : ℤ_[p]) = 0 :=
  Padic.valuation_one
#align padic_int.valuation_one PadicInt.valuation_one

@[simp]
theorem valuation_p : valuation (p : ℤ_[p]) = 1 := by simp [Valuation]
#align padic_int.valuation_p PadicInt.valuation_p

theorem valuation_nonneg (x : ℤ_[p]) : 0 ≤ x.Valuation :=
  by
  by_cases hx : x = 0
  · simp [hx]
  have h : (1 : ℝ) < p := by exact_mod_cast hp.1.one_lt
  rw [← neg_nonpos, ← (zpow_strictMono h).le_iff_le]
  show (p : ℝ) ^ (-Valuation x) ≤ p ^ (0 : ℤ)
  rw [← norm_eq_pow_val hx]
  simpa using x.property
#align padic_int.valuation_nonneg PadicInt.valuation_nonneg

@[simp]
theorem valuation_p_pow_mul (n : ℕ) (c : ℤ_[p]) (hc : c ≠ 0) :
    (↑p ^ n * c).Valuation = n + c.Valuation :=
  by
  have : ‖↑p ^ n * c‖ = ‖(p ^ n : ℤ_[p])‖ * ‖c‖ := norm_mul _ _
  have aux : ↑p ^ n * c ≠ 0 := by
    contrapose! hc
    rw [mul_eq_zero] at hc
    cases hc
    · refine' (hp.1.NeZero _).elim
      exact_mod_cast pow_eq_zero hc
    · exact hc
  rwa [norm_eq_pow_val aux, norm_p_pow, norm_eq_pow_val hc, ← zpow_add₀, ← neg_add, zpow_inj,
    neg_inj] at this
  · exact_mod_cast hp.1.Pos
  · exact_mod_cast hp.1.ne_one
  · exact_mod_cast hp.1.NeZero
#align padic_int.valuation_p_pow_mul PadicInt.valuation_p_pow_mul

section Units

/-! ### Units of `ℤ_[p]` -/

attribute [local reducible] PadicInt

theorem mul_inv : ∀ {z : ℤ_[p]}, ‖z‖ = 1 → z * z.inv = 1
  | ⟨k, _⟩, h =>
    by
    have hk : k ≠ 0 := fun h' => zero_ne_one' ℚ_[p] (by simpa [h'] using h)
    unfold PadicInt.inv
    rw [norm_eq_padic_norm] at h
    rw [dif_pos h]
    apply Subtype.ext_iff_val.2
    simp [mul_inv_cancel hk]
#align padic_int.mul_inv PadicInt.mul_inv

theorem inv_mul {z : ℤ_[p]} (hz : ‖z‖ = 1) : z.inv * z = 1 := by rw [mul_comm, mul_inv hz]
#align padic_int.inv_mul PadicInt.inv_mul

theorem isUnit_iff {z : ℤ_[p]} : IsUnit z ↔ ‖z‖ = 1 :=
  ⟨fun h => by
    rcases isUnit_iff_dvd_one.1 h with ⟨w, eq⟩
    refine' le_antisymm (norm_le_one _) _
    have := mul_le_mul_of_nonneg_left (norm_le_one w) (norm_nonneg z)
    rwa [mul_one, ← norm_mul, ← Eq, norm_one] at this, fun h =>
    ⟨⟨z, z.inv, mul_inv h, inv_mul h⟩, rfl⟩⟩
#align padic_int.is_unit_iff PadicInt.isUnit_iff

theorem norm_lt_one_add {z1 z2 : ℤ_[p]} (hz1 : ‖z1‖ < 1) (hz2 : ‖z2‖ < 1) : ‖z1 + z2‖ < 1 :=
  lt_of_le_of_lt (nonarchimedean _ _) (max_lt hz1 hz2)
#align padic_int.norm_lt_one_add PadicInt.norm_lt_one_add

theorem norm_lt_one_mul {z1 z2 : ℤ_[p]} (hz2 : ‖z2‖ < 1) : ‖z1 * z2‖ < 1 :=
  calc
    ‖z1 * z2‖ = ‖z1‖ * ‖z2‖ := by simp
    _ < 1 := mul_lt_one_of_nonneg_of_lt_one_right (norm_le_one _) (norm_nonneg _) hz2

#align padic_int.norm_lt_one_mul PadicInt.norm_lt_one_mul

@[simp]
theorem mem_nonunits {z : ℤ_[p]} : z ∈ nonunits ℤ_[p] ↔ ‖z‖ < 1 := by
  rw [lt_iff_le_and_ne] <;> simp [norm_le_one z, nonunits, is_unit_iff]
#align padic_int.mem_nonunits PadicInt.mem_nonunits

/-- A `p`-adic number `u` with `‖u‖ = 1` is a unit of `ℤ_[p]`. -/
def mkUnits {u : ℚ_[p]} (h : ‖u‖ = 1) : ℤ_[p]ˣ :=
  let z : ℤ_[p] := ⟨u, le_of_eq h⟩
  ⟨z, z.inv, mul_inv h, inv_mul h⟩
#align padic_int.mk_units PadicInt.mkUnits

@[simp]
theorem mkUnits_eq {u : ℚ_[p]} (h : ‖u‖ = 1) : ((mkUnits h : ℤ_[p]) : ℚ_[p]) = u :=
  rfl
#align padic_int.mk_units_eq PadicInt.mkUnits_eq

@[simp]
theorem norm_units (u : ℤ_[p]ˣ) : ‖(u : ℤ_[p])‖ = 1 :=
  isUnit_iff.mp <| by simp
#align padic_int.norm_units PadicInt.norm_units

/-- `unit_coeff hx` is the unit `u` in the unique representation `x = u * p ^ n`.
See `unit_coeff_spec`. -/
def unitCoeff {x : ℤ_[p]} (hx : x ≠ 0) : ℤ_[p]ˣ :=
  let u : ℚ_[p] := x * p ^ (-x.Valuation)
  have hu : ‖u‖ = 1 := by
    simp [hx, Nat.zpow_ne_zero_of_pos (by exact_mod_cast hp.1.Pos) x.valuation, norm_eq_pow_val,
      zpow_neg, inv_mul_cancel]
  mkUnits hu
#align padic_int.unit_coeff PadicInt.unitCoeff

@[simp]
theorem unitCoeff_coe {x : ℤ_[p]} (hx : x ≠ 0) : (unitCoeff hx : ℚ_[p]) = x * p ^ (-x.Valuation) :=
  rfl
#align padic_int.unit_coeff_coe PadicInt.unitCoeff_coe

theorem unitCoeff_spec {x : ℤ_[p]} (hx : x ≠ 0) :
    x = (unitCoeff hx : ℤ_[p]) * p ^ Int.natAbs (valuation x) :=
  by
  apply Subtype.coe_injective
  push_cast
  have repr : (x : ℚ_[p]) = unit_coeff hx * p ^ x.valuation :=
    by
    rw [unit_coeff_coe, mul_assoc, ← zpow_add₀]
    · simp
    · exact_mod_cast hp.1.NeZero
  convert repr using 2
  rw [← zpow_ofNat, Int.natAbs_of_nonneg (valuation_nonneg x)]
#align padic_int.unit_coeff_spec PadicInt.unitCoeff_spec

end Units

section NormLeIff

/-! ### Various characterizations of open unit balls -/

theorem norm_le_pow_iff_le_valuation (x : ℤ_[p]) (hx : x ≠ 0) (n : ℕ) :
    ‖x‖ ≤ p ^ (-n : ℤ) ↔ ↑n ≤ x.Valuation :=
  by
  rw [norm_eq_pow_val hx]
  lift x.valuation to ℕ using x.valuation_nonneg with k hk
  simp only [Int.ofNat_le, zpow_neg, zpow_ofNat]
  have aux : ∀ n : ℕ, 0 < (p ^ n : ℝ) := by
    apply pow_pos
    exact_mod_cast hp.1.Pos
  rw [inv_le_inv (aux _) (aux _)]
  have : p ^ n ≤ p ^ k ↔ n ≤ k := (pow_strictMono_right hp.1.one_lt).le_iff_le
  rw [← this]
  norm_cast
#align padic_int.norm_le_pow_iff_le_valuation PadicInt.norm_le_pow_iff_le_valuation

/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:132:4: warning: unsupported: rw with cfg: { occs := occurrences.pos[occurrences.pos] «expr[ ,]»([2]) } -/
theorem mem_span_pow_iff_le_valuation (x : ℤ_[p]) (hx : x ≠ 0) (n : ℕ) :
    x ∈ (Ideal.span {p ^ n} : Ideal ℤ_[p]) ↔ ↑n ≤ x.Valuation :=
  by
  rw [Ideal.mem_span_singleton]
  constructor
  · rintro ⟨c, rfl⟩
    suffices c ≠ 0 by
      rw [valuation_p_pow_mul _ _ this, le_add_iff_nonneg_right]
      apply valuation_nonneg
    contrapose! hx
    rw [hx, MulZeroClass.mul_zero]
  · rw [unit_coeff_spec hx]
    lift x.valuation to ℕ using x.valuation_nonneg with k hk
    simp only [Int.natAbs_ofNat, Units.isUnit, IsUnit.dvd_mul_left, Int.ofNat_le]
    intro H
    obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le H
    simp only [pow_add, dvd_mul_right]
#align padic_int.mem_span_pow_iff_le_valuation PadicInt.mem_span_pow_iff_le_valuation

theorem norm_le_pow_iff_mem_span_pow (x : ℤ_[p]) (n : ℕ) :
    ‖x‖ ≤ p ^ (-n : ℤ) ↔ x ∈ (Ideal.span {p ^ n} : Ideal ℤ_[p]) :=
  by
  by_cases hx : x = 0
  · subst hx
    simp only [norm_zero, zpow_neg, zpow_ofNat, inv_nonneg, iff_true_iff, Submodule.zero_mem]
    exact_mod_cast Nat.zero_le _
  rw [norm_le_pow_iff_le_valuation x hx, mem_span_pow_iff_le_valuation x hx]
#align padic_int.norm_le_pow_iff_mem_span_pow PadicInt.norm_le_pow_iff_mem_span_pow

theorem norm_le_pow_iff_norm_lt_pow_add_one (x : ℤ_[p]) (n : ℤ) : ‖x‖ ≤ p ^ n ↔ ‖x‖ < p ^ (n + 1) :=
  by rw [norm_def]; exact Padic.norm_le_pow_iff_norm_lt_pow_add_one _ _
#align padic_int.norm_le_pow_iff_norm_lt_pow_add_one PadicInt.norm_le_pow_iff_norm_lt_pow_add_one

theorem norm_lt_pow_iff_norm_le_pow_sub_one (x : ℤ_[p]) (n : ℤ) : ‖x‖ < p ^ n ↔ ‖x‖ ≤ p ^ (n - 1) :=
  by rw [norm_le_pow_iff_norm_lt_pow_add_one, sub_add_cancel]
#align padic_int.norm_lt_pow_iff_norm_le_pow_sub_one PadicInt.norm_lt_pow_iff_norm_le_pow_sub_one

theorem norm_lt_one_iff_dvd (x : ℤ_[p]) : ‖x‖ < 1 ↔ ↑p ∣ x :=
  by
  have := norm_le_pow_iff_mem_span_pow x 1
  rw [Ideal.mem_span_singleton, pow_one] at this
  rw [← this, norm_le_pow_iff_norm_lt_pow_add_one]
  simp only [zpow_zero, Int.ofNat_zero, Int.ofNat_succ, add_left_neg, zero_add]
#align padic_int.norm_lt_one_iff_dvd PadicInt.norm_lt_one_iff_dvd

@[simp]
theorem pow_p_dvd_int_iff (n : ℕ) (a : ℤ) : (p ^ n : ℤ_[p]) ∣ a ↔ ↑p ^ n ∣ a := by
  rw [← norm_int_le_pow_iff_dvd, norm_le_pow_iff_mem_span_pow, Ideal.mem_span_singleton]
#align padic_int.pow_p_dvd_int_iff PadicInt.pow_p_dvd_int_iff

end NormLeIff

section Dvr

/-! ### Discrete valuation ring -/

instance : LocalRing ℤ_[p] :=
  LocalRing.of_nonunits_add <| by simp only [mem_nonunits] <;> exact fun x y => norm_lt_one_add

theorem p_nonnunit : (p : ℤ_[p]) ∈ nonunits ℤ_[p] :=
  by
  have : (p : ℝ)⁻¹ < 1 := inv_lt_one <| by exact_mod_cast hp.1.one_lt
  simp [this]
#align padic_int.p_nonnunit PadicInt.p_nonnunit

theorem maximalIdeal_eq_span_p : maximalIdeal ℤ_[p] = Ideal.span {p} :=
  by
  apply le_antisymm
  · intro x hx
    simp only [LocalRing.mem_maximalIdeal, mem_nonunits] at hx
    rwa [Ideal.mem_span_singleton, ← norm_lt_one_iff_dvd]
  · rw [Ideal.span_le, Set.singleton_subset_iff]
    exact p_nonnunit
#align padic_int.maximal_ideal_eq_span_p PadicInt.maximalIdeal_eq_span_p

theorem prime_p : Prime (p : ℤ_[p]) :=
  by
  rw [← Ideal.span_singleton_prime, ← maximal_ideal_eq_span_p]
  · infer_instance
  · exact_mod_cast hp.1.NeZero
#align padic_int.prime_p PadicInt.prime_p

theorem irreducible_p : Irreducible (p : ℤ_[p]) :=
  Prime.irreducible prime_p
#align padic_int.irreducible_p PadicInt.irreducible_p

instance : DiscreteValuationRing ℤ_[p] :=
  DiscreteValuationRing.of_hasUnitMulPowIrreducibleFactorization
    ⟨p, irreducible_p, fun x hx =>
      ⟨x.Valuation.natAbs, unitCoeff hx, by rw [mul_comm, ← unit_coeff_spec hx]⟩⟩

theorem ideal_eq_span_pow_p {s : Ideal ℤ_[p]} (hs : s ≠ ⊥) : ∃ n : ℕ, s = Ideal.span {p ^ n} :=
  DiscreteValuationRing.ideal_eq_span_pow_irreducible hs irreducible_p
#align padic_int.ideal_eq_span_pow_p PadicInt.ideal_eq_span_pow_p

open CauSeq

instance : IsAdicComplete (maximalIdeal ℤ_[p]) ℤ_[p]
    where prec' x hx :=
    by
    simp only [← Ideal.one_eq_top, smul_eq_mul, mul_one, SModEq.sub_mem, maximal_ideal_eq_span_p,
      Ideal.span_singleton_pow, ← norm_le_pow_iff_mem_span_pow] at hx⊢
    let x' : CauSeq ℤ_[p] norm := ⟨x, _⟩; swap
    · intro ε hε
      obtain ⟨m, hm⟩ := exists_pow_neg_lt p hε
      refine' ⟨m, fun n hn => lt_of_le_of_lt _ hm⟩
      rw [← neg_sub, norm_neg]
      exact hx hn
    · refine' ⟨x'.lim, fun n => _⟩
      have : (0 : ℝ) < p ^ (-n : ℤ) := by
        apply zpow_pos_of_pos
        exact_mod_cast hp.1.Pos
      obtain ⟨i, hi⟩ := equiv_def₃ (equiv_lim x') this
      by_cases hin : i ≤ n
      · exact (hi i le_rfl n hin).le
      · push_neg  at hin
        specialize hi i le_rfl i le_rfl
        specialize hx hin.le
        have := nonarchimedean (x n - x i) (x i - x'.lim)
        rw [sub_add_sub_cancel] at this
        refine' this.trans (max_le_iff.mpr ⟨hx, hi.le⟩)

end Dvr

section FractionRing

instance algebra : Algebra ℤ_[p] ℚ_[p] :=
  Algebra.ofSubring (subring p)
#align padic_int.algebra PadicInt.algebra

@[simp]
theorem algebraMap_apply (x : ℤ_[p]) : algebraMap ℤ_[p] ℚ_[p] x = x :=
  rfl
#align padic_int.algebra_map_apply PadicInt.algebraMap_apply

instance isFractionRing : IsFractionRing ℤ_[p] ℚ_[p]
    where
  map_units := fun ⟨x, hx⟩ => by
    rwa [[anonymous], algebra_map_apply, isUnit_iff_ne_zero, PadicInt.coe_ne_zero, ←
      mem_nonZeroDivisors_iff_ne_zero]
  surj x := by
    by_cases hx : ‖x‖ ≤ 1
    · use (⟨x, hx⟩, 1)
      rw [Submonoid.coe_one, map_one, mul_one, PadicInt.algebraMap_apply, Subtype.coe_mk]
    · set n := Int.toNat (-x.valuation) with hn
      have hn_coe : (n : ℤ) = -x.valuation :=
        by
        rw [hn, Int.toNat_of_nonneg]
        rw [Right.nonneg_neg_iff]
        rw [Padic.norm_le_one_iff_val_nonneg, not_le] at hx
        exact hx.le
      set a := x * p ^ n with ha
      have ha_norm : ‖a‖ = 1 :=
        by
        have hx : x ≠ 0 := by
          intro h0
          rw [h0, norm_zero] at hx
          exact hx zero_le_one
        rw [ha, padicNormE.mul, padicNormE.norm_p_pow, Padic.norm_eq_pow_val hx, ← zpow_add',
          hn_coe, neg_neg, add_left_neg, zpow_zero]
        exact Or.inl (nat.cast_ne_zero.mpr (NeZero.ne p))
      use
        (⟨a, le_of_eq ha_norm⟩,
          ⟨(p ^ n : ℤ_[p]), mem_non_zero_divisors_iff_ne_zero.mpr (NeZero.ne _)⟩)
      simp only [[anonymous], map_pow, map_natCast, algebra_map_apply, PadicInt.coe_pow,
        PadicInt.coe_nat_cast, Subtype.coe_mk]
  eq_iff_exists x y :=
    by
    rw [algebra_map_apply, algebra_map_apply, Subtype.coe_inj]
    refine' ⟨fun h => ⟨1, by rw [h]⟩, _⟩
    rintro ⟨⟨c, hc⟩, h⟩
    exact (mul_eq_mul_left_iff.mp h).resolve_right (mem_non_zero_divisors_iff_ne_zero.mp hc)
#align padic_int.is_fraction_ring PadicInt.isFractionRing

end FractionRing

end PadicInt


import .rules
open psum nnf node

set_option eqn_compiler.zeta true

def tableau : Π Γ : list nnf, node Γ
| Γ :=
match get_contra Γ with
| inl w          := contra_rule w.2
| inr no_contra  :=
  match get_and Γ with
  | inl p :=
  let Δ := p.1.1 :: p.1.2 :: Γ.erase (nnf.and p.val.1 p.val.2) in
  let inst := and_instance.cons p.2 in
  have node_size ((p.val).fst :: (p.val).snd :: list.erase Γ (and ((p.val).fst) ((p.val).snd))) < node_size Γ,
    by apply split_lt_and; exact p.2,
  let d_delta : node Δ := tableau Δ in and_rule inst d_delta
  | inr no_and :=
    match get_or Γ with
    | inl p :=
    let Γ₁ := p.1.1 :: Γ.erase (nnf.or p.val.1 p.val.2) in
    let Γ₂ := p.1.2 :: Γ.erase (nnf.or p.val.1 p.val.2) in
    let inst := or_instance.cons p.2 in
    have node_size ((p.val).fst :: list.erase Γ (or ((p.val).fst) ((p.val).snd))) < node_size Γ,
      by apply split_lt_or_left; exact p.2,
    have node_size ((p.val).snd :: list.erase Γ (or ((p.val).fst) ((p.val).snd))) < node_size Γ,
      by apply split_lt_or_right; exact p.2,
    let d_Γ₁ : node (p.1.1 :: Γ.erase (or p.val.1 p.val.2)) := tableau Γ₁ in
    match d_Γ₁ with
    | closed m hsat pm := if hprcp : left_prcp inst ∈ m then
                          or_rule inst (closed m hsat pm) (tableau Γ₂)
                          else jump_rule inst m hsat pm hprcp
    | open_ w := open_rule inst w.2
    end
    | inr no_or :=
      match get_dia Γ with
      | inl p :=
      let ma : modal_applicable Γ :=
          {no_contra := no_contra,
           no_and := no_and,
           no_or := no_or,
           v := get_var Γ,
           hv := λ n, get_var_iff,
           φ := p.1,
           ex := p.2} in
      let l := @tmap (λ Δ, node_size Δ < node_size Γ)
               (λ x h, tableau x) (unmodal Γ)
               (unmodal_size Γ) in
      match l with
      | inl w := begin
                   left,
                   {exact unsat_of_unsat_unmodal ma w.1.1 ⟨w.2.1, w.2.2.1⟩},
                   swap, {exact mark_modal Γ w.1.1 w.1.2},
                   { exact modal_pmark ma w.1.1 w.1.2 ⟨w.2.1, w.2.2.1⟩ w.2.2.2 }
                 end
      | inr w := begin
                   right, split,
                   apply sat_of_batch_sat,
                   exact ma, exact w.2
                 end
      end
      | inr no_dia :=
      let mc : model_constructible Γ :=
          {no_contra := no_contra,
           no_and := no_and,
           no_or := no_or,
           v := get_var Γ,
           hv := λ n, get_var_iff,
           no_dia := no_dia} in
      by right; split; apply build_model; exact mc
      end
    end
  end
end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf node_size⟩]}

def is_sat (Γ : list nnf) : bool :=
match tableau Γ with
| closed _ _  _:= ff
| open_ _  := tt
end

theorem correctness (Γ : list nnf) : is_sat Γ = tt ↔ ∃ (st : Type) (k : kripke st) s, sat k s Γ :=
begin
  cases h : is_sat Γ,
  constructor,
  {intro, contradiction},
  {intro hsat, cases eq : tableau Γ,
   rcases hsat with ⟨w, k, s, hsat⟩,
   apply false.elim, apply a, exact hsat,
   {dsimp [is_sat] at h, rw eq at h, contradiction} },
  {split, intro, dsimp [is_sat] at h,
    cases eq : tableau Γ,
    { rw eq at h, contradiction },
  { split, split, split, exact a_1.2},
  { simp } }
end

/- The negation of the defining formula of K is unsatisfiable -/

def φ : nnf :=
and (box $ or (neg 1) (var 2)) (and (box $ var 1) (dia $ neg 2))

#eval is_sat [φ]

def ψ : nnf := and (box (var 1)) (dia (dia (neg 1)))

#eval is_sat [ψ]


import tactic
import data.set.finite

import topological_spaces

open set
open topological_space

class filter {X : Type} (F : set (set X)) :=
  ( inter  : ∀ {a b}, F a → F b → F (a ∩ b) )
  ( upward : ∀ {a b}, F a → a ⊆ b → F b )
  ( univ   : F univ )

inductive generated_filter {X : Type} (G : set (set X)) : set (set X)
| generator : ∀ g ∈ G, generated_filter g
| inter     : ∀ a b, generated_filter a → generated_filter b → generated_filter (a ∩ b)
| upward    : ∀ a b, generated_filter a → a ⊆ b → generated_filter b
| univ      : generated_filter univ

instance generated_filter_is_filter {X : Type} (G : set (set X)) : filter (generated_filter G) :=
{ inter  := generated_filter.inter,
  upward := generated_filter.upward,
  univ   := generated_filter.univ, }

def neighbourhoods {X : Type} [topological_space X] (x : X) :=
generated_filter {u : set X | is_open u ∧ x ∈ u}

instance neighbourhoods_filter {X : Type} [topological_space X] (x : X) : filter (neighbourhoods x) :=
generated_filter_is_filter {u : set X | is_open u ∧ x ∈ u}

lemma is_neighbourhood_iff {X : Type} [topological_space X] (x : X) {v : set X} :
v ∈ (neighbourhoods x) ↔ ∃ u, is_open u ∧ x ∈ u ∧ u ⊆ v :=
begin
  split,
  { intro hyp,
    induction hyp with g hg a b ha1 hb1 ha2 hb2 a b ha1 hb ha2,
    { use [g, hg.1, hg.2], },
    { rcases ha2 with ⟨ u1, hu1, hxu1, hu1a⟩,
      rcases hb2 with ⟨ u2, hu2, hxu2, hu2b⟩,
      use [u1 ∩ u2, inter hu1 hu2, hxu1, hxu2],
      intros x hx, exact ⟨hu1a hx.1, hu2b hx.2⟩, },
    { rcases ha2 with ⟨u, hu, hxu, hua⟩,
      use [u, hu, hxu, subset.trans hua hb], },
    { use [univ, univ_mem], simp, }, },
  { rintro ⟨u, hu, hxu, huv⟩,
    apply (neighbourhoods_filter x).upward,
    apply generated_filter.generator,
    exact ⟨hu, hxu⟩,
    exact huv, },
end

lemma is_open_iff {X : Type} [topological_space X] {u : set X} :
is_open u ↔ ∀ x ∈ u, u ∈ neighbourhoods x :=
begin
  split,
  { intro hyp,
    intros x hx,
    apply generated_filter.generator,
    exact ⟨hyp, hx⟩, },
  { intro hyp,
    have : ∀ x ∈ u, ∃ u', is_open u' ∧ x ∈ u' ∧ u' ⊆ u,
    { intros x hx,
      exact (is_neighbourhood_iff x).1 (hyp x hx), },
    choose φ hφ1 hφ2 hφ3 using this,
    have clef : u = ⋃₀ { (φ x hx) | (x : X) (hx : x ∈ u)},
    { apply subset.antisymm,
      { intros x hx,
        use [φ x hx, x, hx, hφ2 x hx], },
      { rintros x ⟨u', ⟨x', hx', hu'⟩, hx⟩,
        rw ← hu' at hx,
        exact (hφ3 x' hx') hx, }, },
    rw clef,
    apply union,
    rintros u' ⟨x, hx, hu'⟩,
    rw ← hu',
    exact hφ1 x hx, },
end


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

/-!
# Nilpotent Lie algebras

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

## Main definitions

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

## Tags

lie algebra, lower central series, nilpotent
-/

universes u v w w₁ w₂

namespace lie_module

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

/-- The lower central series of Lie submodules of a Lie module. -/
def lower_central_series (k : ℕ) : lie_submodule R L M := (λ I, ⁅(⊤ : lie_ideal R L), I⁆)^[k] ⊤

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

@[simp] lemma lower_central_series_succ (k : ℕ) :
  lower_central_series R L M (k + 1) = ⁅(⊤ : lie_ideal R L), lower_central_series R L M k⁆ :=
function.iterate_succ_apply' (λ I, ⁅(⊤ : lie_ideal R L), I⁆) k ⊤

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

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

open lie_algebra

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

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

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

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

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

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

end lie_module

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

section nilpotent_algebras

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

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

open lie_algebra

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

lemma lie_algebra.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent [is_nilpotent R L] :
  (⨅ (x : L), (ad R L x).maximal_generalized_eigenspace 0) = ⊤ :=
lie_module.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent R L L

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

variables {R L L'}

open lie_module (lower_central_series)

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

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

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

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

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

end nilpotent_algebras


/-
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 algebra.char_p.invertible
import data.fintype.big_operators
import data.mv_polynomial.variables
import data.mv_polynomial.comm_ring
import data.mv_polynomial.expand
import data.zmod.basic

/-!
# Witt polynomials

To endow `witt_vector p R` with a ring structure,
we need to study the so-called Witt polynomials.

Fix a base value `p : ℕ`.
The `p`-adic Witt polynomials are an infinite family of polynomials
indexed by a natural number `n`, taking values in an arbitrary ring `R`.
The variables of these polynomials are represented by natural numbers.
The variable set of the `n`th Witt polynomial contains at most `n+1` elements `{0, ..., n}`,
with exactly these variables when `R` has characteristic `0`.

These polynomials are used to define the addition and multiplication operators
on the type of Witt vectors. (While this type itself is not complicated,
the ring operations are what make it interesting.)

When the base `p` is invertible in `R`, the `p`-adic Witt polynomials
form a basis for `mv_polynomial ℕ R`, equivalent to the standard basis.

## Main declarations

* `witt_polynomial p R n`: the `n`-th Witt polynomial, viewed as polynomial over the ring `R`
* `X_in_terms_of_W p R n`: if `p` is invertible, the polynomial `X n` is contained in the subalgebra
  generated by the Witt polynomials. `X_in_terms_of_W p R n` is the explicit polynomial,
  which upon being bound to the Witt polynomials yields `X n`.
* `bind₁_witt_polynomial_X_in_terms_of_W`: the proof of the claim that
  `bind₁ (X_in_terms_of_W p R) (W_ R n) = X n`
* `bind₁_X_in_terms_of_W_witt_polynomial`: the converse of the above statement

## Notation

In this file we use the following notation

* `p` is a natural number, typically assumed to be prime.
* `R` and `S` are commutative rings
* `W n` (and `W_ R n` when the ring needs to be explicit) denotes the `n`th Witt polynomial

## References

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

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

open mv_polynomial
open finset (hiding map)
open finsupp (single)

open_locale big_operators

local attribute [-simp] coe_eval₂_hom

variables (p : ℕ)
variables (R : Type*) [comm_ring R]

/-- `witt_polynomial p R n` is the `n`-th Witt polynomial
with respect to a prime `p` with coefficients in a commutative ring `R`.
It is defined as:

`∑_{i ≤ n} p^i X_i^{p^{n-i}} ∈ R[X_0, X_1, X_2, …]`. -/
noncomputable def witt_polynomial (n : ℕ) : mv_polynomial ℕ R :=
∑ i in range (n+1), monomial (single i (p ^ (n - i))) (p ^ i : R)

lemma witt_polynomial_eq_sum_C_mul_X_pow (n : ℕ) :
  witt_polynomial p R n = ∑ i in range (n+1), C (p ^ i : R) * X i ^ (p ^ (n - i)) :=
begin
  apply sum_congr rfl,
  rintro i -,
  rw [monomial_eq, finsupp.prod_single_index],
  rw pow_zero,
end

/-! We set up notation locally to this file, to keep statements short and comprehensible.
This allows us to simply write `W n` or `W_ ℤ n`. -/

-- Notation with ring of coefficients explicit
localized "notation (name := witt_polynomial) `W_` := witt_polynomial p" in witt
-- Notation with ring of coefficients implicit
localized "notation (name := witt_polynomial.infer) `W` := witt_polynomial p hole!" in witt

open_locale witt
open mv_polynomial
/- The first observation is that the Witt polynomial doesn't really depend on the coefficient ring.
If we map the coefficients through a ring homomorphism, we obtain the corresponding Witt polynomial
over the target ring. -/
section
variables {R} {S : Type*} [comm_ring S]

@[simp] lemma map_witt_polynomial (f : R →+* S) (n : ℕ) :
  map f (W n) = W n :=
begin
  rw [witt_polynomial, ring_hom.map_sum, witt_polynomial, sum_congr rfl],
  intros i hi,
  rw [map_monomial, ring_hom.map_pow, map_nat_cast],
end

variables (R)

@[simp] lemma constant_coeff_witt_polynomial [hp : fact p.prime] (n : ℕ) :
  constant_coeff (witt_polynomial p R n) = 0 :=
begin
  simp only [witt_polynomial, ring_hom.map_sum, constant_coeff_monomial],
  rw [sum_eq_zero],
  rintro i hi,
  rw [if_neg],
  rw [finsupp.single_eq_zero],
  exact ne_of_gt (pow_pos hp.1.pos _)
end

@[simp] lemma witt_polynomial_zero : witt_polynomial p R 0 = X 0 :=
by simp only [witt_polynomial, X, sum_singleton, range_one, pow_zero]

@[simp] lemma witt_polynomial_one : witt_polynomial p R 1 = C ↑p * X 1 + (X 0) ^ p :=
by simp only [witt_polynomial_eq_sum_C_mul_X_pow, sum_range_succ_comm, range_one,
    sum_singleton, one_mul, pow_one, C_1, pow_zero]

lemma aeval_witt_polynomial {A : Type*} [comm_ring A] [algebra R A] (f : ℕ → A) (n : ℕ) :
  aeval f (W_ R n) = ∑ i in range (n+1), p^i * (f i) ^ (p ^ (n-i)) :=
by simp [witt_polynomial, alg_hom.map_sum, aeval_monomial, finsupp.prod_single_index]

/--
Over the ring `zmod (p^(n+1))`, we produce the `n+1`st Witt polynomial
by expanding the `n`th Witt polynomial by `p`.
-/
@[simp] lemma witt_polynomial_zmod_self (n : ℕ) :
  W_ (zmod (p ^ (n + 1))) (n + 1) = expand p (W_ (zmod (p^(n + 1))) n) :=
begin
  simp only [witt_polynomial_eq_sum_C_mul_X_pow],
  rw [sum_range_succ, ← nat.cast_pow, char_p.cast_eq_zero (zmod (p^(n+1))) (p^(n+1)), C_0, zero_mul,
      add_zero, alg_hom.map_sum, sum_congr rfl],
  intros k hk,
  rw [alg_hom.map_mul, alg_hom.map_pow, expand_X, alg_hom_C, ← pow_mul, ← pow_succ],
  congr,
  rw mem_range at hk,
  rw [add_comm, add_tsub_assoc_of_le (nat.lt_succ_iff.mp hk), ← add_comm],
end

section p_prime

variables [hp : ne_zero p]
include hp

lemma witt_polynomial_vars [char_zero R] (n : ℕ) :
  (witt_polynomial p R n).vars = range (n + 1) :=
begin
  have : ∀ i, (monomial (finsupp.single i (p ^ (n - i))) (p ^ i : R)).vars = {i},
  { intro i,
    refine vars_monomial_single i (pow_ne_zero _ hp.1) _,
    rw [← nat.cast_pow, nat.cast_ne_zero],
    exact pow_ne_zero i hp.1 },
  rw [witt_polynomial, vars_sum_of_disjoint],
  { simp only [this, bUnion_singleton_eq_self], },
  { simp only [this],
    intros a b h,
    apply disjoint_singleton_left.mpr,
    rwa mem_singleton, },
end

lemma witt_polynomial_vars_subset (n : ℕ) :
  (witt_polynomial p R n).vars ⊆ range (n + 1) :=
begin
  rw [← map_witt_polynomial p (int.cast_ring_hom R), ← witt_polynomial_vars p ℤ],
  apply vars_map,
end

end p_prime

end

/-!

## Witt polynomials as a basis of the polynomial algebra

If `p` is invertible in `R`, then the Witt polynomials form a basis
of the polynomial algebra `mv_polynomial ℕ R`.
The polynomials `X_in_terms_of_W` give the coordinate transformation in the backwards direction.
-/

/-- The `X_in_terms_of_W p R n` is the polynomial on the basis of Witt polynomials
that corresponds to the ordinary `X n`. -/
noncomputable def X_in_terms_of_W [invertible (p : R)] :
  ℕ → mv_polynomial ℕ R
| n := (X n - (∑ i : fin n,
  have _ := i.2, (C (p^(i : ℕ) : R) * (X_in_terms_of_W i)^(p^(n-i))))) * C (⅟p ^ n : R)

lemma X_in_terms_of_W_eq [invertible (p : R)] {n : ℕ} :
  X_in_terms_of_W p R n =
    (X n - (∑ i in range n, C (p^i : R) * X_in_terms_of_W p R i ^ p ^ (n - i))) * C (⅟p ^ n : R) :=
by { rw [X_in_terms_of_W, ← fin.sum_univ_eq_sum_range] }

@[simp] lemma constant_coeff_X_in_terms_of_W [hp : fact p.prime] [invertible (p : R)] (n : ℕ) :
  constant_coeff (X_in_terms_of_W p R n) = 0 :=
begin
  apply nat.strong_induction_on n; clear n,
  intros n IH,
  rw [X_in_terms_of_W_eq, mul_comm, ring_hom.map_mul, ring_hom.map_sub, ring_hom.map_sum,
    constant_coeff_C, sum_eq_zero],
  { simp only [constant_coeff_X, sub_zero, mul_zero] },
  { intros m H,
    rw mem_range at H,
    simp only [ring_hom.map_mul, ring_hom.map_pow, constant_coeff_C, IH m H],
    rw [zero_pow, mul_zero],
    apply pow_pos hp.1.pos, }
end

@[simp] lemma X_in_terms_of_W_zero [invertible (p : R)] :
  X_in_terms_of_W p R 0 = X 0 :=
by rw [X_in_terms_of_W_eq, range_zero, sum_empty, pow_zero, C_1, mul_one, sub_zero]

section p_prime
variables [hp : fact p.prime]
include hp

lemma X_in_terms_of_W_vars_aux (n : ℕ) :
  n ∈ (X_in_terms_of_W p ℚ n).vars ∧
  (X_in_terms_of_W p ℚ n).vars ⊆ range (n + 1) :=
begin
  apply nat.strong_induction_on n, clear n,
  intros n ih,
  rw [X_in_terms_of_W_eq, mul_comm, vars_C_mul, vars_sub_of_disjoint, vars_X, range_succ,
      insert_eq],
  swap 3, { apply nonzero_of_invertible },
  work_on_goal 1
  { simp only [true_and, true_or, eq_self_iff_true,
      mem_union, mem_singleton],
    intro i,
    rw [mem_union, mem_union],
    apply or.imp id },
  work_on_goal 2 { rw [vars_X, disjoint_singleton_left] },
  all_goals
  { intro H,
    replace H := vars_sum_subset _ _ H,
    rw mem_bUnion at H,
    rcases H with ⟨j, hj, H⟩,
    rw vars_C_mul at H,
    swap,
    { apply pow_ne_zero, exact_mod_cast hp.1.ne_zero },
    rw mem_range at hj,
    replace H := (ih j hj).2 (vars_pow _ _ H),
    rw mem_range at H },
  { rw mem_range,
    exact lt_of_lt_of_le H hj },
  { exact lt_irrefl n (lt_of_lt_of_le H hj) },
end

lemma X_in_terms_of_W_vars_subset (n : ℕ) :
  (X_in_terms_of_W p ℚ n).vars ⊆ range (n + 1) :=
(X_in_terms_of_W_vars_aux p n).2

end p_prime

lemma X_in_terms_of_W_aux [invertible (p : R)] (n : ℕ) :
  X_in_terms_of_W p R n * C (p^n : R) =
  X n - ∑ i in range n, C (p^i : R) * (X_in_terms_of_W p R i)^p^(n-i) :=
by rw [X_in_terms_of_W_eq, mul_assoc, ← C_mul, ← mul_pow, inv_of_mul_self, one_pow, C_1, mul_one]

@[simp] lemma bind₁_X_in_terms_of_W_witt_polynomial [invertible (p : R)] (k : ℕ) :
  bind₁ (X_in_terms_of_W p R) (W_ R k) = X k :=
begin
  rw [witt_polynomial_eq_sum_C_mul_X_pow, alg_hom.map_sum],
  simp only [alg_hom.map_pow, C_pow, alg_hom.map_mul, alg_hom_C],
  rw [sum_range_succ_comm, tsub_self, pow_zero, pow_one, bind₁_X_right,
      mul_comm, ← C_pow, X_in_terms_of_W_aux],
  simp only [C_pow, bind₁_X_right, sub_add_cancel],
end

@[simp] lemma bind₁_witt_polynomial_X_in_terms_of_W [invertible (p : R)] (n : ℕ) :
  bind₁ (W_ R) (X_in_terms_of_W p R n) = X n :=
begin
  apply nat.strong_induction_on n,
  clear n, intros n H,
  rw [X_in_terms_of_W_eq, alg_hom.map_mul, alg_hom.map_sub, bind₁_X_right, alg_hom_C,
      alg_hom.map_sum],
  have : W_ R n - ∑ i in range n, C (p ^ i : R) * (X i) ^ p ^ (n - i) = C (p ^ n : R) * X n,
  by simp only [witt_polynomial_eq_sum_C_mul_X_pow, tsub_self, sum_range_succ_comm,
    pow_one, add_sub_cancel, pow_zero],
  rw [sum_congr rfl, this],
  { -- this is really slow for some reason
    rw [mul_right_comm, ← C_mul, ← mul_pow, mul_inv_of_self, one_pow, C_1, one_mul] },
  { intros i h,
    rw mem_range at h,
    simp only [alg_hom.map_mul, alg_hom.map_pow, alg_hom_C, H i h] },
end


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

/-
Correctness lemmas for equality elimination.
See 5.5 of <http://www.decision-procedures.org/> for details.
-/

import tactic.omega.clause

open list.func

namespace omega

def symdiv (i j : int) : int :=
if (2 * (i % j)) < j
then i / j
else (i / j) + 1

def symmod (i j : int) : int :=
if (2 * (i % j)) < j
then i % j
else (i % j) - j

local attribute [semireducible] int.nonneg
lemma symmod_add_one_self {i : int} :
  0 < i → symmod i (i+1) = -1 :=
begin
  intro h1,
  unfold symmod,
  rw [int.mod_eq_of_lt (le_of_lt h1) (lt_add_one _), if_neg],
  simp only [add_comm, add_neg_cancel_left,
    neg_add_rev, sub_eq_add_neg],
  have h2 : 2 * i = (1 + 1) * i := rfl,
  simpa only [h2, add_mul, one_mul,
    add_lt_add_iff_left, not_lt] using h1
end

lemma mul_symdiv_eq {i j : int} :
j * (symdiv i j) = i - (symmod i j) :=
begin
  unfold symdiv, unfold symmod,
  by_cases h1 : (2 * (i % j)) < j,
  { repeat {rw if_pos h1},
    rw [int.mod_def, sub_sub_cancel] },
  { repeat {rw if_neg h1},
    rw [int.mod_def, sub_sub, sub_sub_cancel,
      mul_add, mul_one] }
end

lemma symmod_eq {i j : int} :
  symmod i j = i - j * (symdiv i j) :=
by rw [mul_symdiv_eq, sub_sub_cancel]

/-- (sgm v b as n) is the new value assigned to the nth variable
after a single step of equality elimination using valuation v,
term ⟨b, as⟩, and variable index n. If v satisfies the initial
constraint set, then (v ⟨n ↦ sgm v b as n⟩) satisfies the new
constraint set after equality elimination. -/
def sgm (v : nat → int) (b : int) (as : list int) (n : nat) :=
let a_n : int := get n as in
let m : int := a_n + 1 in
((symmod b m) + (coeffs.val v (as.map (λ x, symmod x m)))) / m

open_locale list.func

def rhs : nat → int → list int → term
| n b as :=
  let m := get n as + 1 in
  ⟨(symmod b m), (as.map (λ x, symmod x m)) {n ↦ -m}⟩

lemma rhs_correct_aux {v : nat → int} {m : int} {as : list int} :
∀ {k}, ∃ d, (m * d +
  coeffs.val_between v (as.map (λ (x : ℤ), symmod x m)) 0 k =
      coeffs.val_between v as 0 k)
| 0 :=
  begin
    existsi (0 : int),
    simp only [add_zero, mul_zero, coeffs.val_between]
  end
| (k+1) :=
  begin
    simp only [zero_add, coeffs.val_between, list.map],
    cases @rhs_correct_aux k with d h1, rw ← h1,
    by_cases hk : k < as.length,
    { rw [get_map hk, symmod_eq, sub_mul],
      existsi (d + (symdiv (get k as) m * v k)),
      ring },
    { rw not_lt at hk,
      repeat {rw get_eq_default_of_le},
      existsi d,
      rw add_assoc,
      exact hk,
      simp only [hk, list.length_map] }
  end

open_locale omega

lemma rhs_correct {v : nat → int}
  {b : int} {as : list int} (n : nat) :
  0 < get n as →
  0 = term.val v (b,as) →
  v n = term.val (v ⟨n ↦ sgm v b as n⟩) (rhs n b as) :=
begin
  intros h0 h1,
  let a_n := get n as,
  let m := a_n + 1,
  have h3 : m ≠ 0,
  { apply ne_of_gt, apply lt_trans h0, simp [a_n, m] },
  have h2 : m * (sgm v b as n) = (symmod b m) +
    coeffs.val v (as.map (λ x, symmod x m)),
  { simp only [sgm, mul_comm m],
    rw [int.div_mul_cancel],
    have h4 : ∃ c, m * c + (symmod b (get n as + 1) +
      coeffs.val v (as.map (λ (x : ℤ), symmod x m))) = term.val v (b,as),
    { have h5: ∃ d,  m * d +
        (coeffs.val v (as.map (λ x, symmod x m))) = coeffs.val v as,
      { simp only [coeffs.val, list.length_map], apply rhs_correct_aux },
      cases h5 with d h5, rw symmod_eq,
      existsi (symdiv b m + d),
      unfold term.val, rw ← h5,
      simp only [term.val, mul_add, add_mul, m, a_n],
      ring },
    cases h4 with c h4,
    rw [dvd_add_iff_right (dvd_mul_right m c), h4, ← h1],
    apply dvd_zero },
  apply calc v n
      = -(m * sgm v b as n) + (symmod b m) +
        (coeffs.val_except n v (as.map (λ x, symmod x m))) :
        begin
          rw [h2, ← coeffs.val_except_add_eq n],
          have hn : n < as.length,
          { by_contra hc, rw not_lt at hc,
            rw (get_eq_default_of_le n hc) at h0,
            cases h0 },
          rw get_map hn,
          simp only [a_n, m],
          rw [add_comm, symmod_add_one_self h0],
          ring
        end
  ... = term.val (v⟨n↦sgm v b as n⟩) (rhs n b as) :
        begin
          unfold rhs, unfold term.val,
          rw [← coeffs.val_except_add_eq n, get_set, update_eq],
          have h2 : ∀ a b c : int, a + b + c = b + (c + a) := by {intros, ring},
          rw (h2 (- _)),
          apply fun_mono_2 rfl,
          apply fun_mono_2,
          { rw coeffs.val_except_update_set },
          { simp only [m, a_n], ring }
        end
end

def sym_sym (m b : int) : int :=
symdiv b m + symmod b m

def coeffs_reduce : nat → int → list int → term
| n b as :=
  let a := get n as in
  let m := a + 1 in
  (sym_sym m b, (as.map (sym_sym m)) {n ↦ -a})

lemma coeffs_reduce_correct
  {v : nat → int} {b : int} {as : list int} {n : nat} :
  0 < get n as →
  0 = term.val v (b,as) →
  0 = term.val (v ⟨n ↦ sgm v b as n⟩) (coeffs_reduce n b as) :=
begin
  intros h1 h2,
  let a_n := get n as,
  let m := a_n + 1,
  have h3 : m ≠ 0,
  { apply ne_of_gt,
    apply lt_trans h1,
    simp only [m, lt_add_iff_pos_right] },
  have h4 : 0 = (term.val (v⟨n↦sgm v b as n⟩) (coeffs_reduce n b as)) * m :=
  calc  0
      = term.val v (b,as) : h2
  ... = b + coeffs.val_except n v as
          + a_n * ((rhs n b as).val (v⟨n ↦ sgm v b as n⟩)) :
        begin
          unfold term.val,
          rw [← coeffs.val_except_add_eq n, rhs_correct n h1 h2],
          simp only [a_n, add_assoc],
        end
  ... = -(m * a_n * sgm v b as n) + (b + a_n * (symmod b m)) +
        (coeffs.val_except n v as +
        a_n * coeffs.val_except n v (as.map (λ x, symmod x m))) :
          begin
            simp only [term.val, rhs, mul_add, m, a_n,
              add_assoc, add_right_inj, add_comm, add_left_comm],
            rw [← coeffs.val_except_add_eq n,
              get_set, update_eq, mul_add],
            apply fun_mono_2,
            { rw coeffs.val_except_eq_val_except
              update_eq_of_ne (get_set_eq_of_ne _) },
            ring,
          end
  ... = -(m * a_n * sgm v b as n) + (b + a_n * (symmod b m))
        + coeffs.val_except n v (as.map (λ a_i, a_i + a_n * (symmod a_i m))) :
        begin
          apply fun_mono_2 rfl,
          simp only [coeffs.val_except, mul_add],
          repeat {rw ← coeffs.val_between_map_mul},
          rw add_add_add_comm,
          have h5 : add as (list.map (has_mul.mul a_n)
            (list.map (λ (x : ℤ), symmod x (get n as + 1)) as)) =
            list.map (λ (a_i : ℤ), a_i + a_n * symmod a_i m) as,
          { rw [list.map_map, ←map_add_map],
            apply fun_mono_2,
            { have h5 : (λ x : int, x) = id,
              { rw function.funext_iff, intro x, refl },
              rw [h5, list.map_id] },
            { apply fun_mono_2 _ rfl,
              rw function.funext_iff, intro x,
              simp only [m] } },
          simp only [list.length_map],
          repeat { rw [← coeffs.val_between_add, h5] },
        end
  ... = -(m * a_n * sgm v b as n) + (m * sym_sym m b)
        + coeffs.val_except n v (as.map (λ a_i, m * sym_sym m a_i)) :
        begin
          repeat {rw add_assoc}, apply fun_mono_2, refl,
          rw ← add_assoc,
          have h4 : ∀ (x : ℤ), x + a_n * symmod x m = m * sym_sym m x,
          { intro x, have h5 : a_n = m - 1,
            { simp only [m],
              rw add_sub_cancel },
            rw [h5, sub_mul, one_mul, add_sub,
              add_comm, add_sub_assoc, ← mul_symdiv_eq],
            simp only [sym_sym, mul_add, add_comm] },
          apply fun_mono_2 (h4 _),
          apply coeffs.val_except_eq_val_except; intros x h5, refl,
          apply congr_arg,
          apply fun_mono_2 _ rfl,
          rw function.funext_iff,
          apply h4
        end
  ... = (-(a_n * sgm v b as n) + (sym_sym m b)
        + coeffs.val_except n v (as.map (sym_sym m))) * m :
        begin
          simp only [add_mul _ _ m],
          apply fun_mono_2, ring,
          simp only [coeffs.val_except, add_mul _ _ m],
          apply fun_mono_2,
          { rw [mul_comm _ m, ← coeffs.val_between_map_mul, list.map_map] },
          simp only [list.length_map, mul_comm _ m],
          rw [← coeffs.val_between_map_mul, list.map_map]
        end
  ... = (sym_sym m b + (coeffs.val_except n v (as.map (sym_sym m)) +
          (-a_n * sgm v b as n))) * m : by ring
  ... = (term.val (v ⟨n ↦ sgm v b as n⟩) (coeffs_reduce n b as)) * m :
        begin
          simp only [coeffs_reduce, term.val, m, a_n],
          rw [← coeffs.val_except_add_eq n,
            coeffs.val_except_update_set, get_set, update_eq]
        end,
  rw [← int.mul_div_cancel (term.val _ _) h3, ← h4, int.zero_div]
end

-- Requires : t1.coeffs[m] = 1
def cancel (m : nat) (t1 t2 : term) : term :=
term.add (t1.mul (-(get m (t2.snd)))) t2

def subst (n : nat) (t1 t2 : term) : term :=
term.add (t1.mul (get n t2.snd)) (t2.fst, t2.snd {n ↦ 0})

lemma subst_correct {v : nat → int} {b : int}
 {as : list int} {t : term} {n : nat} :
  0 < get n as → 0 = term.val v (b,as) →
  term.val v t = term.val (v ⟨n ↦ sgm v b as n⟩) (subst n (rhs n b as) t) :=
begin
  intros h1 h2,
  simp only [subst, term.val, term.val_add, term.val_mul],
  rw ← rhs_correct _ h1 h2,
  cases t with b' as',
  simp only [term.val],
  have h3 : coeffs.val (v ⟨n ↦ sgm v b as n⟩) (as' {n ↦ 0}) =
    coeffs.val_except n v as',
  { rw [← coeffs.val_except_add_eq n, get_set,
      zero_mul, add_zero, coeffs.val_except_update_set] },
  rw [h3, ← coeffs.val_except_add_eq n], ring
end

/-- The type of equality elimination rules. -/
@[derive has_reflect, derive inhabited]
inductive ee : Type
| drop   : ee
| nondiv : int → ee
| factor : int → ee
| neg    : ee
| reduce : nat → ee
| cancel : nat → ee

namespace ee

def repr : ee → string
| drop   := "↓"
| (nondiv i) := i.repr ++ "∤"
| (factor i) := "/" ++ i.repr
| neg    := "-"
| (reduce n) := "≻" ++ n.repr
| (cancel n) := "+" ++ n.repr

instance has_repr : has_repr ee := ⟨repr⟩

meta instance has_to_format : has_to_format ee := ⟨λ x, x.repr⟩

end ee

/-- Apply a given sequence of equality elimination steps to a clause. -/
def eq_elim : list ee → clause → clause
| []     ([], les)     := ([],les)
| []     ((_::_), les) := ([],[])
| (_::_) ([], les)     := ([],[])
| (ee.drop::es) ((eq::eqs), les) := eq_elim es (eqs, les)
| (ee.neg::es)  ((eq::eqs), les) := eq_elim es ((eq.neg::eqs), les)
| (ee.nondiv i::es) ((b,as)::eqs, les) :=
  if ¬(i ∣ b) ∧ (∀ x ∈ as, i ∣ x)
  then ([],[⟨-1,[]⟩])
  else ([],[])
| (ee.factor i::es) ((b,as)::eqs, les) :=
  if (i ∣ b) ∧ (∀ x ∈ as, i ∣ x)
  then eq_elim es ((term.div i (b,as)::eqs), les)
  else ([],[])
| (ee.reduce n::es) ((b,as)::eqs, les) :=
  if 0 < get n as
  then let eq' := coeffs_reduce n b as in
       let r := rhs n b as in
       let eqs' := eqs.map (subst n r) in
       let les' := les.map (subst n r) in
       eq_elim es ((eq'::eqs'), les')
  else ([],[])
| (ee.cancel m::es) ((eq::eqs), les)  :=
  eq_elim es ((eqs.map (cancel m eq)), (les.map (cancel m eq)))

open tactic

lemma sat_empty : clause.sat ([],[]) :=
⟨λ _,0, ⟨dec_trivial, dec_trivial⟩⟩

lemma sat_eq_elim :
  ∀ {es : list ee} {c : clause}, c.sat → (eq_elim es c).sat
| []     ([], les) h := h
| (e::_) ([], les) h :=
  by {cases e; simp only [eq_elim]; apply sat_empty}
| [] ((_::_), les) h := sat_empty
| (ee.drop::es) ((eq::eqs), les) h1 :=
  begin
    apply (@sat_eq_elim es _ _),
    rcases h1 with ⟨v,h1,h2⟩,
    refine ⟨v, list.forall_mem_of_forall_mem_cons h1, h2⟩
  end
| (ee.neg::es) ((eq::eqs), les) h1 :=
  begin
    simp only [eq_elim], apply sat_eq_elim,
    cases h1 with v h1,
    existsi v,
    cases h1 with hl hr,
    apply and.intro _ hr,
    rw list.forall_mem_cons at *,
    apply and.intro _ hl.right,
    rw term.val_neg,
    rw ← hl.left,
    refl
  end
| (ee.nondiv i::es) ((b,as)::eqs, les) h1 :=
  begin
    unfold eq_elim,
    by_cases h2 : (¬i ∣ b ∧ ∀ (x : ℤ), x ∈ as → i ∣ x),
    { exfalso, cases h1 with v h1,
      have h3 : 0 = b + coeffs.val v as := h1.left _ (or.inl rfl),
      have h4 : i ∣ coeffs.val v as     := coeffs.dvd_val h2.right,
      have h5 : i ∣ b + coeffs.val v as := by { rw ← h3, apply dvd_zero },
      rw ← dvd_add_iff_left h4 at h5, apply h2.left h5 },
    rw if_neg h2, apply sat_empty
  end
| (ee.factor i::es) ((b,as)::eqs, les) h1 :=
  begin
    simp only [eq_elim],
    by_cases h2 : (i ∣ b) ∧ (∀ x ∈ as, i ∣ x),
    { rw if_pos h2, apply sat_eq_elim, cases h1 with v h1,
      existsi v, cases h1 with h3 h4, apply and.intro _ h4,
      rw list.forall_mem_cons at *, cases h3 with h5 h6,
      apply and.intro _ h6,
      rw [term.val_div h2.left h2.right, ← h5, int.zero_div] },
    { rw if_neg h2, apply sat_empty }
  end
| (ee.reduce n::es) ((b,as)::eqs, les) h1 :=
  begin
    simp only [eq_elim],
    by_cases h2 : 0 < get n as,
    tactic.rotate 1,
    { rw if_neg h2, apply sat_empty },
    rw if_pos h2,
    apply sat_eq_elim,
    cases h1 with v h1,
    existsi v ⟨n ↦ sgm v b as n⟩,
    cases h1 with h1 h3,
    rw list.forall_mem_cons at h1,
    cases h1 with h4 h5,
    constructor,
    { rw list.forall_mem_cons,
      constructor,
      { apply coeffs_reduce_correct h2 h4 },
      { intros x h6, rw list.mem_map at h6,
        cases h6 with t h6, cases h6 with h6 h7,
        rw [← h7, ← subst_correct h2 h4], apply h5 _ h6 } },
    { intros x h6, rw list.mem_map at h6,
      cases h6 with t h6, cases h6 with h6 h7,
      rw [← h7, ← subst_correct h2 h4], apply h3 _ h6 }
   end
| (ee.cancel m::es) ((eq::eqs), les) h1 :=
  begin
    unfold eq_elim,
    apply sat_eq_elim,
    cases h1 with v h1,
    existsi v,
    cases h1 with h1 h2,
    rw list.forall_mem_cons at h1, cases h1 with h1 h3,
    constructor; intros t h4; rw list.mem_map at h4;
    rcases h4 with ⟨s,h4,h5⟩; rw ← h5;
    simp only [term.val_add, term.val_mul, cancel];
    rw [← h1, mul_zero, zero_add],
    { apply h3 _ h4 },
    { apply h2 _ h4 }
  end

/-- If the result of equality elimination is unsatisfiable, the original clause is unsatisfiable. -/
lemma unsat_of_unsat_eq_elim (ee : list ee) (c : clause) :
  (eq_elim ee c).unsat → c.unsat :=
by {intros h1 h2, apply h1, apply sat_eq_elim h2}

end omega


import challenge_notations
import challenge_prerequisites

/-!

This file discusses `p`-Banach spaces and their associated condensed abelian groups.

-/

noncomputable theory

open_locale liquid_tensor_experiment nnreal zero_object
open liquid_tensor_experiment category_theory category_theory.limits opposite

/-! Let `p` be a nonnegative real, `V` a `p`-Banach space, and `S` a profinite set. -/
variables (p : ℝ≥0) (V : pBanach.{0} p) (S : Profinite.{0})

section pBanach

/-! The `p`-Banach space `V` is a complete and separated topological `ℝ`-vector space. -/
example : topological_add_group V := infer_instance
example : module ℝ V := infer_instance
example : has_continuous_smul ℝ V := infer_instance
example : complete_space V := infer_instance
example : separated_space V := infer_instance

/--
We may *choose* a norm on the `p`-Banach space satisfying some properties
which will be discussed below.

NOTE: This is really a *choice* that must be made, and we make this choice only within
the present section.
-/
def pBanach.has_norm : has_norm V :=
(p_banach.exists_p_norm V.p_banach').some.to_has_norm

/-! We tell the typeclass system to use the norm chosen above. -/
local attribute [instance] pBanach.has_norm

/-! The chosen norm on `V` scales via the rule `∥rv∥ = |r|^p * ∥v∥`. -/
example (r : ℝ) (v : V) : ∥r • v∥ = |r|^(p : ℝ) * ∥v∥ :=
(p_banach.exists_p_norm V.p_banach').some.norm_smul r v

/-! The chosen norm on `V` satisfies the triangle inequality. -/
example (v w : V) : ∥v + w∥ ≤ ∥v∥ + ∥w∥ :=
(p_banach.exists_p_norm V.p_banach').some.triangle v w

/-! The uniform space structure on `V` is induced by the chosen norm. -/
example : uniformity V = ⨅ (ε : ℝ) (H : ε > 0),
  filter.principal { p : V × V | ∥p.1 - p.2∥ < ε } :=
(p_banach.exists_p_norm V.p_banach').some.uniformity

end pBanach

section Condensed
/-!
When `V` is viewed as condensed abelian group, the sections
over `S` are the continuous maps `S → V`.
For technical reasons related to size issues in topos theory,
we need to lift the space of continuous maps to a higher universe using `ulift.{1}`.
-/
example : (Γ_ S V : Type 1) = ulift.{1} C(S,V) := rfl

/-!
The group operation on `Γ_ S V` is pointwise addition, as expected.
-/
example (f g : Γ_ S V) (s : S) : (f + g) s = f s + g s := rfl

end Condensed

section lp

/-!
An example of a p-Banach space: `ℓ^p(ℕ)`.
-/
example [fact (0 < p)] [fact (p ≤ 1)] : pBanach p :=
pBanach.lp p

/-!
Elements of `pBanach.lp p` can be considered as functions `ℕ → ℝ`.
-/
example [fact (0 < p)] [fact (p ≤ 1)] (f : pBanach.lp p) : ℕ → ℝ :=
λ i, f i

/-!
Given an element of `pBanach.lp p`, the infinite sum `∑' n, | f n |^p` exists.
-/
example [fact (0 < p)] [fact (p ≤ 1)] (f : pBanach.lp p) :
  summable (λ n, | f n |^(p : ℝ)) :=
pBanach.lp_type.summable f

/-!
The ℝ-module structure behaves as expected.
-/
example [fact (0 < p)] [fact (p ≤ 1)] (f g : pBanach.lp p) (n : ℕ) :
  (f + g) n = f n + g n :=
rfl

example [fact (0 < p)] [fact (p ≤ 1)] (a : ℝ) (f : pBanach.lp p) (n : ℕ) :
  (a • f) n = a * f n :=
rfl

/-!
Conversely, we can construct elements of `pBanach.lp p` using sequences
where the sum above exists.
-/
example [fact (0 < p)] [fact (p ≤ 1)] (f : ℕ → ℝ) (hf : summable (λ n, | f n |^(p : ℝ))) :
  pBanach.lp p :=
{ val := f,
  property := begin
    change ite _ _ _,
    rw if_neg, rw if_neg, assumption,
    exact ennreal.coe_ne_top,
    exact (ne_of_gt $ by exact_mod_cast (fact.out (0 < p))),
  end }

/-!
`pBanach.lp p` is nontrivial.
-/
example [fact (0 < p)] [fact (p ≤ 1)] : nontrivial (pBanach.lp p) :=
infer_instance

end lp


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.algebra.basic
import Mathlib.algebra.module.ordered
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Ordered algebras

An ordered algebra is an ordered semiring, which is an algebra over an ordered commutative semiring,
for which scalar multiplication is "compatible" with the two orders.

The prototypical example is 2x2 matrices over the reals or complexes (or indeed any C^* algebra)
where the ordering the one determined by the positive cone of positive operators,
i.e. `A ≤ B` iff `B - A = star R * R` for some `R`.
(We don't yet have this example in mathlib.)

## Implementation

Because the axioms for an ordered algebra are exactly the same as those for the underlying
module being ordered, we don't actually introduce a new class, but just use the `ordered_semimodule`
mixin.

## Tags

ordered algebra
-/

theorem algebra_map_monotone {R : Type u_1} {A : Type u_2} [ordered_comm_ring R] [ordered_ring A]
    [algebra R A] [ordered_semimodule R A] : monotone ⇑(algebra_map R A) :=
  sorry

protected instance linear_ordered_comm_ring.to_ordered_semimodule {R : Type u_1}
    [linear_ordered_comm_ring R] : ordered_semimodule R R :=
  ordered_semimodule.mk ordered_semiring.mul_lt_mul_of_pos_left
    fun (a b c : R) (w₁ : c • a < c • b) (w₂ : 0 < c) => iff.mp (mul_lt_mul_left w₂) w₁

end Mathlib


import number_theory.arithmetic_function
import algebra.squarefree
import algebra.order.floor
import data.list.intervals
import tactic
import measure_theory.integral.interval_integral
import general
import defs
import lemmas_on_defs

noncomputable theory
open nat finset function filter nat.arithmetic_function
open_locale topological_space interval big_operators filter asymptotics arithmetic_function

namespace squarefree_sums

def arithmetic_function.from_pred {p : ℕ → Prop} [decidable_pred p] (hp : ¬p 0) :
arithmetic_function ℕ :=
⟨(λ (n : ℕ), ite (p n) (1 : ℕ) 0), by simp only [hp, if_false]⟩

lemma is_multiplicative_ssqrt {a b : ℕ} (hab : a.coprime b) : ssqrt (a * b) = (ssqrt a) * (ssqrt b) :=
begin
  by_cases ha : square a,
  {
    by_cases hb : square b,
    {
      have : square (a * b), exact prod_squares_square ha hb,
      unfold ssqrt,
      simp [ha, hb, this],
      cases ha with a' ha',
      cases hb with b' hb',
      rw pow_two at ha',
      rw pow_two at hb',
      rw [ha', hb'],
      rw [sqrt_eq, sqrt_eq],
      have : a' * a' * (b' * b') = (a' * b') * (a' * b'), ring,
      rw this,
      rw sqrt_eq,
    },
    {
      have : ¬square (a * b), exact coprime_prod_not_squares_is_not_square' hab hb,
      unfold ssqrt,
      simp [ha, hb, this],
    },
  },
  {
    have : ¬square (a * b), exact coprime_prod_not_squares_is_not_square hab ha,
    unfold ssqrt,
    simp [ha, this],
  },
end

lemma blah {α : Sort*} {a b : α} : a = b ↔ b = a := ⟨(λ h, h.symm), (λ h, h.symm)⟩

lemma square_iff_sqrt_mul_sqrt_eq {m : ℕ} : square m ↔ (sqrt m) * (sqrt m) = m :=
begin
  rw ←pow_two,
  convert m.exists_mul_self',
  conv { to_rhs, congr, funext, rw blah, },
  refl,
end

lemma square_iff_ssqrt_mul_ssqrt_eq {m : ℕ} : square m ↔ (ssqrt m) * (ssqrt m) = m :=
begin
  split,
  { intros h,
    simp only [ssqrt, h, if_true],
    exact square_iff_sqrt_mul_sqrt_eq.mp h, },
  { contrapose!,
    intros h,
    simp only [ssqrt, h, if_false, mul_zero],
    intros h',
    rw ←h' at h,
    exact h square_zero, },
end

lemma sqrt_dvd_of_square {m : ℕ} : square m → (sqrt m ∣ m) :=
begin
  intros hm,
  rw [←square_iff_sqrt_mul_sqrt_eq.mp hm, sqrt_eq],
  exact dvd_mul_left _ _,
end

lemma ssqrt_dvd_of_square {m : ℕ} : square m → (ssqrt m ∣ m) :=
begin
  intros hm,
  simp only [ssqrt, hm, if_true],
  exact sqrt_dvd_of_square hm,
end

lemma is_multiplicative_sμ : arithmetic_function.is_multiplicative sμ :=
begin
  -- This proof doesn't quite work out as neatly as other multiplicative proofs because
  -- while moebius is multiplicative and ssqrt is multiplicative, it is _not_ true that
  -- (ssqrt m).coprime (ssqrt n) in general. Indeed, if m and n are both not squares,
  -- then this will be false (`not_coprime_zero_zero`).
  rw is_multiplicative.iff_ne_zero,
  split,
  { simp only [sμ, sμ', zero_hom.coe_mk, ssqrt_one, is_multiplicative_moebius.left], },
  { intros m n hm hn hmn,
    simp only [sμ, sμ', zero_hom.coe_mk],
    by_cases hm_square : square m,
    { by_cases hn_square : square n,
      { rw [← is_multiplicative_moebius.right, ←is_multiplicative_ssqrt hmn],
        refine nat.coprime.coprime_dvd_left (ssqrt_dvd_of_square hm_square) _,
        exact nat.coprime.coprime_dvd_right (ssqrt_dvd_of_square hn_square) hmn, },
      { have : ¬ (square m ∧ square n), simp only [hn_square, and_false, not_false_iff],
        simp [ssqrt, if_false, hn_square, (square_mul hmn).not.mpr this], }, },
    { have : ¬ (square m ∧ square n), simp only [hm_square, false_and, not_false_iff],
      simp [ssqrt, if_false, hm_square, (square_mul hmn).not.mpr this], }, },
end

lemma is_multiplicative_tμ : arithmetic_function.is_multiplicative tμ :=
begin
  unfold tμ,
  apply is_multiplicative_sμ.mul,
  simp [is_multiplicative_zeta, is_multiplicative.nat_cast],
end

lemma is_multiplicative_squarefree_nat : arithmetic_function.is_multiplicative squarefree_nat :=
begin
  rw arithmetic_function.is_multiplicative.iff_ne_zero,
  split,
  { simp only [squarefree_nat, squarefree_nat', zero_hom.coe_mk, squarefree_one, if_true], },
  { intros m n hm hn hmn,
    simp only [squarefree_nat, squarefree_nat', zero_hom.coe_mk, squarefree_mul hmn, ite_and],
    rw [←ite_mul_zero_left, one_mul], },
end

end squarefree_sums