This PR relaxes the assumptions for `Lean.Grind.IsCharP` from `Ring` to `Semiring`, and provides an alternative constructor for rings.
479 lines
19 KiB
Text
479 lines
19 KiB
Text
/-
|
||
Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Kim Morrison
|
||
-/
|
||
module
|
||
|
||
prelude
|
||
import Init.Data.Zero
|
||
import Init.Data.Int.DivMod.Lemmas
|
||
import Init.Data.Int.Pow
|
||
import Init.TacticsExtra
|
||
import Init.Grind.Module.Basic
|
||
|
||
/-!
|
||
# A monolithic commutative ring typeclass for internal use in `grind`.
|
||
|
||
The `Lean.Grind.CommRing` class will be used to convert expressions into the internal representation via polynomials,
|
||
with coefficients expressed via `OfNat` and `Neg`.
|
||
|
||
The `IsCharP α p` typeclass expresses that the ring has characteristic `p`,
|
||
i.e. that a coefficient `OfNat.ofNat x : α` is zero if and only if `x % p = 0` (in `Nat`).
|
||
See
|
||
```
|
||
theorem ofNat_ext_iff {x y : Nat} : OfNat.ofNat (α := α) x = OfNat.ofNat (α := α) y ↔ x % p = y % p
|
||
theorem ofNat_emod (x : Nat) : OfNat.ofNat (α := α) (x % p) = OfNat.ofNat x
|
||
theorem ofNat_eq_iff_of_lt {x y : Nat} (h₁ : x < p) (h₂ : y < p) :
|
||
OfNat.ofNat (α := α) x = OfNat.ofNat (α := α) y ↔ x = y
|
||
```
|
||
-/
|
||
|
||
namespace Lean.Grind
|
||
|
||
class Semiring (α : Type u) extends Add α, Mul α, HPow α Nat α where
|
||
[ofNat : ∀ n, OfNat α n]
|
||
[natCast : NatCast α]
|
||
add_assoc : ∀ a b c : α, a + b + c = a + (b + c)
|
||
add_comm : ∀ a b : α, a + b = b + a
|
||
add_zero : ∀ a : α, a + 0 = a
|
||
mul_assoc : ∀ a b c : α, a * b * c = a * (b * c)
|
||
mul_one : ∀ a : α, a * 1 = a
|
||
one_mul : ∀ a : α, 1 * a = a
|
||
left_distrib : ∀ a b c : α, a * (b + c) = a * b + a * c
|
||
right_distrib : ∀ a b c : α, (a + b) * c = a * c + b * c
|
||
zero_mul : ∀ a : α, 0 * a = 0
|
||
mul_zero : ∀ a : α, a * 0 = 0
|
||
pow_zero : ∀ a : α, a ^ 0 = 1
|
||
pow_succ : ∀ a : α, ∀ n : Nat, a ^ (n + 1) = (a ^ n) * a
|
||
ofNat_succ : ∀ a : Nat, OfNat.ofNat (α := α) (a + 1) = OfNat.ofNat a + 1 := by intros; rfl
|
||
ofNat_eq_natCast : ∀ n : Nat, OfNat.ofNat (α := α) n = Nat.cast n := by intros; rfl
|
||
|
||
class Ring (α : Type u) extends Semiring α, Neg α, Sub α where
|
||
[intCast : IntCast α]
|
||
neg_add_cancel : ∀ a : α, -a + a = 0
|
||
sub_eq_add_neg : ∀ a b : α, a - b = a + -b
|
||
intCast_ofNat : ∀ n : Nat, Int.cast (OfNat.ofNat (α := Int) n) = OfNat.ofNat (α := α) n := by intros; rfl
|
||
intCast_neg : ∀ i : Int, Int.cast (R := α) (-i) = -Int.cast i := by intros; rfl
|
||
|
||
class CommSemiring (α : Type u) extends Semiring α where
|
||
mul_comm : ∀ a b : α, a * b = b * a
|
||
one_mul := by intro a; rw [mul_comm, mul_one]
|
||
mul_zero := by intro a; rw [mul_comm, zero_mul]
|
||
right_distrib := by intro a b c; rw [mul_comm, left_distrib, mul_comm c, mul_comm c]
|
||
|
||
class CommRing (α : Type u) extends Ring α, CommSemiring α
|
||
|
||
-- We reduce the priority of these parent instances,
|
||
-- so that in downstream libraries with their own `CommRing` class,
|
||
-- the path `CommRing -> Add` is found before `CommRing -> Lean.Grind.CommRing -> Add`.
|
||
-- (And similarly for the other parents.)
|
||
attribute [instance 100] Semiring.toAdd Semiring.toMul Semiring.toHPow Ring.toNeg Ring.toSub
|
||
|
||
-- This is a low-priority instance, to avoid conflicts with existing `OfNat`, `NatCast`, and `IntCast` instances.
|
||
attribute [instance 100] Semiring.ofNat
|
||
|
||
attribute [local instance] Semiring.natCast Ring.intCast
|
||
|
||
namespace Semiring
|
||
|
||
variable {α : Type u} [Semiring α]
|
||
|
||
theorem natCast_zero : ((0 : Nat) : α) = 0 := (ofNat_eq_natCast 0).symm
|
||
theorem natCast_one : ((1 : Nat) : α) = 1 := (ofNat_eq_natCast 1).symm
|
||
|
||
theorem ofNat_add (a b : Nat) : OfNat.ofNat (α := α) (a + b) = OfNat.ofNat a + OfNat.ofNat b := by
|
||
induction b with
|
||
| zero => simp [Nat.add_zero, add_zero]
|
||
| succ b ih => rw [Nat.add_succ, ofNat_succ, ih, ofNat_succ b, add_assoc]
|
||
|
||
theorem natCast_add (a b : Nat) : ((a + b : Nat) : α) = ((a : α) + (b : α)) := by
|
||
rw [← ofNat_eq_natCast, ← ofNat_eq_natCast, ofNat_add, ofNat_eq_natCast, ofNat_eq_natCast]
|
||
theorem natCast_succ (n : Nat) : ((n + 1 : Nat) : α) = ((n : α) + 1) := by
|
||
rw [natCast_add, natCast_one]
|
||
|
||
theorem zero_add (a : α) : 0 + a = a := by
|
||
rw [add_comm, add_zero]
|
||
|
||
theorem add_left_comm (a b c : α) : a + (b + c) = b + (a + c) := by
|
||
rw [← add_assoc, ← add_assoc, add_comm a]
|
||
|
||
theorem ofNat_mul (a b : Nat) : OfNat.ofNat (α := α) (a * b) = OfNat.ofNat a * OfNat.ofNat b := by
|
||
induction b with
|
||
| zero => simp [Nat.mul_zero, mul_zero]
|
||
| succ a ih => rw [Nat.mul_succ, ofNat_add, ih, ofNat_add, left_distrib, mul_one]
|
||
|
||
theorem natCast_mul (a b : Nat) : ((a * b : Nat) : α) = ((a : α) * (b : α)) := by
|
||
rw [← ofNat_eq_natCast, ofNat_mul, ofNat_eq_natCast, ofNat_eq_natCast]
|
||
|
||
theorem pow_one (a : α) : a ^ 1 = a := by
|
||
rw [pow_succ, pow_zero, one_mul]
|
||
|
||
theorem pow_two (a : α) : a ^ 2 = a * a := by
|
||
rw [pow_succ, pow_one]
|
||
|
||
theorem pow_add (a : α) (k₁ k₂ : Nat) : a ^ (k₁ + k₂) = a^k₁ * a^k₂ := by
|
||
induction k₂
|
||
next => simp [pow_zero, mul_one]
|
||
next k₂ ih => rw [Nat.add_succ, pow_succ, pow_succ, ih, mul_assoc]
|
||
|
||
instance : NatModule α where
|
||
hMul a x := a * x
|
||
add_zero := by simp [add_zero]
|
||
add_assoc := by simp [add_assoc]
|
||
add_comm := by simp [add_comm]
|
||
zero_hmul := by simp [natCast_zero, zero_mul]
|
||
one_hmul := by simp [natCast_one, one_mul]
|
||
add_hmul := by simp [natCast_add, right_distrib]
|
||
hmul_zero := by simp [mul_zero]
|
||
hmul_add := by simp [left_distrib]
|
||
mul_hmul := by simp [natCast_mul, mul_assoc]
|
||
|
||
theorem hmul_eq_natCast_mul {α} [Semiring α] {k : Nat} {a : α} : HMul.hMul (α := Nat) k a = (k : α) * a := rfl
|
||
|
||
theorem hmul_eq_ofNat_mul {α} [Semiring α] {k : Nat} {a : α} : HMul.hMul (α := Nat) k a = OfNat.ofNat k * a := by
|
||
simp [ofNat_eq_natCast, hmul_eq_natCast_mul]
|
||
|
||
end Semiring
|
||
|
||
namespace Ring
|
||
|
||
open Semiring
|
||
|
||
variable {α : Type u} [Ring α]
|
||
|
||
theorem add_neg_cancel (a : α) : a + -a = 0 := by
|
||
rw [add_comm, neg_add_cancel]
|
||
|
||
theorem add_left_inj {a b : α} (c : α) : a + c = b + c ↔ a = b :=
|
||
⟨fun h => by simpa [add_assoc, add_neg_cancel, add_zero] using (congrArg (· + -c) h),
|
||
fun g => congrArg (· + c) g⟩
|
||
|
||
theorem add_right_inj (a b c : α) : a + b = a + c ↔ b = c := by
|
||
rw [add_comm a b, add_comm a c, add_left_inj]
|
||
|
||
theorem neg_zero : (-0 : α) = 0 := by
|
||
rw [← add_left_inj 0, neg_add_cancel, add_zero]
|
||
|
||
theorem neg_neg (a : α) : -(-a) = a := by
|
||
rw [← add_left_inj (-a), neg_add_cancel, add_neg_cancel]
|
||
|
||
theorem neg_eq_zero (a : α) : -a = 0 ↔ a = 0 :=
|
||
⟨fun h => by
|
||
replace h := congrArg (-·) h
|
||
simpa [neg_neg, neg_zero] using h,
|
||
fun h => by rw [h, neg_zero]⟩
|
||
|
||
theorem neg_eq_iff (a b : α) : -a = b ↔ a = -b := by
|
||
constructor
|
||
· intro h
|
||
rw [← neg_neg a, h]
|
||
· intro h
|
||
rw [← neg_neg b, h]
|
||
|
||
theorem neg_add (a b : α) : -(a + b) = -a + -b := by
|
||
rw [← add_left_inj (a + b), neg_add_cancel, add_assoc (-a), add_comm a b, ← add_assoc (-b),
|
||
neg_add_cancel, zero_add, neg_add_cancel]
|
||
|
||
theorem neg_sub (a b : α) : -(a - b) = b - a := by
|
||
rw [sub_eq_add_neg, neg_add, neg_neg, sub_eq_add_neg, add_comm]
|
||
|
||
theorem sub_self (a : α) : a - a = 0 := by
|
||
rw [sub_eq_add_neg, add_neg_cancel]
|
||
|
||
theorem sub_eq_iff {a b c : α} : a - b = c ↔ a = c + b := by
|
||
rw [sub_eq_add_neg]
|
||
constructor
|
||
next => intro; subst c; rw [add_assoc, neg_add_cancel, add_zero]
|
||
next => intro; subst a; rw [add_assoc, add_comm b, neg_add_cancel, add_zero]
|
||
|
||
theorem sub_eq_zero_iff {a b : α} : a - b = 0 ↔ a = b := by
|
||
simp [sub_eq_iff, zero_add]
|
||
|
||
theorem intCast_zero : ((0 : Int) : α) = 0 := intCast_ofNat 0
|
||
theorem intCast_one : ((1 : Int) : α) = 1 := intCast_ofNat 1
|
||
theorem intCast_neg_one : ((-1 : Int) : α) = -1 := by rw [intCast_neg, intCast_ofNat]
|
||
theorem intCast_natCast (n : Nat) : ((n : Int) : α) = (n : α) := by
|
||
erw [intCast_ofNat]
|
||
rw [ofNat_eq_natCast]
|
||
theorem intCast_natCast_add_one (n : Nat) : ((n + 1 : Int) : α) = (n : α) + 1 := by
|
||
rw [← Int.natCast_add_one, intCast_natCast, natCast_add, ofNat_eq_natCast]
|
||
theorem intCast_negSucc (n : Nat) : ((-(n + 1) : Int) : α) = -((n : α) + 1) := by
|
||
rw [intCast_neg, ← Int.natCast_add_one, intCast_natCast, ofNat_eq_natCast, natCast_add]
|
||
theorem intCast_nat_add {x y : Nat} : ((x + y : Int) : α) = ((x : α) + (y : α)) := by
|
||
rw [Int.ofNat_add_ofNat, intCast_natCast, natCast_add]
|
||
theorem intCast_nat_sub {x y : Nat} (h : x ≥ y) : (((x - y : Nat) : Int) : α) = ((x : α) - (y : α)) := by
|
||
induction x with
|
||
| zero =>
|
||
have : y = 0 := by omega
|
||
simp [this, intCast_zero, natCast_zero, sub_eq_add_neg, zero_add, neg_zero]
|
||
| succ x ih =>
|
||
by_cases h : x + 1 = y
|
||
· simp [h, intCast_zero, sub_self]
|
||
· have : ((x + 1 - y : Nat) : Int) = (x - y : Nat) + 1 := by omega
|
||
rw [this, intCast_natCast_add_one]
|
||
specialize ih (by omega)
|
||
rw [intCast_natCast] at ih
|
||
rw [ih, natCast_succ, sub_eq_add_neg, sub_eq_add_neg, add_assoc, add_comm _ 1, ← add_assoc]
|
||
theorem intCast_add (x y : Int) : ((x + y : Int) : α) = ((x : α) + (y : α)) :=
|
||
match x, y with
|
||
| (x : Nat), (y : Nat) => by
|
||
rw [intCast_nat_add, intCast_natCast, intCast_natCast]
|
||
| (x : Nat), (-(y + 1 : Nat)) => by
|
||
by_cases h : x ≥ y + 1
|
||
· have : (x + -(y+1 : Nat) : Int) = ((x - (y + 1) : Nat) : Int) := by omega
|
||
rw [this, intCast_neg, intCast_nat_sub h, intCast_natCast, intCast_natCast, sub_eq_add_neg]
|
||
· have : (x + -(y+1 : Nat) : Int) = (-(y + 1 - x : Nat) : Int) := by omega
|
||
rw [this, intCast_neg, intCast_nat_sub (by omega), intCast_natCast, intCast_neg, intCast_natCast,
|
||
neg_sub, sub_eq_add_neg]
|
||
| (-(x + 1 : Nat)), (y : Nat) => by
|
||
by_cases h : y ≥ x+ 1
|
||
· have : (-(x+1 : Nat) + y : Int) = ((y - (x + 1) : Nat) : Int) := by omega
|
||
rw [this, intCast_neg, intCast_nat_sub h, intCast_natCast, intCast_natCast, sub_eq_add_neg, add_comm]
|
||
· have : (-(x+1 : Nat) + y : Int) = (-(x + 1 - y : Nat) : Int) := by omega
|
||
rw [this, intCast_neg, intCast_nat_sub (by omega), intCast_natCast, intCast_neg, intCast_natCast,
|
||
neg_sub, sub_eq_add_neg, add_comm]
|
||
| (-(x + 1 : Nat)), (-(y + 1 : Nat)) => by
|
||
rw [← Int.neg_add, intCast_neg, intCast_nat_add, neg_add, intCast_neg, intCast_neg, intCast_natCast, intCast_natCast]
|
||
theorem intCast_sub (x y : Int) : ((x - y : Int) : α) = ((x : α) - (y : α)) := by
|
||
rw [Int.sub_eq_add_neg, intCast_add, intCast_neg, sub_eq_add_neg]
|
||
|
||
theorem ofNat_sub {x y : Nat} (h : y ≤ x) : OfNat.ofNat (α := α) (x - y) = OfNat.ofNat x - OfNat.ofNat y := by
|
||
rw [ofNat_eq_natCast, ← intCast_natCast, Int.ofNat_sub h]
|
||
rw [intCast_sub]
|
||
rw [intCast_natCast, intCast_natCast, ofNat_eq_natCast, ofNat_eq_natCast]
|
||
|
||
theorem neg_ofNat_sub {x y : Nat} (h : y ≤ x) : -OfNat.ofNat (α := α) (x - y) = OfNat.ofNat y - OfNat.ofNat x := by
|
||
rw [neg_eq_iff, ofNat_sub h, neg_sub]
|
||
|
||
theorem neg_eq_neg_one_mul (a : α) : -a = (-1) * a := by
|
||
rw [← add_left_inj a, neg_add_cancel]
|
||
conv => rhs; arg 2; rw [← one_mul a]
|
||
rw [← right_distrib, ← intCast_neg_one, ← intCast_one (α := α)]
|
||
simp [← intCast_add, intCast_zero, zero_mul]
|
||
|
||
theorem neg_eq_mul_neg_one (a : α) : -a = a * (-1) := by
|
||
rw [← add_left_inj a, neg_add_cancel]
|
||
conv => rhs; arg 2; rw [← mul_one a]
|
||
rw [← left_distrib, ← intCast_neg_one, ← intCast_one (α := α)]
|
||
simp [← intCast_add, intCast_zero, mul_zero]
|
||
|
||
theorem neg_mul (a b : α) : (-a) * b = -(a * b) := by
|
||
rw [neg_eq_neg_one_mul a, neg_eq_neg_one_mul (a * b), mul_assoc]
|
||
|
||
theorem mul_neg (a b : α) : a * (-b) = -(a * b) := by
|
||
rw [neg_eq_mul_neg_one b, neg_eq_mul_neg_one (a * b), mul_assoc]
|
||
|
||
theorem intCast_nat_mul (x y : Nat) : ((x * y : Int) : α) = ((x : α) * (y : α)) := by
|
||
rw [Int.ofNat_mul_ofNat, intCast_natCast, natCast_mul]
|
||
|
||
theorem intCast_mul (x y : Int) : ((x * y : Int) : α) = ((x : α) * (y : α)) :=
|
||
match x, y with
|
||
| (x : Nat), (y : Nat) => by
|
||
rw [intCast_nat_mul, intCast_natCast, intCast_natCast]
|
||
| (x : Nat), (-(y + 1 : Nat)) => by
|
||
rw [Int.mul_neg, intCast_neg, intCast_nat_mul, intCast_neg, mul_neg, intCast_natCast, intCast_natCast]
|
||
| (-(x + 1 : Nat)), (y : Nat) => by
|
||
rw [Int.neg_mul, intCast_neg, intCast_nat_mul, intCast_neg, neg_mul, intCast_natCast, intCast_natCast]
|
||
| (-(x + 1 : Nat)), (-(y + 1 : Nat)) => by
|
||
rw [Int.neg_mul_neg, intCast_neg, intCast_neg, neg_mul, mul_neg, neg_neg, intCast_nat_mul,
|
||
intCast_natCast, intCast_natCast]
|
||
|
||
theorem intCast_pow (x : Int) (k : Nat) : ((x ^ k : Int) : α) = (x : α) ^ k := by
|
||
induction k
|
||
next => simp [pow_zero, Int.pow_zero, intCast_one]
|
||
next k ih => simp [pow_succ, Int.pow_succ, intCast_mul, *]
|
||
|
||
instance : IntModule α where
|
||
hMul a x := a * x
|
||
add_zero := by simp [add_zero]
|
||
add_assoc := by simp [add_assoc]
|
||
add_comm := by simp [add_comm]
|
||
zero_hmul := by simp [intCast_zero, zero_mul]
|
||
one_hmul := by simp [intCast_one, one_mul]
|
||
add_hmul := by simp [intCast_add, right_distrib]
|
||
hmul_zero := by simp [mul_zero]
|
||
hmul_add := by simp [left_distrib]
|
||
mul_hmul := by simp [intCast_mul, mul_assoc]
|
||
neg_add_cancel := by simp [neg_add_cancel]
|
||
sub_eq_add_neg := by simp [sub_eq_add_neg]
|
||
|
||
theorem hmul_eq_intCast_mul {α} [Ring α] {k : Int} {a : α} : HMul.hMul (α := Int) k a = (k : α) * a := rfl
|
||
|
||
end Ring
|
||
|
||
namespace CommSemiring
|
||
|
||
open Semiring
|
||
|
||
variable {α : Type u} [CommSemiring α]
|
||
|
||
theorem mul_left_comm (a b c : α) : a * (b * c) = b * (a * c) := by
|
||
rw [← mul_assoc, ← mul_assoc, mul_comm a]
|
||
|
||
end CommSemiring
|
||
|
||
open Semiring Ring CommSemiring CommRing
|
||
|
||
class IsCharP (α : Type u) [Semiring α] (p : outParam Nat) where
|
||
ofNat_ext_iff (p) : ∀ {x y : Nat}, OfNat.ofNat (α := α) x = OfNat.ofNat (α := α) y ↔ x % p = y % p
|
||
|
||
namespace IsCharP
|
||
|
||
section
|
||
|
||
variable (p) [Semiring α] [IsCharP α p]
|
||
|
||
theorem ofNat_eq_zero_iff (x : Nat) :
|
||
OfNat.ofNat (α := α) x = 0 ↔ x % p = 0 := by
|
||
rw [ofNat_ext_iff p]
|
||
simp
|
||
|
||
theorem ofNat_ext {x y : Nat} (h : x % p = y % p) : OfNat.ofNat (α := α) x = OfNat.ofNat (α := α) y := (ofNat_ext_iff p).mpr h
|
||
|
||
theorem ofNat_eq_zero_iff_of_lt {x : Nat} (h : x < p) : OfNat.ofNat (α := α) x = 0 ↔ x = 0 := by
|
||
rw [ofNat_eq_zero_iff p, Nat.mod_eq_of_lt h]
|
||
|
||
theorem ofNat_eq_iff_of_lt {x y : Nat} (h₁ : x < p) (h₂ : y < p) :
|
||
OfNat.ofNat (α := α) x = OfNat.ofNat (α := α) y ↔ x = y := by
|
||
rw [ofNat_ext_iff p, Nat.mod_eq_of_lt h₁, Nat.mod_eq_of_lt h₂]
|
||
|
||
end
|
||
|
||
section Semiring
|
||
|
||
variable (p)
|
||
|
||
variable [Semiring α] [IsCharP α p]
|
||
|
||
theorem natCast_eq_zero_iff (x : Nat) : (x : α) = 0 ↔ x % p = 0 := by
|
||
rw [← ofNat_eq_natCast]
|
||
exact ofNat_eq_zero_iff p x
|
||
|
||
theorem natCast_ext {x y : Nat} (h : x % p = y % p) : (x : α) = (y : α) := by
|
||
rw [← ofNat_eq_natCast, ← ofNat_eq_natCast]
|
||
exact ofNat_ext p h
|
||
|
||
theorem natCast_ext_iff {x y : Nat} : (x : α) = (y : α) ↔ x % p = y % p := by
|
||
rw [← ofNat_eq_natCast, ← ofNat_eq_natCast]
|
||
exact ofNat_ext_iff p
|
||
|
||
theorem natCast_emod (x : Nat) : ((x % p : Nat) : α) = (x : α) := by
|
||
rw [natCast_ext_iff p, Nat.mod_mod]
|
||
|
||
theorem ofNat_emod (x : Nat) : OfNat.ofNat (α := α) (x % p) = OfNat.ofNat x := by
|
||
rw [ofNat_eq_natCast, ofNat_eq_natCast]
|
||
exact natCast_emod p x
|
||
|
||
theorem natCast_eq_zero_iff_of_lt {x : Nat} (h : x < p) : (x : α) = 0 ↔ x = 0 := by
|
||
rw [natCast_eq_zero_iff p, Nat.mod_eq_of_lt h]
|
||
|
||
theorem natCast_eq_iff_of_lt {x y : Nat} (h₁ : x < p) (h₂ : y < p) :
|
||
(x : α) = (y : α) ↔ x = y := by
|
||
rw [natCast_ext_iff p, Nat.mod_eq_of_lt h₁, Nat.mod_eq_of_lt h₂]
|
||
|
||
end Semiring
|
||
|
||
section Ring
|
||
|
||
variable (p) {α : Type u} [Ring α] [IsCharP α p]
|
||
|
||
private theorem mk'_aux {x y : Nat} (p : Nat) (h : y ≤ x) :
|
||
(x - y) % p = 0 ↔ ∃ k₁ k₂, x + k₁ * p = y + k₂ * p := by
|
||
rw [Nat.mod_eq_iff]
|
||
by_cases h : p = 0
|
||
· simp [h]
|
||
omega
|
||
· have h' : 0 < p := by omega
|
||
simp [h, h']
|
||
constructor
|
||
· rintro ⟨k, h⟩
|
||
refine ⟨0, k, ?_⟩
|
||
simp [Nat.mul_comm]
|
||
omega
|
||
· rintro ⟨k₁, k₂, h⟩
|
||
have : k₁ * p ≤ k₂ * p := by omega
|
||
have : k₁ ≤ k₂ := Nat.le_of_mul_le_mul_right this h'
|
||
refine ⟨k₂ - k₁, ?_⟩
|
||
simp [Nat.mul_sub, Nat.mul_comm p k₁, Nat.mul_comm p k₂]
|
||
omega
|
||
|
||
/-- Alternative constructor when `α` is a `Ring`. -/
|
||
def mk' (p : Nat) (α : Type u) [Ring α]
|
||
(ofNat_eq_zero_iff : ∀ (x : Nat), OfNat.ofNat (α := α) x = 0 ↔ x % p = 0) : IsCharP α p where
|
||
ofNat_ext_iff {x y} := by
|
||
rw [← sub_eq_zero_iff]
|
||
rw [Nat.mod_eq_mod_iff]
|
||
by_cases h : y ≤ x
|
||
· have : OfNat.ofNat (α := α) x - OfNat.ofNat y = OfNat.ofNat (x - y) := by rw [ofNat_sub h]
|
||
rw [this, ofNat_eq_zero_iff]
|
||
apply mk'_aux _ h
|
||
· have : OfNat.ofNat (α := α) x - OfNat.ofNat (α := α) y = - OfNat.ofNat (y - x) := by rw [neg_ofNat_sub (by omega)]
|
||
rw [this, neg_eq_zero, ofNat_eq_zero_iff]
|
||
rw [mk'_aux _ (by omega)]
|
||
rw [exists_comm]
|
||
apply exists_congr
|
||
intro k₁
|
||
apply exists_congr
|
||
intro k₂
|
||
simp [eq_comm]
|
||
|
||
theorem intCast_eq_zero_iff (x : Int) : (x : α) = 0 ↔ x % p = 0 :=
|
||
match x with
|
||
| (x : Nat) => by
|
||
have := ofNat_eq_zero_iff (α := α) p (x := x)
|
||
rw [Int.ofNat_mod_ofNat, intCast_natCast, ← ofNat_eq_natCast]
|
||
norm_cast
|
||
| -(x + 1 : Nat) => by
|
||
rw [Int.neg_emod, Int.ofNat_mod_ofNat, intCast_neg, intCast_natCast, neg_eq_zero]
|
||
have := ofNat_eq_zero_iff (α := α) p (x := x + 1)
|
||
rw [ofNat_eq_natCast] at this
|
||
rw [this]
|
||
simp only [Int.ofNat_dvd]
|
||
simp only [← Nat.dvd_iff_mod_eq_zero, Int.natAbs_natCast, Int.natCast_add,
|
||
Int.cast_ofNat_Int, ite_eq_left_iff]
|
||
by_cases h : p ∣ x + 1
|
||
· simp [h]
|
||
· simp only [h, not_false_eq_true, Int.natCast_add, Int.cast_ofNat_Int,
|
||
forall_const, false_iff, ne_eq]
|
||
by_cases w : p = 0
|
||
· simp [w]
|
||
omega
|
||
· have : ((x + 1) % p) < p := Nat.mod_lt _ (by omega)
|
||
omega
|
||
|
||
theorem intCast_ext_iff {x y : Int} : (x : α) = (y : α) ↔ x % p = y % p := by
|
||
constructor
|
||
· intro h
|
||
replace h : ((x - y : Int) : α) = 0 := by rw [intCast_sub, h, sub_self]
|
||
exact Int.emod_eq_emod_iff_emod_sub_eq_zero.mpr ((intCast_eq_zero_iff p _).mp h)
|
||
· intro h
|
||
have : ((x - y : Int) : α) = 0 :=
|
||
(intCast_eq_zero_iff p _).mpr (by rw [Int.sub_emod, h, Int.sub_self, Int.zero_emod])
|
||
replace this := congrArg (· + (y : α)) this
|
||
simpa [intCast_sub, zero_add, sub_eq_add_neg, add_assoc, neg_add_cancel, add_zero] using this
|
||
|
||
theorem intCast_emod (x : Int) : ((x % p : Int) : α) = (x : α) := by
|
||
rw [intCast_ext_iff p, Int.emod_emod]
|
||
|
||
end Ring
|
||
|
||
end IsCharP
|
||
|
||
-- TODO: This should be generalizable to any `IntModule α`, not just `Ring α`.
|
||
theorem no_int_zero_divisors {α : Type u} [Ring α] [NoNatZeroDivisors α] {k : Int} {a : α}
|
||
: k ≠ 0 → k * a = 0 → a = 0 := by
|
||
match k with
|
||
| (k : Nat) =>
|
||
simp [intCast_natCast]
|
||
intro h₁ h₂
|
||
replace h₁ : k ≠ 0 := by intro h; simp [h] at h₁
|
||
exact no_nat_zero_divisors k a h₁ h₂
|
||
| -(k+1 : Nat) =>
|
||
rw [Int.natCast_add, ← Int.natCast_add, intCast_neg, intCast_natCast]
|
||
intro _ h
|
||
replace h := congrArg (-·) h; simp at h
|
||
rw [← neg_mul, neg_neg, neg_zero, ← hmul_eq_natCast_mul] at h
|
||
exact no_nat_zero_divisors (k+1) a (Nat.succ_ne_zero _) h
|
||
|
||
end Lean.Grind
|