From e038521a7d336706389e8b95a772e4970933a60f Mon Sep 17 00:00:00 2001 From: Sam Park Date: Fri, 29 Aug 2025 11:20:37 +0100 Subject: [PATCH 1/8] [new] polynomial --- src/Algebra/Polynomial/Base.agda | 82 +++ src/Algebra/Polynomial/Poly/Base.agda | 149 +++++ src/Algebra/Polynomial/Poly/Properties.agda | 663 ++++++++++++++++++++ src/Algebra/Polynomial/Properties.agda | 304 +++++++++ src/Algebra/Properties/Group.agda | 13 + 5 files changed, 1211 insertions(+) create mode 100644 src/Algebra/Polynomial/Base.agda create mode 100644 src/Algebra/Polynomial/Poly/Base.agda create mode 100644 src/Algebra/Polynomial/Poly/Properties.agda create mode 100644 src/Algebra/Polynomial/Properties.agda diff --git a/src/Algebra/Polynomial/Base.agda b/src/Algebra/Polynomial/Base.agda new file mode 100644 index 0000000000..920ab3f2a8 --- /dev/null +++ b/src/Algebra/Polynomial/Base.agda @@ -0,0 +1,82 @@ +open import Algebra.Bundles using (CommutativeRing) +open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) +open import Data.Product.Base using (_,_) +open import Data.Vec.Base as Vec using ([]; _∷_) +import Level as L + +module Algebra.Polynomial.Base + {ℓ₁ ℓ₂} (CR : CommutativeRing ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Base CR as Poly + using (Poly; zeros) + +open CommutativeRing CR + using (0#; 1#) + renaming (Carrier to A) + +private + variable + m n k : ℕ + p : Poly m + q : Poly n + r : Poly k + +--------------------------------------------------- +-- Types + +record Polynomial : Set ℓ₁ where + constructor _,_ + field + degree : ℕ + polynomial : Poly degree + +private + variable + P Q R : Polynomial + +-- Equivalence relation for representations of polynomials +infix 4 _≈_ +_≈_ : Polynomial → Polynomial → Set (ℓ₁ L.⊔ ℓ₂) +(m , p) ≈ (n , q) = p Poly.≈ q + +refl : P ≈ P +refl = Poly.refl + +sym : P ≈ Q → Q ≈ P +sym = Poly.sym + +trans : P ≈ Q → Q ≈ R → P ≈ R +trans = Poly.trans + +-------------------------------------------------- +-- Constants + +zero : Polynomial +zero = (0 , []) + +one : Polynomial +one = (1 , (1# ∷ [])) + +--------------------------------------------------- +-- Operations + +-- Multiply the polynomial by a factor of x +shift : Polynomial → Polynomial +shift (m , p) = (suc m , Poly.shift p) + +-- Negation +-_ : Polynomial → Polynomial +- (m , p) = (m , Poly.- p) + +-- Scaling +_·_ : A → Polynomial → Polynomial +a · (m , p) = (m , a Poly.· p) + +-- Addition +_+_ : Polynomial → Polynomial → Polynomial +(m , p) + (n , q) = (m ⊔ n , p Poly.+ q) + +-- Multiplication +_*_ : Polynomial → Polynomial → Polynomial +(m , p) * (n , q) = (pred (m ℕ.+ n) , p Poly.* q) diff --git a/src/Algebra/Polynomial/Poly/Base.agda b/src/Algebra/Polynomial/Poly/Base.agda new file mode 100644 index 0000000000..d50d074e14 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Base.agda @@ -0,0 +1,149 @@ +open import Algebra.Bundles using (CommutativeRing) + +module Algebra.Polynomial.Poly.Base + {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) + where + +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +import Data.Nat.Properties as ℕ +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All using (All ; []; _∷_) +import Level as L +open import Relation.Binary.PropositionalEquality.Core using (cong) +open import Relation.Binary.PropositionalEquality + using (_≡_; cong; module ≡-Reasoning) + +infix 8 -_ +infixl 7 _*_ +infix 7 _·_ +infixl 6 _+_ +infix 4 _≈_ + +module CR = CommutativeRing R +open CR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +private + variable + m n k l : ℕ + a b c d : A + +-- Polynomial of degree most n is represented as a vector of length n + 1 +-- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∷ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ + +Poly : ℕ → Set ℓ₁ +Poly n = Vec A n + +private + variable + p : Poly m + q : Poly n + r : Poly k + s : Poly l + +zeros : (n : ℕ) → Poly n +zeros n = Vec.replicate n (0#) + +-- Scaling a polynomial by a +_·_ : A → Poly n → Poly n +a · p = Vec.map (a *A_) p + +-- Multiply a polynomial by a factor of x +shift : Poly n → Poly (suc n) +shift p = 0# ∷ p + +IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) +IsZero = All (_≈A 0#) + +-- The additive inverse +-_ : Poly n → Poly n +- p = Vec.map -A_ p + +------------------------------------------------------------------ +-- The representation of a polynomial is not unique +-- because we allow coefficients to be zero +-- We define an equivalence relation which takes this into account + +data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where + []≈ : (q : Poly n) → IsZero q → [] ≈ q + ≈[] : (p : Poly m) → IsZero p → p ≈ [] + cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) + +------------------------------------------------------------------ +-- Properties of Polynomial Equality + +zeros-unique : IsZero p → IsZero q → p ≈ q +zeros-unique [] [] = []≈ [] [] +zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = cons (CR.trans a≈0 (CR.sym b≈0)) (zeros-unique p≈0 q≈0) + +IsZero-cong : IsZero p → p ≈ q → IsZero q +IsZero-cong [] ([]≈ q q≈0) = q≈0 +IsZero-cong [] (≈[] p p≈0) = p≈0 +IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] +IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) + = (CR.trans (CR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q + +------------------------------------------------------------------ +-- _≈_ is an equivalence relation + +refl : p ≈ p +refl {p = []} = []≈ [] [] +refl {p = a ∷ p} = cons CR.refl refl + +sym : p ≈ q → q ≈ p +sym ([]≈ q q≈0) = ≈[] q q≈0 +sym (≈[] p p≈0) = []≈ p p≈0 +sym (cons a≈b p≈q) = cons (CR.sym a≈b) (sym p≈q) + +trans : p ≈ q → q ≈ r → p ≈ r +trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) +trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) +trans (cons a≈b p≈q) (≈[] q q≈0) + = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) +trans (cons a≈b p≈q) (cons b≈c q≈r) + = cons (CR.trans a≈b b≈c) (trans p≈q q≈r) + +consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) +consˡ a≈b = cons a≈b refl + +consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) +consʳ = cons CR.refl + +---------------------------------------------------------------- +-- Operations + +-- Addition +_+_ : Poly m → Poly n → Poly (m ⊔ n) +[] + [] = [] +[] + (a ∷ p) = a ∷ p +(a ∷ p) + [] = a ∷ p +(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) + +private + pred[n+sucm]≡n+m : ∀ n → ∀ m → pred (n ℕ.+ suc m) ≡ n ℕ.+ m + pred[n+sucm]≡n+m n m = begin + pred (n ℕ.+ suc m) ≡⟨ cong pred (ℕ.+-comm n (suc m)) ⟩ + pred (suc m ℕ.+ n) ≡⟨ ℕ.+-comm m n ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +cast-lem : ∀ m → ∀ n → m ⊔ pred (n ℕ.+ suc m) ≡ (n ℕ.+ m) +cast-lem m n = begin + m ⊔ pred (n ℕ.+ suc m) ≡⟨ cong (m ⊔_) (pred[n+sucm]≡n+m n m) ⟩ + m ⊔ (n ℕ.+ m) ≡⟨ ℕ.m≤n⇒m⊔n≡n (ℕ.m≤n+m m n) ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +-- Multiplication +_*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) +_*_ {m = m} [] p = zeros (pred m) +_*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) diff --git a/src/Algebra/Polynomial/Poly/Properties.agda b/src/Algebra/Polynomial/Poly/Properties.agda new file mode 100644 index 0000000000..29501f2c39 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Properties.agda @@ -0,0 +1,663 @@ +open import Algebra.Bundles using (CommutativeRing) + +module Algebra.Polynomial.Poly.Properties + {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Base R as P + using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) +open import Algebra.Properties.Ring +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +import Data.Nat.Properties as ℕ +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All using (All ; []; _∷_; head; tail) +import Level as L +open import Relation.Binary +open import Relation.Binary.PropositionalEquality as Eq + using (_≡_; module ≡-Reasoning) +open import Relation.Binary.PropositionalEquality.Core using (cong) + +module CR = CommutativeRing R +open CR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +private + variable + m n k l : ℕ + a b c d : A + p : Poly m + q : Poly n + r : Poly k + s : Poly l + +--------------------------------------------------------------------- +-- Equational reasoning for Poly n and Poly m +-- where m is not necesarily the same as n +private + + infix 4 _IsRelatedTo_ + + data _IsRelatedTo_ (p : Poly m) (q : Poly n) : Set (ℓ₁ L.⊔ ℓ₂) where + relTo : (p≈q : p ≈ q) → p IsRelatedTo q + + start : _IsRelatedTo_ {m} {n} ⇒ _≈_ + start (relTo p≈q) = p≈q + + ∼-go : Trans (_≈_) (_IsRelatedTo_ {n} {k}) (_IsRelatedTo_ {m} {k}) + ∼-go p≈q (relTo q≈r) = relTo (trans p≈q q≈r) + + stop : Reflexive (_IsRelatedTo_ {m} {m}) + stop = relTo refl + + forward : (p : Poly m) → q IsRelatedTo r → p ≈ q → p IsRelatedTo r + forward p qRr p≈q = ∼-go p≈q qRr + + backward : (p : Poly m) → q IsRelatedTo r → q ≈ p → p IsRelatedTo r + backward p qRr q≈p = ∼-go (sym q≈p) qRr + + infix 1 begin_ + begin_ : p IsRelatedTo q → p ≈ q + begin_ = start + + infixr 2 step-∼-⟩ + step-∼-⟩ = forward + syntax step-∼-⟩ p qRr p≈q = p ≈⟨ p≈q ⟩ qRr + + infixr 2 step-∼-⟨ + step-∼-⟨ = backward + syntax step-∼-⟨ p qRr q≈p = p ≈⟨ q≈p ⟨ qRr + + infix 3 _∎ + _∎ : (p : Poly m) → p IsRelatedTo p + p ∎ = stop + +----------------------------------------------------------------- +-- Properties of zero polynomial + +zerosIsZero : (n : ℕ) → IsZero (zeros n) +zerosIsZero 0 = [] +zerosIsZero (suc n) = CR.refl ∷ (zerosIsZero n) + +zerosm≈zerosn : zeros m ≈ zeros n +zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) + +≈0⇒IsZero : p ≈ zeros m → IsZero p +≈0⇒IsZero ([]≈ zeros zeros≈0) = [] +≈0⇒IsZero (≈[] p p≈0) = p≈0 +≈0⇒IsZero (cons a≈0 p≈0) = a≈0 ∷ ≈0⇒IsZero p≈0 + +IsZero⇒≈0 : IsZero p → p ≈ zeros m +IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) + +All-p≈0∧q≈0⇒p+q≈0 : All (_≈A 0#) p → All (_≈A 0#) q → All (_≈A 0#) (p + q) +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] [] = [] +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +All-p≈0∧q≈0⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = CR.trans (CR.+-cong a≈0 b≈0) (CR.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 + +------------------------------------------------------ +-- Additive inverse + +[-p]+pIsZero : {p : Poly m} → IsZero ((- p) + p) +[-p]+pIsZero {p = []} = [] +[-p]+pIsZero {p = a ∷ p} = CR.-‿inverseˡ a ∷ [-p]+pIsZero + +p+[-p]IsZero : {p : Poly m} → IsZero (p + (- p)) +p+[-p]IsZero {p = []} = [] +p+[-p]IsZero {p = a ∷ p} = CR.-‿inverseʳ a ∷ p+[-p]IsZero + ++-inverseˡ : (p : Poly m) → (- p) + p ≈ [] ++-inverseˡ [] = refl ++-inverseˡ (a ∷ p) + = ≈[] ((- (a ∷ p)) + (a ∷ p)) (CR.-‿inverseˡ a ∷ [-p]+pIsZero) + ++-inverseʳ : (p : Poly m) → p + (- p) ≈ [] ++-inverseʳ [] = refl ++-inverseʳ (a ∷ p) + = ≈[] ((a ∷ p) + (- (a ∷ p))) ((CR.-‿inverseʳ a) ∷ p+[-p]IsZero) + +------------------------------------------------------- +-- Negation is congruent + +-⁺ : IsZero p → IsZero (- p) +-⁺ [] = [] +-⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε CR.ring a≈0 ∷ (-⁺ p≈0) + +-⁻ : IsZero (- p) → IsZero p +-⁻ {p = []} -p≈0 = -p≈0 +-⁻ {p = a ∷ p} (-a≈0 ∷ -p≈0) = x⁻¹≈ε⇒x≈ε CR.ring -a≈0 ∷ (-⁻ -p≈0) + +-‿cong : p ≈ q → - p ≈ - q +-‿cong ([]≈ q q≈0) = []≈ (- q) (-⁺ q≈0) +-‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) +-‿cong (cons a≈b p≈q) = cons (CR.-‿cong a≈b) (-‿cong p≈q) + +----------------------------------------------------- +-- Properties of polynomial addition + ++-comm : (p : Poly m) → (q : Poly n) → p + q ≈ q + p ++-comm [] [] = refl ++-comm [] (a ∷ p) = refl ++-comm (a ∷ p) [] = refl ++-comm (a ∷ p) (b ∷ q) = cons (CR.+-comm a b) (+-comm p q) + ++-idʳ : (p : Poly n) → (q : Poly m) → IsZero q → p + q ≈ p ++-idʳ [] q [] = refl ++-idʳ (a ∷ p) q [] = refl ++-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) ++-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) + = cons (CR.trans (CR.+-congˡ b≈0) (CR.+-identityʳ a)) (+-idʳ p q q≈0) + ++-idˡ : (p : Poly n) → (q : Poly m) → IsZero p → p + q ≈ q ++-idˡ p q p≈0 = begin + p + q ≈⟨ +-comm p q ⟩ + q + p ≈⟨ +-idʳ q p p≈0 ⟩ + q ∎ + ++-identityʳ : (p : Poly n) → p + (zeros m) ≈ p ++-identityʳ {m = m} p = +-idʳ p (zeros m) (zerosIsZero m) + ++-identityˡ : (p : Poly n) → (zeros m) + p ≈ p ++-identityˡ {m = m} p = +-idˡ (zeros m) p (zerosIsZero m) + ++-cong : p ≈ q → r ≈ s → p + r ≈ q + s ++-cong {p = _} {q = _} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin + [] + r ≈⟨ +-identityˡ r ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-idˡ q s q≈0 ⟨ + q + s ∎ ++-cong {p = _} {q = _} {r = r} {s = s} (≈[] p p≈0) r≈s = begin + p + r ≈⟨ +-idˡ p r p≈0 ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-identityˡ s ⟨ + [] + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} {r = _} {s = s} (cons a≈b p≈q) ([]≈ s s≈0) = begin + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ + (b ∷ q) + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} {r = r} {s = _} (cons a≈b p≈q) (≈[] r r≈0) = begin + (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ∎ ++-cong (cons a≈b p≈q) (cons c≈d r≈s) + = cons (CR.+-cong a≈b c≈d) (+-cong p≈q r≈s) + ++-congˡ : p ≈ q → p + r ≈ q + r ++-congˡ p≈q = +-cong p≈q refl + ++-congʳ : q ≈ r → p + q ≈ p + r ++-congʳ q≈r = +-cong refl q≈r + ++-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (p + q) + r ≈ p + (q + r) ++-assoc [] q r = begin + ([] + q) + r ≈⟨ +-congˡ (+-identityˡ q) ⟩ + q + r ≈⟨ +-identityˡ (q + r) ⟨ + [] + (q + r) ∎ ++-assoc (a ∷ p) [] r = +-congʳ (sym (+-identityˡ r)) ++-assoc (a ∷ p) (b ∷ q) [] = refl ++-assoc (a ∷ p) (b ∷ q) (c ∷ r) + = cons (CR.+-assoc a b c) (+-assoc p q r) + +middleFour : (p : Poly m) → (q : Poly n) → (r : Poly k) → (w : Poly l) → + (p + q) + (r + w) ≈ (p + r) + (q + w) +middleFour p q r w = begin + (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ + (p + q + r) + w ≈⟨ +-congˡ (+-assoc p q r) ⟩ + (p + (q + r)) + w ≈⟨ +-congˡ (+-congʳ (+-comm q r)) ⟩ + (p + (r + q)) + w ≈⟨ +-congˡ (+-assoc p r q) ⟨ + (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ + (p + r) + (q + w) ∎ + +------------------------------------------------------------------ +-- Vector casting lemmas + +private + n+1≡sucn+0 : (n ℕ.+ 1) ≡ suc (n ℕ.+ 0) + n+1≡sucn+0 {0} = Eq.refl + n+1≡sucn+0 {suc n} = cong suc n+1≡sucn+0 + + cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → + All (_≈A 0#) (Vec.cast m≡n p) + cast-p≈0⇒p≈0 {n = 0} {[]} m≡n [] = [] + cast-p≈0⇒p≈0 {n = suc n} {a ∷ p} m≡n (a≈0 ∷ p≈0) + = a≈0 ∷ cast-p≈0⇒p≈0 (cong pred m≡n) p≈0 + + cast-p≈p : (m≡n : m ≡ n) → Vec.cast m≡n p ≈ p + cast-p≈p {n = 0} {[]} Eq.refl = refl + cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) + +------------------------------------------------------------------ +-- Properties of polynomial shifting + +*-distrib-shift : (p : Poly m) → (q : Poly n) → + p * (shift q) ≈ shift (p * q) +*-distrib-shift {_} {_} [] qs = zerosm≈zerosn +*-distrib-shift {suc m} {n} (a ∷ p) q = begin + (a ∷ p) * (0# ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + a · (0# ∷ q) + p * (0# ∷ 0# ∷ q) + ≈⟨ +-congˡ (consˡ (CR.zeroʳ a)) ⟩ + (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) + ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ + (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ consˡ (CR.+-identityˡ 0#) ⟩ + 0# ∷ (a · q + p * (0# ∷ q)) + ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟨ + 0# ∷ ((a ∷ p) * q) + ∎ + +·-distrib-shift : (a : A) → (p : Poly m) → a · (shift p) ≈ shift (a · p) +·-distrib-shift a [] = cons (CR.zeroʳ a) (refl) +·-distrib-shift a (b ∷ p) = consˡ (CR.zeroʳ a) + +---------------------------------------------------------------- +-- Properties of polynomial scaling + +a·p≈a∷[]*p : (a : A) → (p : Poly n) → a · p ≈ (a ∷ []) * p +a·p≈a∷[]*p {_} a [] = refl +a·p≈a∷[]*p {suc n} a (b ∷ p) = begin + a · (b ∷ p) + ≈⟨ cons (CR.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ + a *A b +A 0# ∷ (a · p + zeros n) + ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟨ + (a ∷ []) * (b ∷ p) ∎ + +pIsZero⇒a·pIsZero : (a : A) → (p : Poly n) → IsZero p → IsZero (a · p) +pIsZero⇒a·pIsZero a p [] = [] +pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) + = (CR.trans (CR.*-congˡ b≈0) (CR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 + +a≈0⇒a·pIsZero : (a : A) → (p : Poly n) → a ≈A 0# → IsZero (a · p) +a≈0⇒a·pIsZero a [] a≈0 = [] +a≈0⇒a·pIsZero a (b ∷ p) a≈0 + = CR.trans (CR.*-congʳ a≈0) (CR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) + +·-cong : a ≈A b → p ≈ q → a · p ≈ b · q +·-cong {a = _} {b = b} _ ([]≈ q q≈0) + = sym (IsZero⇒≈0 (pIsZero⇒a·pIsZero b q q≈0)) +·-cong {a = a} {b = _} _ (≈[] p p≈0) + = IsZero⇒≈0 (pIsZero⇒a·pIsZero a p p≈0) +·-cong {a = _} {b = _} c≈d (cons a≈b p≈q) + = cons (CR.*-cong c≈d a≈b) (·-cong c≈d p≈q) + +·-congˡ : a ≈A b → a · p ≈ b · p +·-congˡ a≈b = ·-cong a≈b refl + +·-congʳ : p ≈ q → a · p ≈ a · q +·-congʳ = ·-cong CR.refl + +·-dist : a · (p + q) ≈ (a · p) + (a · q) +·-dist {a = _} {p = []} {q = []} = refl +·-dist {a = _} {p = []} {q = b ∷ q} = refl +·-dist {a = _} {p = b ∷ p} {q = []} = refl +·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (CR.distribˡ a b c) ·-dist + +·-assoc : a · (b · p) ≈ (a *A b) · p +·-assoc {_} {_} {p = []} = refl +·-assoc {a} {b} {p = c ∷ p} = cons (CR.sym (CR.*-assoc a b c)) ·-assoc + +a·-cong : p ≈ q → a · p ≈ a · q +a·-cong = ·-cong CR.refl + +----------------------------------------------------------------- +-- Properties of polynomial multiplication + +zeroˡ : (p : Poly m) → [] * p ≈ [] +zeroˡ p = zerosm≈zerosn + +zeroʳ : (p : Poly m) → p * [] ≈ [] +zeroʳ {_} [] = refl +zeroʳ {m} (a ∷ p) = begin + (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ + p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ + 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ + 0# ∷ [] ≈⟨ zerosm≈zerosn ⟩ + [] ∎ + +pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) +pIsZero⇒p*qIsZero {n} {_} {p = []} q [] = zerosIsZero (pred n) +pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) + = cast-p≈0⇒p≈0 (cast-lem n m) + (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) + +p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] +p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) + +*-cong : {p : Poly m} → {q : Poly n} → {r : Poly k} → {s : Poly l} → + p ≈ q → r ≈ s → p * r ≈ q * s +*-cong {k = k} {q = q} {r} {s} ([]≈ q q≈0) r≈s = begin + [] * r ≈⟨ p≈[]⇒p*q≈[] r refl ⟩ + [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒≈0 q≈0) ⟨ + q * s ∎ +*-cong {k = k} {q = q} {r} {s} (≈[] p p≈0) r≈s = begin + p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 p≈0) ⟩ + [] ≈⟨ zerosm≈zerosn ⟩ + [] * s ∎ +*-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin + (a ∷ p) * [] + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + [] + p * (0# ∷ []) + ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ + [] + q * (0# ∷ s) + ≈⟨ +-congˡ (zerosm≈zerosn) ⟩ + zeros l + q * (0# ∷ s) + ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero b s s≈0)) ⟨ + (b · s) + q * (0# ∷ s) + ≈⟨ cast-p≈p (cast-lem l n) ⟨ + (b ∷ q) * s + ∎ +*-cong {suc m} {k = k} {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) (≈[] r s≈0) = begin + (a ∷ p) * r + ≈⟨ cast-p≈p (cast-lem k m) ⟩ + (a · r) + p * (0# ∷ r) + ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ ([]≈ r s≈0))) ⟨ + (a · r) + q * (0# ∷ []) + ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero a r s≈0)) ⟩ + zeros k + q * (0# ∷ []) + ≈⟨ +-congˡ zerosm≈zerosn ⟩ + (b · []) + q * (0# ∷ []) + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + (b ∷ q) * [] + ∎ +*-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin + (a ∷ p) * (c ∷ r) + ≈⟨ cast-p≈p (cast-lem (suc k) m)⟩ + (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consˡ (CR.*-cong (CR.sym a≈b) (CR.sym c≈d))) ⟨ + (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consʳ ((·-cong (CR.sym a≈b) (sym r≈s)))) ⟨ + (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) + ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ + (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) + ≈⟨ cast-p≈p (cast-lem (suc l) n) ⟨ + (b ∷ q) * (d ∷ s) + ∎ + +*-congʳ : q ≈ r → p * q ≈ p * r +*-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r + +*-congˡ : p ≈ q → p * r ≈ q * r +*-congˡ p≈q = *-cong p≈q refl + +qIsZero⇒p*qIsZero : (p : Poly m) → IsZero q → IsZero (p * q) +qIsZero⇒p*qIsZero {m} {_} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) +qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) + = ≈0⇒IsZero ( + begin + p * (b ∷ q) ≈⟨ *-congʳ {p = p} (consˡ b≈0) ⟩ + p * (0# ∷ q) ≈⟨ *-distrib-shift p q ⟩ + 0# ∷ (p * q) ≈⟨ consʳ (IsZero⇒≈0 (qIsZero⇒p*qIsZero p q≈0)) ⟩ + 0# ∷ (zeros m) ≈⟨ zerosm≈zerosn ⟩ + zeros m ∎ + ) + +q≈[]→p*q≈[] : (p : Poly n) → q ≈ [] → p * q ≈ [] +q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero q≈0)) + +*-comm : (p : Poly m) → (q : Poly n) → p * q ≈ q * p +*-comm {_} {_} [] [] = refl +*-comm {_} {suc n} [] (b ∷ q) = sym ( begin + (b ∷ q) * [] + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + [] + (q * (0# ∷ [])) + ≈⟨ +-congʳ (q≈[]→p*q≈[] q zerosm≈zerosn) ⟩ + [] + [] + ≈⟨ zerosm≈zerosn ⟩ + zeros (pred (0 ℕ.+ suc n)) + ∎) +*-comm {suc m} {_} (a ∷ p) [] = begin + (a ∷ p) * [] + ≈⟨(cast-p≈p (cong pred n+1≡sucn+0))⟩ + [] + p * (0# ∷ []) + ≈⟨ +-congʳ (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ + [] + [] + ≈⟨ zerosm≈zerosn ⟩ + zeros (pred (0 ℕ.+ suc m)) + ∎ +*-comm {suc m} {suc n} (a ∷ p) (b ∷ q) = begin + (a ∷ p) * (b ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + a · (b ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congˡ (*-comm-lem (a *A b) a) ⟩ + (a *A b ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congˡ (consˡ (CR.+-congʳ (CR.*-comm a b))) ⟩ + (b *A a ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congʳ step1 ⟩ + (b *A a ∷ []) + (a · (0# ∷ q)) + ((b · (0# ∷ p)) + (0# ∷ 0# ∷ p * q)) + ≈⟨ step2 ⟩ + ((b *A a ∷ []) + b · (0# ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ p * q)) + ≈⟨ step3 ⟩ + (b · (a ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))) + ≈⟨ +-congʳ step4 ⟨ + (b · (a ∷ p) + q * (0# ∷ a ∷ p)) + ≈⟨ cast-p≈p (cast-lem (suc m) n) ⟨ + (b ∷ q) * (a ∷ p) + ∎ + where + *-comm-lem : ∀ {m} → {p : Poly m} → (a b : A) → + a ∷ (b · p) ≈ (a ∷ []) + (b · (0# ∷ p)) + *-comm-lem {p = []} a b + = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ b)) (CR.+-identityʳ a))) + *-comm-lem {p = a ∷ p} b c + = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ c)) (CR.+-identityʳ b))) + + step1 = begin + p * (0# ∷ b ∷ q) + ≈⟨ *-distrib-shift p (b ∷ q) ⟩ + 0# ∷ (p * (b ∷ q)) + ≈⟨ consʳ (*-comm p (b ∷ q)) ⟩ + 0# ∷ ((b ∷ q) * p) + ≈⟨ consʳ (cast-p≈p (cast-lem m n)) ⟩ + 0# ∷ (b · p + q * (0# ∷ p)) + ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ + (0# ∷ (b · p)) + (0# ∷ (q * (0# ∷ p))) + ≈⟨ +-congˡ {r = (0# ∷ (q * (0# ∷ p)))} (·-distrib-shift b p) ⟨ + (b · (0# ∷ p)) + (0# ∷ (q * (0# ∷ p))) + ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (*-distrib-shift q p)) ⟩ + b · (0# ∷ p) + (0# ∷ 0# ∷ (q * p)) + ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (consʳ (*-comm q p))) ⟩ + b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) + ∎ + + step2 + = middleFour (b *A a ∷ []) (a · (0# ∷ q)) + (b · (0# ∷ p)) (0# ∷ 0# ∷ (p * q)) + + step3 + = +-congˡ {r = a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))} + (sym (*-comm-lem {p = p} (b *A a) b)) + + step4 = begin + q * (0# ∷ a ∷ p) + ≈⟨ *-distrib-shift q (a ∷ p) ⟩ + 0# ∷ (q * (a ∷ p)) + ≈⟨ consʳ (*-comm q (a ∷ p)) ⟩ + 0# ∷ ((a ∷ p) * q) + ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟩ + 0# ∷ (a · q + p * (0# ∷ q)) + ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ + (0# ∷ (a · q)) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ +-congˡ {r = (0# ∷ (p * (0# ∷ q)))} (·-distrib-shift a q) ⟨ + a · (0# ∷ q) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ +-congʳ {p = a · (0# ∷ q)} (consʳ (*-distrib-shift p q))⟩ + a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) + ∎ + +shift-distrib-+ : (p : Poly m) → (q : Poly n) → + shift (p + q) ≈ (shift p) + (shift q) +shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl + +0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ (shift p) * q +0∷[p*q]≈[0∷p]*q p q = begin + 0# ∷ (p * q) ≈⟨ consʳ (*-comm p q) ⟩ + 0# ∷ (q * p) ≈⟨ *-distrib-shift q p ⟨ + q * (0# ∷ p) ≈⟨ *-comm q (0# ∷ p) ⟩ + (0# ∷ p) * q ∎ + +0∷[p*q]≈q*[0∷p] : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ q * (shift p) +0∷[p*q]≈q*[0∷p] p q = begin + 0# ∷ (p * q) ≈⟨ 0∷[p*q]≈[0∷p]*q p q ⟩ + (0# ∷ p) * q ≈⟨ *-comm (0# ∷ p) q ⟩ + q * (0# ∷ p) ∎ + +*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (q + r) * p ≈ (q * p) + (r * p) +*-distribʳ-+ {_} {_} {_} [] q r = begin + (q + r) * [] + ≈⟨ q≈[]→p*q≈[] (q + r) refl ⟩ + [] + [] + ≈⟨ +-cong (zeroʳ q) (zeroʳ r)⟨ + (q * []) + (r * []) + ∎ +*-distribʳ-+ {suc m} {n} {k} (a ∷ p) q r = begin + ((q + r) * (a ∷ p)) + ≈⟨ *-comm (q + r) (a ∷ p) ⟩ + ((a ∷ p) * (q + r)) + ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ + (a · (q + r)) + (p * (0# ∷ (q + r))) + ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ + (a · q + a · r) + (0# ∷ (p * (q + r))) + ≈⟨ +-congʳ step5 ⟩ + (a · q + a · r) + ((0# ∷ (q * p)) + (0# ∷ (r * p))) + ≈⟨ middleFour (a · q) (a · r) (0# ∷ (q * p)) (0# ∷ (r * p)) ⟩ + (a · q + (0# ∷ (q * p))) + (a · r + (0# ∷ (r * p))) + ≈⟨ +-congˡ step6 ⟩ + q * (a ∷ p) + (a · r + (0# ∷ r * p)) + ≈⟨ +-congʳ step7 ⟩ + (q * (a ∷ p) + r * (a ∷ p)) + ∎ + where + step5 = begin + 0# ∷ p * (q + r) + ≈⟨ consʳ (*-comm p (q + r)) ⟩ + 0# ∷ ((q + r) * p) + ≈⟨ consʳ (*-distribʳ-+ p q r) ⟩ + 0# ∷ q * p + r * p + ≈⟨ shift-distrib-+ (q * p) (r * p) ⟩ + (0# ∷ q * p) + (0# ∷ r * p) ∎ + + step6 = begin + a · q + (0# ∷ q * p) + ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] q p) ⟩ + a · q + p * (0# ∷ q) + ≈⟨ cast-p≈p (cast-lem n m) ⟨ + (a ∷ p) * q + ≈⟨ *-comm (a ∷ p) q ⟩ + q * (a ∷ p) ∎ + + step7 = begin + a · r + (0# ∷ r * p) + ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] r p) ⟩ + a · r + p * (0# ∷ r) + ≈⟨ cast-p≈p (cast-lem k m) ⟨ + (a ∷ p) * r + ≈⟨ *-comm (a ∷ p) r ⟩ + r * (a ∷ p) ∎ + +·-distrib-* : (p : Poly m) → (q : Poly n) → (a : A) → + a · (p * q) ≈ (a · p) * q +·-distrib-* {_} {n} [] q a = begin + a · ([] * q) ≈⟨ ·-congʳ zerosm≈zerosn ⟩ + a · [] ≈⟨ zerosm≈zerosn ⟨ + (a · []) * q ∎ +·-distrib-* {suc m} {_} (b ∷ p) [] a = begin + a · ((b ∷ p) * []) + ≈⟨ a·-cong (cast-p≈p (cong pred n+1≡sucn+0)) ⟩ + a · ((b · []) + (p * (0# ∷ []))) + ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ + a · (p * (0# ∷ [])) + ≈⟨ a·-cong (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ + [] + ≈⟨ q≈[]→p*q≈[] ((a · p)) zerosm≈zerosn ⟨ + (a · p) * (0# ∷ []) + ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ + ((a *A b) · []) + ((a · p) * (0# ∷ [])) + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + (a · (b ∷ p)) * [] + ∎ +·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin + a · ((b ∷ p) * (c ∷ q)) + ≈⟨ a·-cong (cast-p≈p (cast-lem (suc n) m)) ⟩ + a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) + ≈⟨ ·-dist ⟩ + a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congˡ (cons (CR.sym (CR.*-assoc a b c)) ·-assoc) ⟩ + (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ + (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟨ + (a · (b ∷ p)) * (c ∷ q) + ∎ + +*-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (p * q) * r ≈ p * (q * r) +*-assoc {_} {n} {k} [] q r = begin + zeros (n ℕ.∸ 1) * r + ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 (zerosIsZero (n ℕ.∸ 1))) ⟩ + [] + ≈⟨ zerosm≈zerosn ⟩ + zeros (pred (0 ℕ.+ pred (n ℕ.+ k))) + ∎ +*-assoc {suc m} {n} {k} (a ∷ p) q r = begin + ((a ∷ p) * q) * r + ≈⟨ *-congˡ (cast-p≈p (cast-lem n m)) ⟩ + ((a · q) + (p * (0# ∷ q))) * r + ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ + ((a · q) + (0# ∷ (p * q))) * r + ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ + ((a · q) * r) + ((0# ∷ (p * q)) * r) + ≈⟨ +-congʳ step8 ⟨ + ((a · q) * r) + (0# ∷ (p * (q * r))) + ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ + (a · (q * r)) + (0# ∷ (p * (q * r))) + ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ + (a · (q * r)) + (p * (0# ∷ (q * r))) + ≈⟨ cast-p≈p (cast-lem (pred (n ℕ.+ k)) m) ⟨ + (a ∷ p) * (q * r) + ∎ + where + step8 = begin + 0# ∷ (p * (q * r)) + ≈⟨ consʳ (*-assoc p q r) ⟨ + 0# ∷ ((p * q) * r) + ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ + (0# ∷ (p * q)) * r + ≈⟨ cast-p≈p (cast-lem k (m ℕ.+ n ℕ.∸ 1)) ⟩ + (0# · r) + ((p * q) * (0# ∷ r)) + ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r CR.refl) ) ⟩ + zeros k + ((p * q) * (0# ∷ r)) + ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ + zeros k + (0# ∷ ((p * q) * r)) + ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ + zeros k + ((0# ∷ (p * q)) * r) + ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ + (0# ∷ (p * q)) * r + ∎ + +--------------------------------------------------------------------- +-- Multiplicative identity + +*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p +*-identityʳ {0} [] = zerosm≈zerosn +*-identityʳ {suc n} (a ∷ p) = begin + (a ∷ p) * (1# ∷ []) + ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ + (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congˡ (consˡ (CR.*-identityʳ a)) ⟩ + (a ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ + (a ∷ []) + (0# ∷ (p * (1# ∷ []))) + ≈⟨ cons (CR.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ + a ∷ (p * (1# ∷ [])) + ≈⟨ consʳ (*-identityʳ p) ⟩ + a ∷ p ∎ diff --git a/src/Algebra/Polynomial/Properties.agda b/src/Algebra/Polynomial/Properties.agda new file mode 100644 index 0000000000..b888069cfb --- /dev/null +++ b/src/Algebra/Polynomial/Properties.agda @@ -0,0 +1,304 @@ +open import Algebra.Bundles using (Magma; CommutativeRing) + +module Algebra.Polynomial.Properties + {ℓ₁ ℓ₂} + (CR : CommutativeRing ℓ₁ ℓ₂) + where + +import Algebra.Consequences.Setoid as C + using (comm∧distrʳ⇒distrˡ ; comm∧idʳ⇒idˡ) +import Algebra.Definitions as Def +import Algebra.Polynomial.Poly.Properties CR as Poly +open import Algebra.Polynomial.Base CR + using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ + ; zero; one; -_; refl; sym; trans) +open import Algebra.Properties.AbelianGroup +open import Algebra.Properties.Ring +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsGroup; IsAbelianGroup; IsCommutativeMonoid; IsSemiring + ; IsRing; IsCommutativeSemiring; IsCommutativeRing ) +open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) +open import Data.Product.Base using (_,_) +open import Data.Vec.Base as Vec using ([]; _∷_) +open import Relation.Binary using (IsEquivalence) + +open Polynomial + +open CommutativeRing CR + using (0#; 1#) + renaming (Carrier to A) + +open Def _≈_ + +private + variable + P Q R : Polynomial + +-------------------------------------------------------------- +-- Algebraic properties of addition + ++-identityˡ : LeftIdentity zero _+_ ++-identityˡ P = Poly.+-identityˡ (polynomial P) + ++-identityʳ : RightIdentity zero _+_ ++-identityʳ P = Poly.+-identityʳ (polynomial P) + ++-identity : Identity zero _+_ ++-identity = +-identityˡ , +-identityʳ + ++-comm : Commutative _+_ ++-comm P Q = Poly.+-comm (polynomial P) (polynomial Q) + ++-assoc : Associative _+_ ++-assoc P Q R + = Poly.+-assoc (polynomial P) (polynomial Q) (polynomial R) + ++-inverseˡ : LeftInverse zero -_ _+_ ++-inverseˡ P = Poly.+-inverseˡ (polynomial P) + ++-inverseʳ : RightInverse zero -_ _+_ ++-inverseʳ P = Poly.+-inverseʳ (polynomial P) + ++-inverse : Inverse zero -_ _+_ ++-inverse = +-inverseˡ , +-inverseʳ + +-‿cong : P ≈ Q → - P ≈ - Q +-‿cong = Poly.-‿cong + +--------------------------------------------------------------- +-- Additive structures + +isEquivalence : IsEquivalence _≈_ +isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + ++-isMagma : IsMagma _≈_ _+_ ++-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = Poly.+-cong + } + ++-isSemigroup : IsSemigroup _≈_ _+_ ++-isSemigroup = record + { isMagma = +-isMagma + ; assoc = +-assoc + } + ++-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ ++-isCommutativeSemigroup = record + { isSemigroup = +-isSemigroup + ; comm = +-comm + } + ++-isMonoid : IsMonoid _≈_ _+_ zero ++-isMonoid = record + { isSemigroup = +-isSemigroup + ; identity = +-identity + } + ++-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ zero ++-isCommutativeMonoid = record + { isMonoid = +-isMonoid + ; comm = +-comm + } + ++-isGroup : IsGroup _≈_ _+_ zero -_ ++-isGroup = record + { isMonoid = +-isMonoid + ; inverse = +-inverse + ; ⁻¹-cong = -‿cong + } + ++-isAbelianGroup : IsAbelianGroup _≈_ _+_ zero -_ ++-isAbelianGroup = record + { isGroup = +-isGroup + ; comm = +-comm + } + +--------------------------------------------------------------- +-- Additive bundles + ++-magma : Algebra.Bundles.Magma _ _ ++-magma = record + { isMagma = +-isMagma + } + ++-semigroup : Algebra.Bundles.Semigroup _ _ ++-semigroup = record + { isSemigroup = +-isSemigroup + } + ++-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ ++-commutativeSemigroup = record + { isCommutativeSemigroup = +-isCommutativeSemigroup + } + ++-monoid : Algebra.Bundles.Monoid _ _ ++-monoid = record + { isMonoid = +-isMonoid + } + ++-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ ++-commutativeMonoid = record + { isCommutativeMonoid = +-isCommutativeMonoid + } + ++-abelianGroup : Algebra.Bundles.AbelianGroup _ _ ++-abelianGroup = record + { isAbelianGroup = +-isAbelianGroup + } + +----------------------------------------------------------------- +-- Algebraic properties of multiplication + +a·p≈a∷[]*p : (a : A) → (P : Polynomial) → a · P ≈ (1 , (a ∷ [])) * P +a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) + +*-comm : Commutative _*_ +*-comm P Q = Poly.*-comm (polynomial P) (polynomial Q) + +*-identityʳ : RightIdentity one _*_ +*-identityʳ P = Poly.*-identityʳ (polynomial P) + +*-identityˡ : LeftIdentity one _*_ +*-identityˡ = C.comm∧idʳ⇒idˡ (Magma.setoid +-magma) *-comm *-identityʳ + +*-identity : Identity one _*_ +*-identity = *-identityˡ , *-identityʳ + +*-zeroˡ : LeftZero zero _*_ +*-zeroˡ P = Poly.zeroˡ (polynomial P) + +*-zeroʳ : RightZero zero _*_ +*-zeroʳ P = Poly.zeroʳ (polynomial P) + +*-zero : Zero zero _*_ +*-zero = *-zeroˡ , *-zeroʳ + +*-assoc : Associative _*_ +*-assoc P Q R + = Poly.*-assoc (polynomial P) (polynomial Q) (polynomial R) + +*-distribʳ-+ : _*_ DistributesOverʳ _+_ +*-distribʳ-+ P Q R + = Poly.*-distribʳ-+ (polynomial P) (polynomial Q) (polynomial R) + +*-distribˡ-+ : _*_ DistributesOverˡ _+_ +*-distribˡ-+ + = C.comm∧distrʳ⇒distrˡ (Magma.setoid +-magma) Poly.+-cong *-comm *-distribʳ-+ + +*-distrib-+ : _*_ DistributesOver _+_ +*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ + +------------------------------------------------------------------ +-- Multiplicative structure + +*-isMagma : IsMagma _≈_ _*_ +*-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = Poly.*-cong + } + +*-isSemigroup : IsSemigroup _≈_ _*_ +*-isSemigroup = record + { isMagma = *-isMagma + ; assoc = *-assoc + } + +*-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _*_ +*-isCommutativeSemigroup = record + { isSemigroup = *-isSemigroup + ; comm = *-comm + } + +*-isMonoid : IsMonoid _≈_ _*_ one +*-isMonoid = record + { isSemigroup = *-isSemigroup + ; identity = *-identity + } + +*-isCommutativeMonoid : IsCommutativeMonoid _≈_ _*_ one +*-isCommutativeMonoid = record + { isMonoid = *-isMonoid + ; comm = *-comm + } + ++-*-isSemiring : IsSemiring _≈_ _+_ _*_ zero one ++-*-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = +-isCommutativeMonoid + ; *-cong = Poly.*-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + ; zero = *-zero + } + ++-*-isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ zero one ++-*-isCommutativeSemiring = record + { isSemiring = +-*-isSemiring + ; *-comm = *-comm + } + ++-*-isRing : IsRing _≈_ _+_ _*_ -_ zero one ++-*-isRing = record + { +-isAbelianGroup = +-isAbelianGroup + ; *-cong = Poly.*-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + ++-*-isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ zero one ++-*-isCommutativeRing = record + { isRing = +-*-isRing + ; *-comm = *-comm + } + +--------------------------------------------------------------- +-- Multiplicative bundles + +*-magma : Algebra.Bundles.Magma _ _ +*-magma = record + { isMagma = *-isMagma + } + +*-semigroup : Algebra.Bundles.Semigroup _ _ +*-semigroup = record + { isSemigroup = *-isSemigroup + } + +*-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ +*-commutativeSemigroup = record + { isCommutativeSemigroup = *-isCommutativeSemigroup + } + +*-monoid : Algebra.Bundles.Monoid _ _ +*-monoid = record + { isMonoid = *-isMonoid + } + +*-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ +*-commutativeMonoid = record + { isCommutativeMonoid = *-isCommutativeMonoid + } + ++-*-commutativeSemiring : Algebra.Bundles.CommutativeSemiring _ _ ++-*-commutativeSemiring = record + { isCommutativeSemiring = +-*-isCommutativeSemiring + } + ++-*-ring : Algebra.Bundles.Ring _ _ ++-*-ring = record + { isRing = +-*-isRing + } + ++-*-commutativeRing : Algebra.Bundles.CommutativeRing _ _ ++-*-commutativeRing = record + { isCommutativeRing = +-*-isCommutativeRing + } diff --git a/src/Algebra/Properties/Group.agda b/src/Algebra/Properties/Group.agda index 8277f4feb7..54c5d469fe 100644 --- a/src/Algebra/Properties/Group.agda +++ b/src/Algebra/Properties/Group.agda @@ -127,6 +127,19 @@ x≈y⇒x∙y⁻¹≈ε {x} {y} x≈y = begin y ∙ y ⁻¹ ≈⟨ inverseʳ y ⟩ ε ∎ +x≈ε⇒x⁻¹≈ε : ∀ {x} → x ≈ ε → x ⁻¹ ≈ ε +x≈ε⇒x⁻¹≈ε {x} x≈ε = begin + x ⁻¹ ≈⟨ ⁻¹-cong x≈ε ⟩ + ε ⁻¹ ≈⟨ ε⁻¹≈ε ⟩ + ε ∎ + +x⁻¹≈ε⇒x≈ε : ∀ {x} → x ⁻¹ ≈ ε → x ≈ ε +x⁻¹≈ε⇒x≈ε {x} x⁻¹≈ε = begin + x ≈⟨ ⁻¹-involutive x ⟨ + x ⁻¹ ⁻¹ ≈⟨ ⁻¹-cong x⁻¹≈ε ⟩ + ε ⁻¹ ≈⟨ ε⁻¹≈ε ⟩ + ε ∎ + ⁻¹-injective : Injective _≈_ _≈_ _⁻¹ ⁻¹-injective = selfInverse⇒injective ⁻¹-selfInverse From af24b17952f91a0f6723c81f56df89dd24d6164d Mon Sep 17 00:00:00 2001 From: Sam Park Date: Thu, 11 Sep 2025 21:03:25 -0400 Subject: [PATCH 2/8] This is a draft on polynomial data types with proof of the universal property --- src/Algebra/Polynomial/Base.agda | 12 +- src/Algebra/Polynomial/Base1.agda | 82 +++ src/Algebra/Polynomial/Base2.agda | 82 +++ src/Algebra/Polynomial/Morphism/Morphism.agda | 510 ++++++++++++++ src/Algebra/Polynomial/Poly/Base.agda | 43 +- src/Algebra/Polynomial/Poly/Base1.agda | 148 ++++ src/Algebra/Polynomial/Poly/Base2.agda | 149 ++++ src/Algebra/Polynomial/Poly/Properties.agda | 450 ++++++------ src/Algebra/Polynomial/Poly/Properties1.agda | 646 +++++++++++++++++ src/Algebra/Polynomial/Poly/Properties2.agda | 663 ++++++++++++++++++ src/Algebra/Polynomial/Properties.agda | 132 +--- src/Algebra/Polynomial/Properties1.agda | 292 ++++++++ src/Algebra/Polynomial/Properties2.agda | 352 ++++++++++ 13 files changed, 3175 insertions(+), 386 deletions(-) create mode 100644 src/Algebra/Polynomial/Base1.agda create mode 100644 src/Algebra/Polynomial/Base2.agda create mode 100644 src/Algebra/Polynomial/Morphism/Morphism.agda create mode 100644 src/Algebra/Polynomial/Poly/Base1.agda create mode 100644 src/Algebra/Polynomial/Poly/Base2.agda create mode 100644 src/Algebra/Polynomial/Poly/Properties1.agda create mode 100644 src/Algebra/Polynomial/Poly/Properties2.agda create mode 100644 src/Algebra/Polynomial/Properties1.agda create mode 100644 src/Algebra/Polynomial/Properties2.agda diff --git a/src/Algebra/Polynomial/Base.agda b/src/Algebra/Polynomial/Base.agda index 920ab3f2a8..84ae5763e0 100644 --- a/src/Algebra/Polynomial/Base.agda +++ b/src/Algebra/Polynomial/Base.agda @@ -1,17 +1,17 @@ -open import Algebra.Bundles using (CommutativeRing) +open import Algebra.Bundles using (Semiring) open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) open import Data.Product.Base using (_,_) open import Data.Vec.Base as Vec using ([]; _∷_) import Level as L module Algebra.Polynomial.Base - {ℓ₁ ℓ₂} (CR : CommutativeRing ℓ₁ ℓ₂) + {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base CR as Poly +open import Algebra.Polynomial.Poly.Base SR as Poly using (Poly; zeros) -open CommutativeRing CR +open Semiring SR using (0#; 1#) renaming (Carrier to A) @@ -65,10 +65,6 @@ one = (1 , (1# ∷ [])) shift : Polynomial → Polynomial shift (m , p) = (suc m , Poly.shift p) --- Negation --_ : Polynomial → Polynomial -- (m , p) = (m , Poly.- p) - -- Scaling _·_ : A → Polynomial → Polynomial a · (m , p) = (m , a Poly.· p) diff --git a/src/Algebra/Polynomial/Base1.agda b/src/Algebra/Polynomial/Base1.agda new file mode 100644 index 0000000000..bc68980ffd --- /dev/null +++ b/src/Algebra/Polynomial/Base1.agda @@ -0,0 +1,82 @@ +open import Algebra.Bundles using (Ring) +open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) +open import Data.Product.Base using (_,_) +open import Data.Vec.Base as Vec using ([]; _∷_) +import Level as L + +module Algebra.Polynomial.Base1 + {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Base1 R as Poly + using (Poly; zeros) + +open Ring R + using (0#; 1#) + renaming (Carrier to A) + +private + variable + m n k : ℕ + p : Poly m + q : Poly n + r : Poly k + +--------------------------------------------------- +-- Types + +record Polynomial : Set ℓ₁ where + constructor _,_ + field + degree : ℕ + polynomial : Poly degree + +private + variable + P Q W : Polynomial + +-- Equivalence relation for representations of polynomials +infix 4 _≈_ +_≈_ : Polynomial → Polynomial → Set (ℓ₁ L.⊔ ℓ₂) +(m , p) ≈ (n , q) = p Poly.≈ q + +refl : P ≈ P +refl = Poly.refl + +sym : P ≈ Q → Q ≈ P +sym = Poly.sym + +trans : P ≈ Q → Q ≈ W → P ≈ W +trans = Poly.trans + +-------------------------------------------------- +-- Constants + +zero : Polynomial +zero = (0 , []) + +one : Polynomial +one = (1 , (1# ∷ [])) + +--------------------------------------------------- +-- Operations + +-- Multiply the polynomial by a factor of x +shift : Polynomial → Polynomial +shift (m , p) = (suc m , Poly.shift p) + +-- Negation +-_ : Polynomial → Polynomial +- (m , p) = (m , Poly.- p) + +-- Scaling +_·_ : A → Polynomial → Polynomial +a · (m , p) = (m , a Poly.· p) + +-- Addition +_+_ : Polynomial → Polynomial → Polynomial +(m , p) + (n , q) = (m ⊔ n , p Poly.+ q) + +-- Multiplication +_*_ : Polynomial → Polynomial → Polynomial +(m , p) * (n , q) = (pred (m ℕ.+ n) , p Poly.* q) diff --git a/src/Algebra/Polynomial/Base2.agda b/src/Algebra/Polynomial/Base2.agda new file mode 100644 index 0000000000..a4316f82f8 --- /dev/null +++ b/src/Algebra/Polynomial/Base2.agda @@ -0,0 +1,82 @@ +open import Algebra.Bundles using (CommutativeRing) +open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) +open import Data.Product.Base using (_,_) +open import Data.Vec.Base as Vec using ([]; _∷_) +import Level as L + +module Algebra.Polynomial.Base2 + {ℓ₁ ℓ₂} (CR : CommutativeRing ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Base2 CR as Poly + using (Poly; zeros) + +open CommutativeRing CR + using (0#; 1#) + renaming (Carrier to A) + +private + variable + m n k : ℕ + p : Poly m + q : Poly n + r : Poly k + +--------------------------------------------------- +-- Types + +record Polynomial : Set ℓ₁ where + constructor _,_ + field + degree : ℕ + polynomial : Poly degree + +private + variable + P Q R : Polynomial + +-- Equivalence relation for representations of polynomials +infix 4 _≈_ +_≈_ : Polynomial → Polynomial → Set (ℓ₁ L.⊔ ℓ₂) +(m , p) ≈ (n , q) = p Poly.≈ q + +refl : P ≈ P +refl = Poly.refl + +sym : P ≈ Q → Q ≈ P +sym = Poly.sym + +trans : P ≈ Q → Q ≈ R → P ≈ R +trans = Poly.trans + +-------------------------------------------------- +-- Constants + +zero : Polynomial +zero = (0 , []) + +one : Polynomial +one = (1 , (1# ∷ [])) + +--------------------------------------------------- +-- Operations + +-- Multiply the polynomial by a factor of x +shift : Polynomial → Polynomial +shift (m , p) = (suc m , Poly.shift p) + +-- Negation +-_ : Polynomial → Polynomial +- (m , p) = (m , Poly.- p) + +-- Scaling +_·_ : A → Polynomial → Polynomial +a · (m , p) = (m , a Poly.· p) + +-- Addition +_+_ : Polynomial → Polynomial → Polynomial +(m , p) + (n , q) = (m ⊔ n , p Poly.+ q) + +-- Multiplication +_*_ : Polynomial → Polynomial → Polynomial +(m , p) * (n , q) = (pred (m ℕ.+ n) , p Poly.* q) diff --git a/src/Algebra/Polynomial/Morphism/Morphism.agda b/src/Algebra/Polynomial/Morphism/Morphism.agda new file mode 100644 index 0000000000..05020c0b93 --- /dev/null +++ b/src/Algebra/Polynomial/Morphism/Morphism.agda @@ -0,0 +1,510 @@ +-- Polynomial Morphisms +open import Algebra.Bundles + using (CommutativeRing ; CommutativeSemiring; Ring; + SemiringWithoutAnnihilatingZero; Semiring) + +module ALgebra.Polynomial.Morphism.Morphism + {ℓ₁ ℓ₂} + (R : CommutativeRing ℓ₁ ℓ₂) + where + +open import Algebra.Bundles.Raw using (RawRing) +open import Algebra.Morphism.Bundles + using (RingHomomorphism ; MagmaHomomorphism ; MonoidHomomorphism) +open import Algebra.Morphism.Structures + using (IsRingHomomorphism ; IsMagmaHomomorphism ; IsSemiringHomomorphism; + IsNearSemiringHomomorphism ; IsMonoidHomomorphism) +open import Algebra.Polynomial.Poly.Base2 R + using (Poly; []≈ ; ≈[]; cons ; cast-lem ; consˡ ; consʳ) + renaming ( sym to P-sym ; _·_ to _·P_ + ; _+_ to _+P_ ; _*_ to _*P_; _≈_ to _≈P_; -_ to -P_) +open import Algebra.Polynomial.Poly.Properties2 R + using (cast-p≈p; IsZero⇒≈0; ≈0⇒IsZero; a·p≈a∷[]*p ; *-distrib-shift) + renaming (+-identityˡ to +-P-identityˡ ; +-identityʳ to +-P-identityʳ + ; zeroˡ to P-zeroˡ; zeroʳ to P-zeroʳ ; *-comm to *-P-comm ) +open import Algebra.Polynomial.Base2 R +open import Algebra.Polynomial.Properties2 R as P + using (+-identityˡ; +-identityʳ; +-*-commutativeRing; *-zeroˡ ; *-zeroʳ) + +import Algebra.Definitions.RawSemiring as Def +import Algebra.Definitions as D +open import Algebra.Properties.Group +open import Algebra.Properties.Ring +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All +open import Data.Product.Base using (proj₁ ; proj₂) +import Level as L +import Relation.Binary.Morphism.Structures as S + using (IsRelHomomorphism) +open import Relation.Binary.PropositionalEquality.Core using (cong) + +module R = CommutativeRing R +open R + hiding (distrib) + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_ + ; 0# to A0# + ; 1# to A1#) + +private + variable + m n k l : ℕ + a b c d : A + p : Poly m + q : Poly n + P : Polynomial + Q : Polynomial + +module PolynomialRingMorphism + {ℓ₃ ℓ₄} + (B : CommutativeRing ℓ₃ ℓ₄) + (β : CommutativeRing.Carrier B) + + (f : RingHomomorphism {ℓ₁} {ℓ₂} + (CommutativeRing.rawRing R) (CommutativeRing.rawRing B) ) + where + + module B = CommutativeRing B + open B + using (semiringWithoutOne ; isSemiringWithoutOne ; distrib) + renaming + (_≈_ to _≈B_ + ; _+_ to _+B_ + ; _*_ to _*B_ + ; -_ to -B_ + ; setoid to B-Set) + using (0#; 1#) + + open import Relation.Binary.Reasoning.Setoid B-Set + + open RingHomomorphism f using (⟦_⟧) + open D {A = B.Carrier} (_≈B_) + using (_MiddleFourExchange_; _DistributesOverˡ_) + + eval-p : Poly m → CommutativeRing.Carrier B + eval-p [] = 0# + eval-p (a ∷ p) = ⟦ a ⟧ +B (β *B eval-p p ) + + + eval : Polynomial → CommutativeRing.Carrier B + eval (ℕ.zero , []) = 0# + eval (suc n , (a ∷ p)) = ⟦ a ⟧ +B (β *B eval (n , p) ) + + + + eval-equiv : (p : Poly m) → eval-p p ≈B (eval (m , p)) + eval-equiv {ℕ.zero} [] = B.refl + eval-equiv {suc m} (a ∷ p) = begin + ⟦ a ⟧ +B β *B eval-p p + ≈⟨ B.+-congˡ (B.*-congˡ (eval-equiv p) ) ⟩ + ⟦ a ⟧ +B β *B eval (m , p) + ∎ + + + eval-p-cong : ∀ {p : Poly m} → ∀ {q : Poly n} → p ≈P q → (eval-p p) ≈B (eval-p q) + eval-p-cong {p = []} {[]} P≈Q = B.refl + eval-p-cong {p = []} {b ∷ q} p≈q = begin + eval-p [] + ≈⟨ B.zeroʳ β ⟨ + β *B 0# + ≈⟨ B.+-identityˡ (β *B eval-p []) ⟨ + 0# +B β *B eval-p [] + ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo + (RingHomomorphism.+-monoidHomomorphism f)) ⟨ + ⟦ A0# ⟧ +B β *B eval-p [] + ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-cong {p = []} {q = q} + (P-sym (IsZero⇒≈0 (tail (≈0⇒IsZero (P-sym p≈q))))))) ⟩ + ⟦ A0# ⟧ +B β *B eval-p q + ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong + (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero (P-sym p≈q)))) ⟨ + eval-p (b ∷ q) + ∎ + eval-p-cong {p = a ∷ p} {[]} p≈q = begin + eval-p (a ∷ p) + ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong + (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero p≈q))) ⟩ + ⟦ A0# ⟧ +B β *B eval-p p + ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-cong {p = p} {q = []} + (IsZero⇒≈0 (tail (≈0⇒IsZero p≈q))))) ⟩ + ⟦ A0# ⟧ +B β *B eval-p [] + ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo + (RingHomomorphism.+-monoidHomomorphism f)) ⟩ + 0# +B β *B eval-p [] + ≈⟨ B.+-congˡ (B.zeroʳ β) ⟩ + 0# +B 0# + ≈⟨ B.+-identityʳ 0# ⟩ + eval-p [] + ∎ + eval-p-cong {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) + = B.+-cong (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) a≈b) + (B.*-congˡ (eval-p-cong p≈q)) + + + eval-cong : P ≈ Q → eval P ≈B eval Q + eval-cong {P = (m , p)} {Q = (n , q)} P≈Q = begin + eval (m , p) + ≈⟨ eval-equiv p ⟨ + eval-p p + ≈⟨ eval-p-cong P≈Q ⟩ + eval-p q + ≈⟨ eval-equiv q ⟩ + eval (n , q) + ∎ + + + + eval-p-+-homomorphic : (p : Poly m) → (q : Poly n) → eval-p (p +P q) ≈B eval-p p +B eval-p q + eval-p-+-homomorphic [] q = begin + eval-p ([] +P q) + ≈⟨ eval-p-cong (+-P-identityˡ {m = 0} q) ⟩ + eval-p q + ≈⟨ B.+-identityˡ (eval-p q) ⟨ + eval-p [] +B eval-p q + ∎ + eval-p-+-homomorphic (a ∷ p) [] = B.sym (B.+-identityʳ (eval-p (a ∷ p))) + eval-p-+-homomorphic (a ∷ p) (b ∷ q) = begin + eval-p ((a ∷ p) +P (b ∷ q)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-+-homomorphic p q)) ⟩ + ⟦ a +A b ⟧ +B (β *B (eval-p p +B eval-p q)) + ≈⟨ B.+-congˡ (proj₁ distrib β (eval-p p) (eval-p q)) ⟩ + ⟦ a +A b ⟧ +B (β *B eval-p p +B β *B eval-p q) + ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.+-isMagmaHomomorphism f) a b) ⟩ + ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval-p p +B β *B eval-p q) + ≈⟨ B.+-assoc (⟦ a ⟧ +B ⟦ b ⟧) (β *B eval-p p) (β *B eval-p q) ⟨ + ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval-p p +B β *B eval-p q + ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval-p p)) ⟩ + ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval-p p) +B β *B eval-p q + ≈⟨ B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval-p p) (β *B eval-p q) ⟩ + ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval-p p +B (β *B eval-p q)) + ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval-p p) ⟦ b ⟧))) ⟨ + ⟦ a ⟧ +B ((β *B eval-p p) +B ⟦ b ⟧ +B (β *B eval-p q)) + ≈⟨ B.+-congˡ (B.+-assoc (β *B eval-p p) ⟦ b ⟧ (β *B eval-p q)) ⟩ + ⟦ a ⟧ +B (β *B eval-p p +B eval-p (b ∷ q)) + ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval-p p) (eval-p (b ∷ q)) ⟨ + ⟦ a ⟧ +B β *B eval-p p +B eval-p (b ∷ q) + ∎ + + + + eval-+-homomorphic : (P : Polynomial) → (Q : Polynomial) → eval (P + Q) ≈B eval P +B eval Q + eval-+-homomorphic (m , p) (n , q) = begin + eval ((m , p) + (n , q)) + ≈⟨ eval-equiv (p +P q) ⟨ + eval-p (p +P q) + ≈⟨ eval-p-+-homomorphic p q ⟩ + eval-p p +B eval-p q + ≈⟨ B.+-cong (eval-equiv p) (eval-equiv q) ⟩ + eval (m , p) +B eval (n , q) + ∎ + + eval-p-1#-homomorphic : eval-p (A1# ∷ []) ≈B 1# + eval-p-1#-homomorphic = begin + eval-p (A1# ∷ []) + ≈⟨ B.+-cong (RingHomomorphism.1#-homo f) (B.zeroʳ β) ⟩ + 1# +B 0# + ≈⟨ B.+-identityʳ 1# ⟩ + 1# + ∎ + + eval-1#-homomorphic : eval one ≈B 1# + eval-1#-homomorphic = begin + eval (1 , (A1# ∷ [])) + ≈⟨ eval-equiv (A1# ∷ []) ⟨ + eval-p (A1# ∷ []) + ≈⟨ eval-p-1#-homomorphic ⟩ + 1# + ∎ + + + eval-p-scale : (a : A) → (p : Poly m) → eval-p (a ·P p) ≈B eval-p (a ∷ []) *B (eval-p p) + eval-p-scale a [] = begin + 0# + ≈⟨ B.zeroʳ (⟦ a ⟧ +B β *B 0#) ⟨ + (⟦ a ⟧ +B β *B 0#) *B 0# + ∎ + eval-p-scale a (b ∷ p) = begin + ⟦ a *A b ⟧ +B β *B eval-p (a ·P p) + ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.*-isMagmaHomomorphism f) a b) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B eval-p (a ·P p) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-scale a p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B (eval-p (a ∷ []) *B (eval-p p)) + ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-congˡ (B.zeroʳ β)))) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B ((⟦ a ⟧ +B 0#) *B (eval-p p)) + ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧))) ⟩ + ⟦ a ⟧ *B ⟦ b ⟧ +B β *B ((⟦ a ⟧ *B eval-p p)) + ≈⟨ B.+-congˡ (B.*-assoc β ⟦ a ⟧ (eval-p p)) ⟨ + ⟦ a ⟧ *B ⟦ b ⟧ +B (β *B (⟦ a ⟧) *B (eval-p p)) + ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm β ⟦ a ⟧)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B (⟦ a ⟧ *B β) *B eval-p p + ≈⟨ B.+-congˡ (B.*-assoc ⟦ a ⟧ β (eval-p p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B ⟦ a ⟧ *B (β *B eval-p p) + ≈⟨ proj₁ distrib ⟦ a ⟧ ⟦ b ⟧ ( β *B eval-p p) ⟨ + (⟦ a ⟧) *B (⟦ b ⟧ +B β *B eval-p p) + ≈⟨ B.*-congʳ (B.+-identityʳ ⟦ a ⟧) ⟨ + (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-p p) + ≈⟨ B.*-congʳ (B.+-congˡ (B.zeroʳ β)) ⟨ + (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval-p p) + ∎ + + eval-p-shift : (p : Poly m) → eval-p (A0# ∷ p) ≈B β *B eval-p p + eval-p-shift p = begin + ⟦ A0# ⟧ +B β *B eval-p p + ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo + (RingHomomorphism.+-monoidHomomorphism f)) ⟩ + 0# +B β *B eval-p p + ≈⟨ B.+-identityˡ (β *B eval-p p) ⟩ + β *B eval-p p + ∎ + + + eval-p-*-homomorphic : (p : Poly m) → (q : Poly n) → eval-p (p *P q) ≈B eval-p p *B eval-p q + eval-p-*-homomorphic [] q = begin + eval-p ([] *P q) + ≈⟨ eval-p-cong (P-zeroˡ q) ⟩ + eval-p [] + ≈⟨ B.zeroˡ (eval-p q) ⟨ + eval-p [] *B eval-p q + ∎ + eval-p-*-homomorphic (a ∷ p) [] = begin + eval-p ((a ∷ p) *P []) + ≈⟨ eval-p-cong (P-zeroʳ (a ∷ p)) ⟩ + eval-p [] + ≈⟨ B.zeroʳ (eval-p (a ∷ p)) ⟨ + eval-p (a ∷ p) *B eval-p [] + ∎ + eval-p-*-homomorphic {suc m} {suc n} (a ∷ p) (b ∷ q) = begin + eval-p ((a ∷ p) *P (b ∷ q)) + ≈⟨ eval-p-cong (cast-p≈p (cast-lem (suc n) (m))) ⟩ + eval-p (a ·P (b ∷ q) +P p *P (A0# ∷ b ∷ q)) + ≈⟨ eval-p-+-homomorphic (a ·P (b ∷ q)) (p *P (A0# ∷ b ∷ q)) ⟩ + eval-p (a ·P (b ∷ q)) +B eval-p (p *P (A0# ∷ b ∷ q)) + ≈⟨ B.+-congʳ (eval-p-scale a (b ∷ q)) ⟩ + (eval-p (a ∷ []) *B eval-p (b ∷ q)) +B eval-p (p *P (A0# ∷ b ∷ q)) + ≈⟨ B.+-congˡ (eval-p-*-homomorphic p (A0# ∷ b ∷ q)) ⟩ + (eval-p (a ∷ []) *B eval-p (b ∷ q)) +B (eval-p p) *B eval-p (A0# ∷ b ∷ q) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-shift (b ∷ q))) ⟩ + (eval-p (a ∷ []) *B eval-p (b ∷ q)) +B (eval-p p) *B (β *B eval-p (b ∷ q)) + ≈⟨ B.+-congʳ (B.*-congʳ (B.+-congˡ (B.zeroʳ β))) ⟩ + (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-p q) +B eval-p p *B (β *B (⟦ b ⟧ +B β *B eval-p q)) + ≈⟨ B.+-congʳ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧)) ⟩ + (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-p q) +B eval-p p *B (β *B (⟦ b ⟧ +B β *B eval-p q))) + ≈⟨ B.+-congˡ (B.*-assoc (eval-p p) β (⟦ b ⟧ +B β *B eval-p q)) ⟨ + (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-p q) +B (eval-p p *B β) *B (⟦ b ⟧ +B β *B eval-p q)) + ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm (eval-p p) β)) ⟩ + (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-p q) +B (β *B eval-p p) *B (⟦ b ⟧ +B β *B eval-p q)) + ≈⟨ proj₂ distrib (⟦ b ⟧ +B β *B eval-p q) ⟦ a ⟧ (β *B eval-p p) ⟨ + (⟦ a ⟧ +B β *B eval-p p) *B (⟦ b ⟧ +B β *B eval-p q) + ∎ + + eval-*-homomorphic : (P : Polynomial) → (Q : Polynomial) → eval (P * Q) ≈B eval P *B eval Q + eval-*-homomorphic (m , p) (n , q) = begin + eval ((m , p) * (n , q)) + ≈⟨ eval-equiv ((p *P q)) ⟨ + eval-p (p *P q) + ≈⟨ eval-p-*-homomorphic p q ⟩ + (eval-p p *B eval-p q) + ≈⟨ B.*-cong (eval-equiv p) (eval-equiv q) ⟩ + eval (m , p) *B eval (n , q) + ∎ + + eval-p-inverse-homomorphic : (p : Poly m) → eval-p (-P p) ≈B -B (eval-p p) + eval-p-inverse-homomorphic [] = B.sym (ε⁻¹≈ε B.+-group) + eval-p-inverse-homomorphic (a ∷ p) = begin + eval-p (-P (a ∷ p)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-inverse-homomorphic p)) ⟩ + ⟦ -A a ⟧ +B β *B (-B (eval-p p)) + ≈⟨ B.+-congˡ step1 ⟩ + ⟦ -A a ⟧ +B -B (β *B eval-p p) + ≈⟨ B.+-congʳ (RingHomomorphism.-‿homo f a) ⟩ + -B ⟦ a ⟧ +B -B (β *B eval-p p) + ≈⟨ B.+-comm (-B (β *B eval-p p)) (-B ⟦ a ⟧) ⟨ + -B (β *B eval-p p) +B -B ⟦ a ⟧ + ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval-p p) ⟨ + -B eval-p (a ∷ p) + ∎ + where + step1 = begin + β *B -B eval-p p + ≈⟨ B.*-congˡ (-1*x≈-x B.ring (eval-p p)) ⟨ + β *B (-B 1# *B eval-p p) + ≈⟨ B.*-assoc β (-B 1#) (eval-p p) ⟨ + (β *B -B 1#) *B eval-p p + ≈⟨ B.*-congʳ (B.*-comm (-B 1#) β) ⟨ + (-B 1# *B β) *B eval-p p + ≈⟨ B.*-assoc (-B 1#) β (eval-p p) ⟩ + (-B 1#) *B (β *B eval-p p) + ≈⟨ -1*x≈-x B.ring (β *B eval-p p) ⟩ + -B (β *B eval-p p) + ∎ + + + + + eval-inverse-homomorphic : (P : Polynomial) → eval (- P) ≈B -B (eval P) + eval-inverse-homomorphic (m , p) = begin + eval (- (m , p)) + ≈⟨ eval-equiv (-P p) ⟨ + eval-p (-P p) + ≈⟨ eval-p-inverse-homomorphic p ⟩ + -B eval-p p + ≈⟨ B.-‿cong (eval-equiv p) ⟩ + -B eval (m , p) + ∎ + + eval-+-isMagmaHomomorphism : IsMagmaHomomorphism (CommutativeRing.+-rawMagma +-*-commutativeRing) + (CommutativeRing.+-rawMagma B) eval + eval-+-isMagmaHomomorphism = record + { isRelHomomorphism = record { cong = eval-cong } + ; homo = eval-+-homomorphic + } + + eval-+-isMonoidHomomorphism : IsMonoidHomomorphism (CommutativeRing.+-rawMonoid +-*-commutativeRing) + (CommutativeRing.+-rawMonoid B) eval + eval-+-isMonoidHomomorphism = record + { isMagmaHomomorphism = eval-+-isMagmaHomomorphism + ; ε-homo = B.refl + } + + eval-isNearSemiringHomomorphism : IsNearSemiringHomomorphism (SemiringWithoutAnnihilatingZero.rawNearSemiring + (Semiring.semiringWithoutAnnihilatingZero (CommutativeRing.semiring +-*-commutativeRing))) + (SemiringWithoutAnnihilatingZero.rawNearSemiring + (Semiring.semiringWithoutAnnihilatingZero (CommutativeRing.semiring B))) eval + eval-isNearSemiringHomomorphism = record + { +-isMonoidHomomorphism = eval-+-isMonoidHomomorphism + ; *-homo = eval-*-homomorphic } + + eval-isSemiringHomomorphism : IsSemiringHomomorphism (CommutativeSemiring.rawSemiring + (CommutativeRing.commutativeSemiring +-*-commutativeRing)) + (CommutativeSemiring.rawSemiring (CommutativeRing.commutativeSemiring B)) eval + eval-isSemiringHomomorphism = record + { isNearSemiringHomomorphism = eval-isNearSemiringHomomorphism + ; 1#-homo = eval-1#-homomorphic } + + eval-isRingHomomorphism : IsRingHomomorphism (CommutativeRing.rawRing +-*-commutativeRing) (CommutativeRing.rawRing B) eval + eval-isRingHomomorphism = record + { isSemiringHomomorphism = eval-isSemiringHomomorphism + ; -‿homo = eval-inverse-homomorphic + } + + + + +{- + eval-cong : P ≈ Q → eval P ≈B eval Q + eval-cong {P = 0 , []} {Q = ℕ.zero , []} P≈Q = B.refl + eval-cong {P = suc n , (a ∷ p)} {Q = ℕ.zero , []} P≈Q = begin + eval (suc n , (a ∷ p)) + ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong + (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero P≈Q))) ⟩ + ⟦ A0# ⟧ +B β *B eval (n , p) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {P = n , p} {Q = ℕ.zero , []} + (IsZero⇒≈0 (tail (≈0⇒IsZero P≈Q))))) ⟩ + ⟦ A0# ⟧ +B β *B eval(ℕ.zero , []) + ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo + (RingHomomorphism.+-monoidHomomorphism f)) ⟩ + (0# +B β *B eval(ℕ.zero , [])) + ≈⟨ B.+-congˡ (B.zeroʳ β) ⟩ + (0# +B 0#) + ≈⟨ B.+-identityʳ 0# ⟩ + eval (ℕ.zero , []) + ∎ + eval-cong {P = ℕ.zero , []} {Q = suc n , (a ∷ q)} P≈Q = begin + eval (ℕ.zero , []) + ≈⟨ B.zeroʳ β ⟨ + β *B eval (ℕ.zero , []) + ≈⟨ B.+-identityˡ (β *B eval (ℕ.zero , [])) ⟨ + 0# +B β *B eval (ℕ.zero , []) + ≈⟨ B.+-congʳ ( (MonoidHomomorphism.ε-homo + (RingHomomorphism.+-monoidHomomorphism f))) ⟨ + ⟦ A0# ⟧ +B β *B eval (ℕ.zero , []) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {P = 0 , []} {Q = n , q} + (P-sym (IsZero⇒≈0 (tail (≈0⇒IsZero (P-sym P≈Q))))))) ⟩ + ⟦ A0# ⟧ +B β *B eval (n , q) + ≈⟨ B.+-congʳ ((S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) + (head (≈0⇒IsZero (P-sym P≈Q))))) ⟨ + eval (suc n , (a ∷ q)) + ∎ + eval-cong {P = suc m , (a ∷ p)} {Q = suc n , (b ∷ q)} (cons a≈b p≈q) + = B.+-cong (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) a≈b) + (B.*-congˡ (eval-cong p≈q)) + -} + + +{-eval-+-homomorphic (0 , []) (n , q) = begin + eval ((ℕ.zero , []) + (n , q)) + ≈⟨ eval-cong (P.+-identityˡ ((n , q))) ⟩ + eval (n , q) + ≈⟨ B.+-identityˡ (eval (n , q)) ⟨ + eval (ℕ.zero , []) +B eval (n , q) + ∎ + eval-+-homomorphic (suc m , (a ∷ p)) (0 , []) = B.sym (B.+-identityʳ (eval (suc m , (a ∷ p)))) + eval-+-homomorphic (suc m , (a ∷ p)) (suc n , (b ∷ q)) = begin + eval ((suc m , (a ∷ p)) + (suc n , (b ∷ q))) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-+-homomorphic (m , p) (n , q))) ⟩ + ⟦ a +A b ⟧ +B (β *B (eval (m , p) +B eval (n , q))) + ≈⟨ B.+-congˡ (proj₁ distrib β (eval (m , p)) (eval (n , q))) ⟩ + ⟦ a +A b ⟧ +B (β *B eval (m , p) +B β *B eval (n , q)) + ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.+-isMagmaHomomorphism f) a b) ⟩ + ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval (m , p) +B β *B eval (n , q)) + ≈⟨ B.+-assoc ( ⟦ a ⟧ +B ⟦ b ⟧) (β *B eval (m , p)) (β *B eval (n , q)) ⟨ + ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval (m , p) +B β *B eval (n , q) + ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval (m , p))) ⟩ + ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval (m , p)) +B β *B eval (n , q) + ≈⟨ (B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval (m , p)) (β *B eval (n , q))) ⟩ + ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval (m , p) +B (β *B eval (n , q))) + ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval (m , p)) ⟦ b ⟧))) ⟨ + ⟦ a ⟧ +B ((β *B eval (m , p)) +B ⟦ b ⟧ +B (β *B eval (n , q))) + ≈⟨ B.+-congˡ (B.+-assoc (β *B eval (m , p)) ⟦ b ⟧ (β *B eval (n , q))) ⟩ + ⟦ a ⟧ +B (β *B eval (m , p) +B eval (suc n , (b ∷ q))) + ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval (m , p)) (eval (suc n , (b ∷ q))) ⟨ + eval (suc m , (a ∷ p)) +B eval (suc n , (b ∷ q)) + ∎ + -} + + + +{- eval-1#-homomorphic = begin + eval (1 , (A1# ∷ [])) + ≈⟨ B.+-cong (RingHomomorphism.1#-homo f) (B.zeroʳ β) ⟩ + 1# +B 0# + ≈⟨ B.+-identityʳ (1#) ⟩ + 1# + ∎ + +-} + + +{-eval-inverse-homomorphic (0 , []) = B.sym (ε⁻¹≈ε B.+-group) + eval-inverse-homomorphic (suc m , (a ∷ p)) = begin + eval (- (suc m , (a ∷ p))) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-inverse-homomorphic (m , p))) ⟩ + ⟦ -A a ⟧ +B β *B (-B (eval (m , p))) + ≈⟨ B.+-congˡ step1 ⟩ + ⟦ -A a ⟧ +B -B (β *B eval (m , p)) + ≈⟨ B.+-congʳ (RingHomomorphism.-‿homo f a) ⟩ + -B ⟦ a ⟧ +B -B (β *B eval (m , p)) + ≈⟨ B.+-comm (-B (β *B eval (m , p))) (-B ⟦ a ⟧) ⟨ + -B (β *B eval (m , p)) +B (-B ⟦ a ⟧) + ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval (m , p)) ⟨ + (-B eval (suc m , (a ∷ p))) + ∎ + where + step1 = begin + β *B (-B (eval (m , p))) + ≈⟨ B.*-congˡ (-1*x≈-x B.ring (eval (m , p))) ⟨ + β *B (-B 1# *B eval (m , p)) + ≈⟨ B.*-assoc β (-B 1#) (eval (m , p)) ⟨ + (β *B -B 1#) *B eval (m , p) + ≈⟨ B.*-congʳ (B.*-comm (-B 1#) β) ⟨ + (-B 1# *B β) *B eval (m , p) + ≈⟨ B.*-assoc (-B 1#) β (eval (m , p)) ⟩ + (-B 1#) *B (β *B eval (m , p)) + ≈⟨ -1*x≈-x B.ring (β *B eval (m , p)) ⟩ + -B (β *B eval (m , p)) + ∎ + -} diff --git a/src/Algebra/Polynomial/Poly/Base.agda b/src/Algebra/Polynomial/Poly/Base.agda index d50d074e14..b150951622 100644 --- a/src/Algebra/Polynomial/Poly/Base.agda +++ b/src/Algebra/Polynomial/Poly/Base.agda @@ -1,7 +1,7 @@ -open import Algebra.Bundles using (CommutativeRing) +open import Algebra.Bundles using (Semiring) module Algebra.Polynomial.Poly.Base - {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) + {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) @@ -13,22 +13,21 @@ open import Relation.Binary.PropositionalEquality.Core using (cong) open import Relation.Binary.PropositionalEquality using (_≡_; cong; module ≡-Reasoning) -infix 8 -_ -infixl 7 _*_ -infix 7 _·_ -infixl 6 _+_ -infix 4 _≈_ - -module CR = CommutativeRing R -open CR - renaming +module SR = Semiring SR +open SR + renaming ( Carrier to A ; _≈_ to _≈A_ ; _+_ to _+A_ ; _*_ to _*A_ - ; -_ to -A_) + ) using (0#; 1#) +infixl 7 _*_ +infix 7 _·_ +infixl 6 _+_ +infix 4 _≈_ + private variable m n k l : ℕ @@ -61,11 +60,6 @@ shift p = 0# ∷ p IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) IsZero = All (_≈A 0#) --- The additive inverse --_ : Poly n → Poly n -- p = Vec.map -A_ p - ------------------------------------------------------------------- -- The representation of a polynomial is not unique -- because we allow coefficients to be zero -- We define an equivalence relation which takes this into account @@ -75,7 +69,6 @@ data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where ≈[] : (p : Poly m) → IsZero p → p ≈ [] cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) ------------------------------------------------------------------- -- Properties of Polynomial Equality zeros-unique : IsZero p → IsZero q → p ≈ q @@ -83,26 +76,25 @@ zeros-unique [] [] = []≈ [] [] zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = cons (CR.trans a≈0 (CR.sym b≈0)) (zeros-unique p≈0 q≈0) + = cons (SR.trans a≈0 (SR.sym b≈0)) (zeros-unique p≈0 q≈0) IsZero-cong : IsZero p → p ≈ q → IsZero q IsZero-cong [] ([]≈ q q≈0) = q≈0 IsZero-cong [] (≈[] p p≈0) = p≈0 IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) - = (CR.trans (CR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q + = (SR.trans (SR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q ------------------------------------------------------------------- -- _≈_ is an equivalence relation refl : p ≈ p refl {p = []} = []≈ [] [] -refl {p = a ∷ p} = cons CR.refl refl +refl {p = a ∷ p} = cons SR.refl refl sym : p ≈ q → q ≈ p sym ([]≈ q q≈0) = ≈[] q q≈0 sym (≈[] p p≈0) = []≈ p p≈0 -sym (cons a≈b p≈q) = cons (CR.sym a≈b) (sym p≈q) +sym (cons a≈b p≈q) = cons (SR.sym a≈b) (sym p≈q) trans : p ≈ q → q ≈ r → p ≈ r trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) @@ -110,13 +102,13 @@ trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) trans (cons a≈b p≈q) (≈[] q q≈0) = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) trans (cons a≈b p≈q) (cons b≈c q≈r) - = cons (CR.trans a≈b b≈c) (trans p≈q q≈r) + = cons (SR.trans a≈b b≈c) (trans p≈q q≈r) consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) consˡ a≈b = cons a≈b refl consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) -consʳ = cons CR.refl +consʳ = cons SR.refl ---------------------------------------------------------------- -- Operations @@ -147,3 +139,4 @@ cast-lem m n = begin _*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) _*_ {m = m} [] p = zeros (pred m) _*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) + diff --git a/src/Algebra/Polynomial/Poly/Base1.agda b/src/Algebra/Polynomial/Poly/Base1.agda new file mode 100644 index 0000000000..814f134482 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Base1.agda @@ -0,0 +1,148 @@ +open import Algebra.Bundles using (Ring) + +module Algebra.Polynomial.Poly.Base1 + {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) + where + +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +import Data.Nat.Properties as ℕ +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All using (All ; []; _∷_) +import Level as L +open import Relation.Binary.PropositionalEquality.Core using (cong) +open import Relation.Binary.PropositionalEquality + using (_≡_; cong; module ≡-Reasoning) + +module R = Ring R +open R + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +infix 8 -_ +infixl 7 _*_ +infix 7 _·_ +infixl 6 _+_ +infix 4 _≈_ + +private + variable + m n k l : ℕ + a b c d : A + +-- Polynomial of degree most n is represented as a vector of length n + 1 +-- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∷ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ + +Poly : ℕ → Set ℓ₁ +Poly n = Vec A n + +private + variable + p : Poly m + q : Poly n + r : Poly k + s : Poly l + +zeros : (n : ℕ) → Poly n +zeros n = Vec.replicate n (0#) + +-- Scaling a polynomial by a +_·_ : A → Poly n → Poly n +a · p = Vec.map (a *A_) p + +-- Multiply a polynomial by a factor of x +shift : Poly n → Poly (suc n) +shift p = 0# ∷ p + +IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) +IsZero = All (_≈A 0#) + + +-- The additive inverse +-_ : Poly n → Poly n +- p = Vec.map -A_ p + +-- The representation of a polynomial is not unique +-- because we allow coefficients to be zero +-- We define an equivalence relation which takes this into account + +data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where + []≈ : (q : Poly n) → IsZero q → [] ≈ q + ≈[] : (p : Poly m) → IsZero p → p ≈ [] + cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) + +-- Properties of Polynomial Equality + +zeros-unique : IsZero p → IsZero q → p ≈ q +zeros-unique [] [] = []≈ [] [] +zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = cons (R.trans a≈0 (R.sym b≈0)) (zeros-unique p≈0 q≈0) + +IsZero-cong : IsZero p → p ≈ q → IsZero q +IsZero-cong [] ([]≈ q q≈0) = q≈0 +IsZero-cong [] (≈[] p p≈0) = p≈0 +IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] +IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) + = (R.trans (R.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q + +-- _≈_ is an equivalence relation + +refl : p ≈ p +refl {p = []} = []≈ [] [] +refl {p = a ∷ p} = cons R.refl refl + +sym : p ≈ q → q ≈ p +sym ([]≈ q q≈0) = ≈[] q q≈0 +sym (≈[] p p≈0) = []≈ p p≈0 +sym (cons a≈b p≈q) = cons (R.sym a≈b) (sym p≈q) + +trans : p ≈ q → q ≈ r → p ≈ r +trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) +trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) +trans (cons a≈b p≈q) (≈[] q q≈0) + = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) +trans (cons a≈b p≈q) (cons b≈c q≈r) + = cons (R.trans a≈b b≈c) (trans p≈q q≈r) + +consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) +consˡ a≈b = cons a≈b refl + +consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) +consʳ = cons R.refl + +---------------------------------------------------------------- +-- Operations + +-- Addition +_+_ : Poly m → Poly n → Poly (m ⊔ n) +[] + [] = [] +[] + (a ∷ p) = a ∷ p +(a ∷ p) + [] = a ∷ p +(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) + +private + pred[n+sucm]≡n+m : ∀ n → ∀ m → pred (n ℕ.+ suc m) ≡ n ℕ.+ m + pred[n+sucm]≡n+m n m = begin + pred (n ℕ.+ suc m) ≡⟨ cong pred (ℕ.+-comm n (suc m)) ⟩ + pred (suc m ℕ.+ n) ≡⟨ ℕ.+-comm m n ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +cast-lem : ∀ m → ∀ n → m ⊔ pred (n ℕ.+ suc m) ≡ (n ℕ.+ m) +cast-lem m n = begin + m ⊔ pred (n ℕ.+ suc m) ≡⟨ cong (m ⊔_) (pred[n+sucm]≡n+m n m) ⟩ + m ⊔ (n ℕ.+ m) ≡⟨ ℕ.m≤n⇒m⊔n≡n (ℕ.m≤n+m m n) ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +-- Multiplication +_*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) +_*_ {m = m} [] p = zeros (pred m) +_*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) + diff --git a/src/Algebra/Polynomial/Poly/Base2.agda b/src/Algebra/Polynomial/Poly/Base2.agda new file mode 100644 index 0000000000..aac53f2489 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Base2.agda @@ -0,0 +1,149 @@ +open import Algebra.Bundles using (CommutativeRing) + +module Algebra.Polynomial.Poly.Base2 + {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) + where + +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +import Data.Nat.Properties as ℕ +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All using (All ; []; _∷_) +import Level as L +open import Relation.Binary.PropositionalEquality.Core using (cong) +open import Relation.Binary.PropositionalEquality + using (_≡_; cong; module ≡-Reasoning) + +infix 8 -_ +infixl 7 _*_ +infix 7 _·_ +infixl 6 _+_ +infix 4 _≈_ + +module CR = CommutativeRing R +open CR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +private + variable + m n k l : ℕ + a b c d : A + +-- Polynomial of degree most n is represented as a vector of length n + 1 +-- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∷ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ + +Poly : ℕ → Set ℓ₁ +Poly n = Vec A n + +private + variable + p : Poly m + q : Poly n + r : Poly k + s : Poly l + +zeros : (n : ℕ) → Poly n +zeros n = Vec.replicate n (0#) + +-- Scaling a polynomial by a +_·_ : A → Poly n → Poly n +a · p = Vec.map (a *A_) p + +-- Multiply a polynomial by a factor of x +shift : Poly n → Poly (suc n) +shift p = 0# ∷ p + +IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) +IsZero = All (_≈A 0#) + +-- The additive inverse +-_ : Poly n → Poly n +- p = Vec.map -A_ p + +------------------------------------------------------------------ +-- The representation of a polynomial is not unique +-- because we allow coefficients to be zero +-- We define an equivalence relation which takes this into account + +data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where + []≈ : (q : Poly n) → IsZero q → [] ≈ q + ≈[] : (p : Poly m) → IsZero p → p ≈ [] + cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) + +------------------------------------------------------------------ +-- Properties of Polynomial Equality + +zeros-unique : IsZero p → IsZero q → p ≈ q +zeros-unique [] [] = []≈ [] [] +zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = cons (CR.trans a≈0 (CR.sym b≈0)) (zeros-unique p≈0 q≈0) + +IsZero-cong : IsZero p → p ≈ q → IsZero q +IsZero-cong [] ([]≈ q q≈0) = q≈0 +IsZero-cong [] (≈[] p p≈0) = p≈0 +IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] +IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) + = (CR.trans (CR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q + +------------------------------------------------------------------ +-- _≈_ is an equivalence relation + +refl : p ≈ p +refl {p = []} = []≈ [] [] +refl {p = a ∷ p} = cons CR.refl refl + +sym : p ≈ q → q ≈ p +sym ([]≈ q q≈0) = ≈[] q q≈0 +sym (≈[] p p≈0) = []≈ p p≈0 +sym (cons a≈b p≈q) = cons (CR.sym a≈b) (sym p≈q) + +trans : p ≈ q → q ≈ r → p ≈ r +trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) +trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) +trans (cons a≈b p≈q) (≈[] q q≈0) + = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) +trans (cons a≈b p≈q) (cons b≈c q≈r) + = cons (CR.trans a≈b b≈c) (trans p≈q q≈r) + +consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) +consˡ a≈b = cons a≈b refl + +consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) +consʳ = cons CR.refl + +---------------------------------------------------------------- +-- Operations + +-- Addition +_+_ : Poly m → Poly n → Poly (m ⊔ n) +[] + [] = [] +[] + (a ∷ p) = a ∷ p +(a ∷ p) + [] = a ∷ p +(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) + +private + pred[n+sucm]≡n+m : ∀ n → ∀ m → pred (n ℕ.+ suc m) ≡ n ℕ.+ m + pred[n+sucm]≡n+m n m = begin + pred (n ℕ.+ suc m) ≡⟨ cong pred (ℕ.+-comm n (suc m)) ⟩ + pred (suc m ℕ.+ n) ≡⟨ ℕ.+-comm m n ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +cast-lem : ∀ m → ∀ n → m ⊔ pred (n ℕ.+ suc m) ≡ (n ℕ.+ m) +cast-lem m n = begin + m ⊔ pred (n ℕ.+ suc m) ≡⟨ cong (m ⊔_) (pred[n+sucm]≡n+m n m) ⟩ + m ⊔ (n ℕ.+ m) ≡⟨ ℕ.m≤n⇒m⊔n≡n (ℕ.m≤n+m m n) ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +-- Multiplication +_*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) +_*_ {m = m} [] p = zeros (pred m) +_*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) diff --git a/src/Algebra/Polynomial/Poly/Properties.agda b/src/Algebra/Polynomial/Poly/Properties.agda index 29501f2c39..ff614789c9 100644 --- a/src/Algebra/Polynomial/Poly/Properties.agda +++ b/src/Algebra/Polynomial/Poly/Properties.agda @@ -1,13 +1,12 @@ -open import Algebra.Bundles using (CommutativeRing) +open import Algebra.Bundles using (Semiring) -module Algebra.Polynomial.Poly.Properties - {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) +module Algebra.Polynomial.Poly.Properties + {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base R as P - using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros +open import Algebra.Polynomial.Poly.Base SR as P + using ( Poly; _+_ ; _*_ ; _·_ ; shift; _≈_; refl; trans; sym; zeros ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) -open import Algebra.Properties.Ring open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) import Data.Nat.Properties as ℕ open import Data.Vec.Base as Vec using (Vec; []; _∷_) @@ -18,14 +17,14 @@ open import Relation.Binary.PropositionalEquality as Eq using (_≡_; module ≡-Reasoning) open import Relation.Binary.PropositionalEquality.Core using (cong) -module CR = CommutativeRing R -open CR +module SR = Semiring SR +open SR renaming ( Carrier to A ; _≈_ to _≈A_ ; _+_ to _+A_ ; _*_ to _*A_ - ; -_ to -A_) + ) using (0#; 1#) private @@ -78,12 +77,11 @@ private _∎ : (p : Poly m) → p IsRelatedTo p p ∎ = stop ------------------------------------------------------------------ -- Properties of zero polynomial zerosIsZero : (n : ℕ) → IsZero (zeros n) zerosIsZero 0 = [] -zerosIsZero (suc n) = CR.refl ∷ (zerosIsZero n) +zerosIsZero (suc n) = SR.refl ∷ (zerosIsZero n) zerosm≈zerosn : zeros m ≈ zeros n zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) @@ -96,49 +94,12 @@ zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) IsZero⇒≈0 : IsZero p → p ≈ zeros m IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) -All-p≈0∧q≈0⇒p+q≈0 : All (_≈A 0#) p → All (_≈A 0#) q → All (_≈A 0#) (p + q) +All-p≈0∧q≈0⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] [] = [] All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 All-p≈0∧q≈0⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = CR.trans (CR.+-cong a≈0 b≈0) (CR.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 - ------------------------------------------------------- --- Additive inverse - -[-p]+pIsZero : {p : Poly m} → IsZero ((- p) + p) -[-p]+pIsZero {p = []} = [] -[-p]+pIsZero {p = a ∷ p} = CR.-‿inverseˡ a ∷ [-p]+pIsZero - -p+[-p]IsZero : {p : Poly m} → IsZero (p + (- p)) -p+[-p]IsZero {p = []} = [] -p+[-p]IsZero {p = a ∷ p} = CR.-‿inverseʳ a ∷ p+[-p]IsZero - -+-inverseˡ : (p : Poly m) → (- p) + p ≈ [] -+-inverseˡ [] = refl -+-inverseˡ (a ∷ p) - = ≈[] ((- (a ∷ p)) + (a ∷ p)) (CR.-‿inverseˡ a ∷ [-p]+pIsZero) - -+-inverseʳ : (p : Poly m) → p + (- p) ≈ [] -+-inverseʳ [] = refl -+-inverseʳ (a ∷ p) - = ≈[] ((a ∷ p) + (- (a ∷ p))) ((CR.-‿inverseʳ a) ∷ p+[-p]IsZero) - -------------------------------------------------------- --- Negation is congruent - --⁺ : IsZero p → IsZero (- p) --⁺ [] = [] --⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε CR.ring a≈0 ∷ (-⁺ p≈0) - --⁻ : IsZero (- p) → IsZero p --⁻ {p = []} -p≈0 = -p≈0 --⁻ {p = a ∷ p} (-a≈0 ∷ -p≈0) = x⁻¹≈ε⇒x≈ε CR.ring -a≈0 ∷ (-⁻ -p≈0) - --‿cong : p ≈ q → - p ≈ - q --‿cong ([]≈ q q≈0) = []≈ (- q) (-⁺ q≈0) --‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) --‿cong (cons a≈b p≈q) = cons (CR.-‿cong a≈b) (-‿cong p≈q) + = SR.trans (SR.+-cong a≈0 b≈0) (SR.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 ----------------------------------------------------- -- Properties of polynomial addition @@ -147,14 +108,14 @@ p+[-p]IsZero {p = a ∷ p} = CR.-‿inverseʳ a ∷ p+[-p]IsZero +-comm [] [] = refl +-comm [] (a ∷ p) = refl +-comm (a ∷ p) [] = refl -+-comm (a ∷ p) (b ∷ q) = cons (CR.+-comm a b) (+-comm p q) ++-comm (a ∷ p) (b ∷ q) = cons (SR.+-comm a b) (+-comm p q) +-idʳ : (p : Poly n) → (q : Poly m) → IsZero q → p + q ≈ p +-idʳ [] q [] = refl +-idʳ (a ∷ p) q [] = refl +-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) +-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) - = cons (CR.trans (CR.+-congˡ b≈0) (CR.+-identityʳ a)) (+-idʳ p q q≈0) + = cons (SR.trans (SR.+-congˡ b≈0) (SR.+-identityʳ a)) (+-idʳ p q q≈0) +-idˡ : (p : Poly n) → (q : Poly m) → IsZero p → p + q ≈ q +-idˡ p q p≈0 = begin @@ -188,7 +149,7 @@ p+[-p]IsZero {p = a ∷ p} = CR.-‿inverseʳ a ∷ p+[-p]IsZero a ∷ p ≈⟨ cons a≈b p≈q ⟩ b ∷ q ∎ +-cong (cons a≈b p≈q) (cons c≈d r≈s) - = cons (CR.+-cong a≈b c≈d) (+-cong p≈q r≈s) + = cons (SR.+-cong a≈b c≈d) (+-cong p≈q r≈s) +-congˡ : p ≈ q → p + r ≈ q + r +-congˡ p≈q = +-cong p≈q refl @@ -205,7 +166,7 @@ p+[-p]IsZero {p = a ∷ p} = CR.-‿inverseʳ a ∷ p+[-p]IsZero +-assoc (a ∷ p) [] r = +-congʳ (sym (+-identityˡ r)) +-assoc (a ∷ p) (b ∷ q) [] = refl +-assoc (a ∷ p) (b ∷ q) (c ∷ r) - = cons (CR.+-assoc a b c) (+-assoc p q r) + = cons (SR.+-assoc a b c) (+-assoc p q r) middleFour : (p : Poly m) → (q : Poly n) → (r : Poly k) → (w : Poly l) → (p + q) + (r + w) ≈ (p + r) + (q + w) @@ -235,6 +196,7 @@ private cast-p≈p {n = 0} {[]} Eq.refl = refl cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) + ------------------------------------------------------------------ -- Properties of polynomial shifting @@ -245,19 +207,19 @@ private (a ∷ p) * (0# ∷ q) ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ a · (0# ∷ q) + p * (0# ∷ 0# ∷ q) - ≈⟨ +-congˡ (consˡ (CR.zeroʳ a)) ⟩ + ≈⟨ +-congˡ (consˡ (SR.zeroʳ a)) ⟩ (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ consˡ (CR.+-identityˡ 0#) ⟩ + ≈⟨ consˡ (SR.+-identityˡ 0#) ⟩ 0# ∷ (a · q + p * (0# ∷ q)) ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟨ 0# ∷ ((a ∷ p) * q) ∎ ·-distrib-shift : (a : A) → (p : Poly m) → a · (shift p) ≈ shift (a · p) -·-distrib-shift a [] = cons (CR.zeroʳ a) (refl) -·-distrib-shift a (b ∷ p) = consˡ (CR.zeroʳ a) +·-distrib-shift a [] = cons (SR.zeroʳ a) (refl) +·-distrib-shift a (b ∷ p) = consˡ (SR.zeroʳ a) ---------------------------------------------------------------- -- Properties of polynomial scaling @@ -266,20 +228,25 @@ a·p≈a∷[]*p : (a : A) → (p : Poly n) → a · p ≈ (a ∷ []) * p a·p≈a∷[]*p {_} a [] = refl a·p≈a∷[]*p {suc n} a (b ∷ p) = begin a · (b ∷ p) - ≈⟨ cons (CR.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ + ≈⟨ cons (SR.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ a *A b +A 0# ∷ (a · p + zeros n) ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟨ (a ∷ []) * (b ∷ p) ∎ +1·p≈p : (p : Poly n) → 1# · p ≈ p +1·p≈p [] = refl +1·p≈p (a ∷ p) = cons (SR.*-identityˡ a) (1·p≈p p) + + pIsZero⇒a·pIsZero : (a : A) → (p : Poly n) → IsZero p → IsZero (a · p) pIsZero⇒a·pIsZero a p [] = [] pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) - = (CR.trans (CR.*-congˡ b≈0) (CR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 + = (SR.trans (SR.*-congˡ b≈0) (SR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 a≈0⇒a·pIsZero : (a : A) → (p : Poly n) → a ≈A 0# → IsZero (a · p) a≈0⇒a·pIsZero a [] a≈0 = [] a≈0⇒a·pIsZero a (b ∷ p) a≈0 - = CR.trans (CR.*-congʳ a≈0) (CR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) + = SR.trans (SR.*-congʳ a≈0) (SR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) ·-cong : a ≈A b → p ≈ q → a · p ≈ b · q ·-cong {a = _} {b = b} _ ([]≈ q q≈0) @@ -287,26 +254,30 @@ a≈0⇒a·pIsZero a (b ∷ p) a≈0 ·-cong {a = a} {b = _} _ (≈[] p p≈0) = IsZero⇒≈0 (pIsZero⇒a·pIsZero a p p≈0) ·-cong {a = _} {b = _} c≈d (cons a≈b p≈q) - = cons (CR.*-cong c≈d a≈b) (·-cong c≈d p≈q) + = cons (SR.*-cong c≈d a≈b) (·-cong c≈d p≈q) ·-congˡ : a ≈A b → a · p ≈ b · p ·-congˡ a≈b = ·-cong a≈b refl ·-congʳ : p ≈ q → a · p ≈ a · q -·-congʳ = ·-cong CR.refl +·-congʳ = ·-cong SR.refl ·-dist : a · (p + q) ≈ (a · p) + (a · q) -·-dist {a = _} {p = []} {q = []} = refl -·-dist {a = _} {p = []} {q = b ∷ q} = refl -·-dist {a = _} {p = b ∷ p} {q = []} = refl -·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (CR.distribˡ a b c) ·-dist +·-dist {p = []} {q = []} = refl +·-dist {p = []} {q = b ∷ q} = refl +·-dist {p = b ∷ p} {q = []} = refl +·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (SR.distribˡ a b c) ·-dist ·-assoc : a · (b · p) ≈ (a *A b) · p -·-assoc {_} {_} {p = []} = refl -·-assoc {a} {b} {p = c ∷ p} = cons (CR.sym (CR.*-assoc a b c)) ·-assoc +·-assoc {p = []} = refl +·-assoc {a} {b} {p = c ∷ p} = cons (SR.sym (SR.*-assoc a b c)) ·-assoc a·-cong : p ≈ q → a · p ≈ a · q -a·-cong = ·-cong CR.refl +a·-cong = ·-cong SR.refl + +·-distrib-+A : (a b : A) → (p : Poly m) → (a +A b) · p ≈ a · p + b · p +·-distrib-+A a b [] = refl +·-distrib-+A a b (c ∷ p) = cons (SR.distribʳ c a b) (·-distrib-+A a b p) ----------------------------------------------------------------- -- Properties of polynomial multiplication @@ -315,7 +286,7 @@ zeroˡ : (p : Poly m) → [] * p ≈ [] zeroˡ p = zerosm≈zerosn zeroʳ : (p : Poly m) → p * [] ≈ [] -zeroʳ {_} [] = refl +zeroʳ [] = refl zeroʳ {m} (a ∷ p) = begin (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ @@ -325,7 +296,7 @@ zeroʳ {m} (a ∷ p) = begin [] ∎ pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) -pIsZero⇒p*qIsZero {n} {_} {p = []} q [] = zerosIsZero (pred n) +pIsZero⇒p*qIsZero {n} {p = []} q [] = zerosIsZero (pred n) pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) = cast-p≈0⇒p≈0 (cast-lem n m) (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) @@ -373,9 +344,9 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero (a ∷ p) * (c ∷ r) ≈⟨ cast-p≈p (cast-lem (suc k) m)⟩ (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consˡ (CR.*-cong (CR.sym a≈b) (CR.sym c≈d))) ⟨ + ≈⟨ +-congˡ (consˡ (SR.*-cong a≈b c≈d)) ⟩ (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consʳ ((·-cong (CR.sym a≈b) (sym r≈s)))) ⟨ + ≈⟨ +-congˡ (consʳ (·-cong a≈b r≈s)) ⟩ (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) @@ -390,7 +361,7 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero *-congˡ p≈q = *-cong p≈q refl qIsZero⇒p*qIsZero : (p : Poly m) → IsZero q → IsZero (p * q) -qIsZero⇒p*qIsZero {m} {_} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) +qIsZero⇒p*qIsZero {m} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) = ≈0⇒IsZero ( begin @@ -404,166 +375,73 @@ qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) q≈[]→p*q≈[] : (p : Poly n) → q ≈ [] → p * q ≈ [] q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero q≈0)) -*-comm : (p : Poly m) → (q : Poly n) → p * q ≈ q * p -*-comm {_} {_} [] [] = refl -*-comm {_} {suc n} [] (b ∷ q) = sym ( begin - (b ∷ q) * [] - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ - [] + (q * (0# ∷ [])) - ≈⟨ +-congʳ (q≈[]→p*q≈[] q zerosm≈zerosn) ⟩ - [] + [] - ≈⟨ zerosm≈zerosn ⟩ - zeros (pred (0 ℕ.+ suc n)) - ∎) -*-comm {suc m} {_} (a ∷ p) [] = begin - (a ∷ p) * [] - ≈⟨(cast-p≈p (cong pred n+1≡sucn+0))⟩ - [] + p * (0# ∷ []) - ≈⟨ +-congʳ (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ - [] + [] - ≈⟨ zerosm≈zerosn ⟩ - zeros (pred (0 ℕ.+ suc m)) - ∎ -*-comm {suc m} {suc n} (a ∷ p) (b ∷ q) = begin - (a ∷ p) * (b ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ - a · (b ∷ q) + p * (0# ∷ b ∷ q) - ≈⟨ +-congˡ (*-comm-lem (a *A b) a) ⟩ - (a *A b ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) - ≈⟨ +-congˡ (consˡ (CR.+-congʳ (CR.*-comm a b))) ⟩ - (b *A a ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) - ≈⟨ +-congʳ step1 ⟩ - (b *A a ∷ []) + (a · (0# ∷ q)) + ((b · (0# ∷ p)) + (0# ∷ 0# ∷ p * q)) - ≈⟨ step2 ⟩ - ((b *A a ∷ []) + b · (0# ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ p * q)) - ≈⟨ step3 ⟩ - (b · (a ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))) - ≈⟨ +-congʳ step4 ⟨ - (b · (a ∷ p) + q * (0# ∷ a ∷ p)) - ≈⟨ cast-p≈p (cast-lem (suc m) n) ⟨ - (b ∷ q) * (a ∷ p) - ∎ - where - *-comm-lem : ∀ {m} → {p : Poly m} → (a b : A) → - a ∷ (b · p) ≈ (a ∷ []) + (b · (0# ∷ p)) - *-comm-lem {p = []} a b - = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ b)) (CR.+-identityʳ a))) - *-comm-lem {p = a ∷ p} b c - = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ c)) (CR.+-identityʳ b))) - - step1 = begin - p * (0# ∷ b ∷ q) - ≈⟨ *-distrib-shift p (b ∷ q) ⟩ - 0# ∷ (p * (b ∷ q)) - ≈⟨ consʳ (*-comm p (b ∷ q)) ⟩ - 0# ∷ ((b ∷ q) * p) - ≈⟨ consʳ (cast-p≈p (cast-lem m n)) ⟩ - 0# ∷ (b · p + q * (0# ∷ p)) - ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ - (0# ∷ (b · p)) + (0# ∷ (q * (0# ∷ p))) - ≈⟨ +-congˡ {r = (0# ∷ (q * (0# ∷ p)))} (·-distrib-shift b p) ⟨ - (b · (0# ∷ p)) + (0# ∷ (q * (0# ∷ p))) - ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (*-distrib-shift q p)) ⟩ - b · (0# ∷ p) + (0# ∷ 0# ∷ (q * p)) - ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (consʳ (*-comm q p))) ⟩ - b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) - ∎ - - step2 - = middleFour (b *A a ∷ []) (a · (0# ∷ q)) - (b · (0# ∷ p)) (0# ∷ 0# ∷ (p * q)) - - step3 - = +-congˡ {r = a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))} - (sym (*-comm-lem {p = p} (b *A a) b)) - - step4 = begin - q * (0# ∷ a ∷ p) - ≈⟨ *-distrib-shift q (a ∷ p) ⟩ - 0# ∷ (q * (a ∷ p)) - ≈⟨ consʳ (*-comm q (a ∷ p)) ⟩ - 0# ∷ ((a ∷ p) * q) - ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟩ - 0# ∷ (a · q + p * (0# ∷ q)) - ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ - (0# ∷ (a · q)) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ +-congˡ {r = (0# ∷ (p * (0# ∷ q)))} (·-distrib-shift a q) ⟨ - a · (0# ∷ q) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ +-congʳ {p = a · (0# ∷ q)} (consʳ (*-distrib-shift p q))⟩ - a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) - ∎ - shift-distrib-+ : (p : Poly m) → (q : Poly n) → shift (p + q) ≈ (shift p) + (shift q) -shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl +shift-distrib-+ p q = cons (SR.sym (SR.+-identityʳ 0#)) refl + +*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p +*-identityʳ {0} [] = zerosm≈zerosn +*-identityʳ {suc n} (a ∷ p) = begin + (a ∷ p) * (1# ∷ []) + ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ + (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congˡ (consˡ (SR.*-identityʳ a)) ⟩ + (a ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ + (a ∷ []) + (0# ∷ (p * (1# ∷ []))) + ≈⟨ cons (SR.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ + a ∷ (p * (1# ∷ [])) + ≈⟨ consʳ (*-identityʳ p) ⟩ + a ∷ p ∎ -0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ (shift p) * q -0∷[p*q]≈[0∷p]*q p q = begin - 0# ∷ (p * q) ≈⟨ consʳ (*-comm p q) ⟩ - 0# ∷ (q * p) ≈⟨ *-distrib-shift q p ⟨ - q * (0# ∷ p) ≈⟨ *-comm q (0# ∷ p) ⟩ - (0# ∷ p) * q ∎ +*-identityˡ : (p : Poly n) → (1# ∷ []) * p ≈ p +*-identityˡ [] = refl +*-identityˡ {suc n} (a ∷ p) = begin + (1# ∷ []) * (a ∷ p) + ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟩ + 1# · (a ∷ p) + [] * (0# ∷ a ∷ p) + ≈⟨ +-identityʳ {m = pred (suc (suc n))} (1# · (a ∷ p) + []) ⟩ + 1# · (a ∷ p) + [] + ≈⟨ +-identityʳ {m = 0} (1# · (a ∷ p)) ⟩ + 1# · (a ∷ p) + ≈⟨ cons (SR.*-identityˡ a) (1·p≈p p) ⟩ + a ∷ p ∎ -0∷[p*q]≈q*[0∷p] : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ q * (shift p) -0∷[p*q]≈q*[0∷p] p q = begin - 0# ∷ (p * q) ≈⟨ 0∷[p*q]≈[0∷p]*q p q ⟩ - (0# ∷ p) * q ≈⟨ *-comm (0# ∷ p) q ⟩ - q * (0# ∷ p) ∎ +-- (0# ∷ 1# ∷ []) is the center of a polynomial ring +shiftp≈p*x : (p : Poly n) → shift p ≈ p * (0# ∷ 1# ∷ []) +shiftp≈p*x [] = refl +shiftp≈p*x {suc n} (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ cons (SR.+-identityˡ 0#) (cons (SR.+-identityʳ a) (+-identityˡ p)) ⟨ + (0# ∷ a ∷ []) + shift (shift p) + ≈⟨ consʳ (consʳ (+-congʳ (*-identityʳ p))) ⟨ + (0# ∷ a ∷ []) + (shift (shift (p * (1# ∷ [])))) + ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (consʳ (*-distrib-shift p (1# ∷ []))) ⟨ + (0# ∷ a ∷ []) + shift (p * shift (1# ∷ [])) + ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (*-distrib-shift p (0# ∷ 1# ∷ [])) ⟨ + (0# ∷ a ∷ []) + p * shift (shift (1# ∷ [])) + ≈⟨ +-congˡ (cons (SR.zeroʳ a) (consˡ (SR.*-identityʳ a))) ⟨ + a · (0# ∷ 1# ∷ []) + p * (0# ∷ 0# ∷ 1# ∷ []) + ≈⟨ cast-p≈p (cast-lem 2 n) ⟨ + (a ∷ p) * (0# ∷ 1# ∷ []) ∎ + +shiftp≈x*p : (p : Poly n) → shift p ≈ (0# ∷ 1# ∷ []) * p +shiftp≈x*p [] + = consˡ (SR.sym (SR.trans (SR.+-identityʳ (1# *A 0#)) (SR.zeroʳ 1#))) +shiftp≈x*p {suc n} (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ *-identityˡ (0# ∷ a ∷ p) ⟨ + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟨ + [] + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟩ + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-idˡ (0# *A a ∷ 0# · p) ((1# ∷ []) * (0# ∷ a ∷ p)) + ((SR.zeroˡ a) ∷ a≈0⇒a·pIsZero 0# p SR.refl) ⟨ + 0# · (a ∷ p) + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ consʳ (cast-p≈p (ℕ.m≤n⇒m⊔n≡n (ℕ.n≤1+n n))) ⟨ + (0# ∷ 1# ∷ []) * (a ∷ p) ∎ -*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → - (q + r) * p ≈ (q * p) + (r * p) -*-distribʳ-+ {_} {_} {_} [] q r = begin - (q + r) * [] - ≈⟨ q≈[]→p*q≈[] (q + r) refl ⟩ - [] + [] - ≈⟨ +-cong (zeroʳ q) (zeroʳ r)⟨ - (q * []) + (r * []) - ∎ -*-distribʳ-+ {suc m} {n} {k} (a ∷ p) q r = begin - ((q + r) * (a ∷ p)) - ≈⟨ *-comm (q + r) (a ∷ p) ⟩ - ((a ∷ p) * (q + r)) - ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ - (a · (q + r)) + (p * (0# ∷ (q + r))) - ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ - (a · q + a · r) + (0# ∷ (p * (q + r))) - ≈⟨ +-congʳ step5 ⟩ - (a · q + a · r) + ((0# ∷ (q * p)) + (0# ∷ (r * p))) - ≈⟨ middleFour (a · q) (a · r) (0# ∷ (q * p)) (0# ∷ (r * p)) ⟩ - (a · q + (0# ∷ (q * p))) + (a · r + (0# ∷ (r * p))) - ≈⟨ +-congˡ step6 ⟩ - q * (a ∷ p) + (a · r + (0# ∷ r * p)) - ≈⟨ +-congʳ step7 ⟩ - (q * (a ∷ p) + r * (a ∷ p)) - ∎ - where - step5 = begin - 0# ∷ p * (q + r) - ≈⟨ consʳ (*-comm p (q + r)) ⟩ - 0# ∷ ((q + r) * p) - ≈⟨ consʳ (*-distribʳ-+ p q r) ⟩ - 0# ∷ q * p + r * p - ≈⟨ shift-distrib-+ (q * p) (r * p) ⟩ - (0# ∷ q * p) + (0# ∷ r * p) ∎ - - step6 = begin - a · q + (0# ∷ q * p) - ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] q p) ⟩ - a · q + p * (0# ∷ q) - ≈⟨ cast-p≈p (cast-lem n m) ⟨ - (a ∷ p) * q - ≈⟨ *-comm (a ∷ p) q ⟩ - q * (a ∷ p) ∎ - - step7 = begin - a · r + (0# ∷ r * p) - ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] r p) ⟩ - a · r + p * (0# ∷ r) - ≈⟨ cast-p≈p (cast-lem k m) ⟨ - (a ∷ p) * r - ≈⟨ *-comm (a ∷ p) r ⟩ - r * (a ∷ p) ∎ - ·-distrib-* : (p : Poly m) → (q : Poly n) → (a : A) → a · (p * q) ≈ (a · p) * q ·-distrib-* {_} {n} [] q a = begin @@ -591,7 +469,7 @@ shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) ≈⟨ ·-dist ⟩ a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) - ≈⟨ +-congˡ (cons (CR.sym (CR.*-assoc a b c)) ·-assoc) ⟩ + ≈⟨ +-congˡ (cons (SR.sym (SR.*-assoc a b c)) ·-assoc) ⟩ (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) @@ -599,9 +477,93 @@ shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl (a · (b ∷ p)) * (c ∷ q) ∎ +0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → + shift (p * q) ≈ (shift p) * q +0∷[p*q]≈[0∷p]*q {n = n} [] q = begin + shift ([] * q) + ≈⟨ consʳ zerosm≈zerosn ⟩ + shift [] + ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero 0# q SR.refl) + (≈0⇒IsZero {m = n} zerosm≈zerosn)) ⟨ + 0# · q + zeros (pred (suc n)) + ≈⟨ cast-p≈p (ℕ.⊔-idem (pred (1 ℕ.+ n))) ⟨ + shift [] * q ∎ +0∷[p*q]≈[0∷p]*q {m = suc m} {n = n} (a ∷ p) (q) = begin + shift ((a ∷ p) * q) + ≈⟨ *-distrib-shift (a ∷ p) q ⟨ + (a ∷ p) * shift q + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + a · shift q + p * (0# ∷ shift q) + ≈⟨ +-idˡ (0# · q) (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) + (a≈0⇒a·pIsZero 0# q SR.refl) ⟨ + 0# · q + (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) + ≈⟨ +-congʳ (cast-p≈p (cast-lem (suc n) m)) ⟨ + 0# · q + (a ∷ p) * (0# ∷ q) + ≈⟨ cast-p≈p (cast-lem n (suc m)) ⟨ + shift (a ∷ p) * q ∎ + +*-distribˡ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → + p * (q + r) ≈ p * q + p * r +*-distribˡ-+ [] q r = begin + [] * (q + r) + ≈⟨ zerosm≈zerosn ⟩ + [] + ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ + [] * q + [] * r ∎ +*-distribˡ-+ {m = suc m} {n = n} {k = k} (a ∷ p) q r = begin + (a ∷ p) * (q + r) + ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ + a · (q + r) + p * (0# ∷ q + r) + ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ + (a · q + a · r) + (0# ∷ (p * (q + r))) + ≈⟨ +-congʳ (consʳ (*-distribˡ-+ p q r)) ⟩ + (a · q + a · r) + (0# ∷ (p * q + p * r)) + ≈⟨ +-congʳ (consˡ (SR.+-identityʳ 0#)) ⟨ + (a · q + a · r) + ((0# ∷ (p * q)) + (0# ∷ (p * r))) + ≈⟨ middleFour (a · q) (a · r) (0# ∷ p * q) (0# ∷ p * r) ⟩ + ((a · q) + (0# ∷ (p * q))) + ((a · r) + (0# ∷ (p * r))) + ≈⟨ +-cong (+-congʳ (*-distrib-shift p q)) (+-congʳ (*-distrib-shift p r)) ⟨ + (a · q + p * (0# ∷ q)) + (a · r + p * (0# ∷ r)) + ≈⟨ +-cong (cast-p≈p (cast-lem n m)) (cast-p≈p (cast-lem k m)) ⟨ + (a ∷ p) * q + (a ∷ p) * r + ∎ + +*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (q + r) * p ≈ (q * p) + (r * p) +*-distribʳ-+ {m = m} p [] [] = sym (+-identityʳ (zeros (m ℕ.∸ 1))) +*-distribʳ-+ {m = m} {k = suc k} p [] (c ∷ r) = begin + ([] + (c ∷ r)) * p + ≈⟨ cast-p≈p (cast-lem m k) ⟩ + c · p + r * (0# ∷ p) + ≈⟨ cast-p≈p (cast-lem m k) ⟨ + (c ∷ r) * p + ≈⟨ +-identityˡ ((c ∷ r) * p) ⟨ + [] * p + (c ∷ r) * p + ∎ +*-distribʳ-+ {m = m} {n = suc n} p (b ∷ q) [] = begin + ((b ∷ q) + []) * p + ≈⟨ cast-p≈p (cast-lem m n) ⟩ + b · p + q * (0# ∷ p) + ≈⟨ cast-p≈p (cast-lem m n) ⟨ + (b ∷ q) * p + ≈⟨ +-identityʳ ((b ∷ q) * p) ⟨ + (b ∷ q) * p + [] * p + ∎ +*-distribʳ-+ {m} {suc n} {suc k} p (b ∷ q) (c ∷ r) = begin + ((b ∷ q) + (c ∷ r)) * p + ≈⟨ cast-p≈p (cast-lem m (n ⊔ k)) ⟩ + (b +A c) · p + (q + r) * (0# ∷ p) + ≈⟨ +-cong (·-distrib-+A b c p) (*-distribʳ-+ (0# ∷ p) q r) ⟩ + ((b · p) + (c · p)) + (q * (0# ∷ p) + r * (0# ∷ p)) + ≈⟨ middleFour (b · p) (c · p) (q * (0# ∷ p)) (r * (0# ∷ p)) ⟩ + (b · p + q * (0# ∷ p)) + (c · p + r * (0# ∷ p)) + ≈⟨ +-cong (cast-p≈p (cast-lem m n)) (cast-p≈p (cast-lem m k)) ⟨ + (b ∷ q) * p + (c ∷ r) * p + ∎ + *-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → (p * q) * r ≈ p * (q * r) -*-assoc {_} {n} {k} [] q r = begin +*-assoc {n = n} {k} [] q r = begin zeros (n ℕ.∸ 1) * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 (zerosIsZero (n ℕ.∸ 1))) ⟩ [] @@ -616,7 +578,7 @@ shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl ((a · q) + (0# ∷ (p * q))) * r ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ ((a · q) * r) + ((0# ∷ (p * q)) * r) - ≈⟨ +-congʳ step8 ⟨ + ≈⟨ +-congʳ step1 ⟨ ((a · q) * r) + (0# ∷ (p * (q * r))) ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ (a · (q * r)) + (0# ∷ (p * (q * r))) @@ -626,7 +588,7 @@ shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl (a ∷ p) * (q * r) ∎ where - step8 = begin + step1 = begin 0# ∷ (p * (q * r)) ≈⟨ consʳ (*-assoc p q r) ⟨ 0# ∷ ((p * q) * r) @@ -634,7 +596,7 @@ shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl (0# ∷ (p * q)) * r ≈⟨ cast-p≈p (cast-lem k (m ℕ.+ n ℕ.∸ 1)) ⟩ (0# · r) + ((p * q) * (0# ∷ r)) - ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r CR.refl) ) ⟩ + ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r SR.refl) ) ⟩ zeros k + ((p * q) * (0# ∷ r)) ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ zeros k + (0# ∷ ((p * q) * r)) @@ -643,21 +605,5 @@ shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ (0# ∷ (p * q)) * r ∎ + ---------------------------------------------------------------------- --- Multiplicative identity - -*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p -*-identityʳ {0} [] = zerosm≈zerosn -*-identityʳ {suc n} (a ∷ p) = begin - (a ∷ p) * (1# ∷ []) - ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ - (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congˡ (consˡ (CR.*-identityʳ a)) ⟩ - (a ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ - (a ∷ []) + (0# ∷ (p * (1# ∷ []))) - ≈⟨ cons (CR.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ - a ∷ (p * (1# ∷ [])) - ≈⟨ consʳ (*-identityʳ p) ⟩ - a ∷ p ∎ diff --git a/src/Algebra/Polynomial/Poly/Properties1.agda b/src/Algebra/Polynomial/Poly/Properties1.agda new file mode 100644 index 0000000000..de8401c194 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Properties1.agda @@ -0,0 +1,646 @@ +open import Algebra.Bundles using (Ring) + +module Algebra.Polynomial.Poly.Properties1 + {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Base1 R as P + using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) +open import Algebra.Properties.Ring +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +import Data.Nat.Properties as ℕ +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All using (All ; []; _∷_; head; tail) +import Level as L +open import Relation.Binary +open import Relation.Binary.PropositionalEquality as Eq + using (_≡_; module ≡-Reasoning) +open import Relation.Binary.PropositionalEquality.Core using (cong) + +module R = Ring R +open R + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +private + variable + m n k l : ℕ + a b c d : A + p : Poly m + q : Poly n + r : Poly k + s : Poly l + +--------------------------------------------------------------------- +-- Equational reasoning for Poly n and Poly m +-- where m is not necesarily the same as n +private + + infix 4 _IsRelatedTo_ + + data _IsRelatedTo_ (p : Poly m) (q : Poly n) : Set (ℓ₁ L.⊔ ℓ₂) where + relTo : (p≈q : p ≈ q) → p IsRelatedTo q + + start : _IsRelatedTo_ {m} {n} ⇒ _≈_ + start (relTo p≈q) = p≈q + + ∼-go : Trans (_≈_) (_IsRelatedTo_ {n} {k}) (_IsRelatedTo_ {m} {k}) + ∼-go p≈q (relTo q≈r) = relTo (trans p≈q q≈r) + + stop : Reflexive (_IsRelatedTo_ {m} {m}) + stop = relTo refl + + forward : (p : Poly m) → q IsRelatedTo r → p ≈ q → p IsRelatedTo r + forward p qRr p≈q = ∼-go p≈q qRr + + backward : (p : Poly m) → q IsRelatedTo r → q ≈ p → p IsRelatedTo r + backward p qRr q≈p = ∼-go (sym q≈p) qRr + + infix 1 begin_ + begin_ : p IsRelatedTo q → p ≈ q + begin_ = start + + infixr 2 step-∼-⟩ + step-∼-⟩ = forward + syntax step-∼-⟩ p qRr p≈q = p ≈⟨ p≈q ⟩ qRr + + infixr 2 step-∼-⟨ + step-∼-⟨ = backward + syntax step-∼-⟨ p qRr q≈p = p ≈⟨ q≈p ⟨ qRr + + infix 3 _∎ + _∎ : (p : Poly m) → p IsRelatedTo p + p ∎ = stop + +-- Properties of zero polynomial + +zerosIsZero : (n : ℕ) → IsZero (zeros n) +zerosIsZero 0 = [] +zerosIsZero (suc n) = R.refl ∷ (zerosIsZero n) + +zerosm≈zerosn : zeros m ≈ zeros n +zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) + +≈0⇒IsZero : p ≈ zeros m → IsZero p +≈0⇒IsZero ([]≈ zeros zeros≈0) = [] +≈0⇒IsZero (≈[] p p≈0) = p≈0 +≈0⇒IsZero (cons a≈0 p≈0) = a≈0 ∷ ≈0⇒IsZero p≈0 + +IsZero⇒≈0 : IsZero p → p ≈ zeros m +IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) + +All-p≈0∧q≈0⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] [] = [] +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +All-p≈0∧q≈0⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = R.trans (R.+-cong a≈0 b≈0) (R.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 + +------------------------------------------------------ +-- Additive inverse + +[-p]+pIsZero : {p : Poly m} → IsZero ((- p) + p) +[-p]+pIsZero {p = []} = [] +[-p]+pIsZero {p = a ∷ p} = R.-‿inverseˡ a ∷ [-p]+pIsZero + +p+[-p]IsZero : {p : Poly m} → IsZero (p + (- p)) +p+[-p]IsZero {p = []} = [] +p+[-p]IsZero {p = a ∷ p} = R.-‿inverseʳ a ∷ p+[-p]IsZero + ++-inverseˡ : (p : Poly m) → (- p) + p ≈ [] ++-inverseˡ [] = refl ++-inverseˡ (a ∷ p) + = ≈[] ((- (a ∷ p)) + (a ∷ p)) (R.-‿inverseˡ a ∷ [-p]+pIsZero) + ++-inverseʳ : (p : Poly m) → p + (- p) ≈ [] ++-inverseʳ [] = refl ++-inverseʳ (a ∷ p) + = ≈[] ((a ∷ p) + (- (a ∷ p))) ((R.-‿inverseʳ a) ∷ p+[-p]IsZero) + +------------------------------------------------------- +-- Negation is congruent + +-⁺ : IsZero p → IsZero (- p) +-⁺ [] = [] +-⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε R a≈0 ∷ (-⁺ p≈0) + +-⁻ : IsZero (- p) → IsZero p +-⁻ {p = []} -p≈0 = -p≈0 +-⁻ {p = a ∷ p} (-a≈0 ∷ -p≈0) = x⁻¹≈ε⇒x≈ε R -a≈0 ∷ (-⁻ -p≈0) + +-‿cong : p ≈ q → - p ≈ - q +-‿cong ([]≈ q q≈0) = []≈ (- q) (-⁺ q≈0) +-‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) +-‿cong (cons a≈b p≈q) = cons (R.-‿cong a≈b) (-‿cong p≈q) + +----------------------------------------------------- +-- Properties of polynomial addition + ++-comm : (p : Poly m) → (q : Poly n) → p + q ≈ q + p ++-comm [] [] = refl ++-comm [] (a ∷ p) = refl ++-comm (a ∷ p) [] = refl ++-comm (a ∷ p) (b ∷ q) = cons (R.+-comm a b) (+-comm p q) + ++-idʳ : (p : Poly n) → (q : Poly m) → IsZero q → p + q ≈ p ++-idʳ [] q [] = refl ++-idʳ (a ∷ p) q [] = refl ++-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) ++-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) + = cons (R.trans (R.+-congˡ b≈0) (R.+-identityʳ a)) (+-idʳ p q q≈0) + ++-idˡ : (p : Poly n) → (q : Poly m) → IsZero p → p + q ≈ q ++-idˡ p q p≈0 = begin + p + q ≈⟨ +-comm p q ⟩ + q + p ≈⟨ +-idʳ q p p≈0 ⟩ + q ∎ + ++-identityʳ : (p : Poly n) → p + (zeros m) ≈ p ++-identityʳ {m = m} p = +-idʳ p (zeros m) (zerosIsZero m) + ++-identityˡ : (p : Poly n) → (zeros m) + p ≈ p ++-identityˡ {m = m} p = +-idˡ (zeros m) p (zerosIsZero m) + ++-cong : p ≈ q → r ≈ s → p + r ≈ q + s ++-cong {p = _} {q = _} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin + [] + r ≈⟨ +-identityˡ r ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-idˡ q s q≈0 ⟨ + q + s ∎ ++-cong {p = _} {q = _} {r = r} {s = s} (≈[] p p≈0) r≈s = begin + p + r ≈⟨ +-idˡ p r p≈0 ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-identityˡ s ⟨ + [] + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} {r = _} {s = s} (cons a≈b p≈q) ([]≈ s s≈0) = begin + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ + (b ∷ q) + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} {r = r} {s = _} (cons a≈b p≈q) (≈[] r r≈0) = begin + (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ∎ ++-cong (cons a≈b p≈q) (cons c≈d r≈s) + = cons (R.+-cong a≈b c≈d) (+-cong p≈q r≈s) + ++-congˡ : p ≈ q → p + r ≈ q + r ++-congˡ p≈q = +-cong p≈q refl + ++-congʳ : q ≈ r → p + q ≈ p + r ++-congʳ q≈r = +-cong refl q≈r + ++-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (p + q) + r ≈ p + (q + r) ++-assoc [] q r = begin + ([] + q) + r ≈⟨ +-congˡ (+-identityˡ q) ⟩ + q + r ≈⟨ +-identityˡ (q + r) ⟨ + [] + (q + r) ∎ ++-assoc (a ∷ p) [] r = +-congʳ (sym (+-identityˡ r)) ++-assoc (a ∷ p) (b ∷ q) [] = refl ++-assoc (a ∷ p) (b ∷ q) (c ∷ r) + = cons (R.+-assoc a b c) (+-assoc p q r) + +middleFour : (p : Poly m) → (q : Poly n) → (r : Poly k) → (w : Poly l) → + (p + q) + (r + w) ≈ (p + r) + (q + w) +middleFour p q r w = begin + (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ + (p + q + r) + w ≈⟨ +-congˡ (+-assoc p q r) ⟩ + (p + (q + r)) + w ≈⟨ +-congˡ (+-congʳ (+-comm q r)) ⟩ + (p + (r + q)) + w ≈⟨ +-congˡ (+-assoc p r q) ⟨ + (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ + (p + r) + (q + w) ∎ + +------------------------------------------------------------------ +-- Vector casting lemmas + +private + n+1≡sucn+0 : (n ℕ.+ 1) ≡ suc (n ℕ.+ 0) + n+1≡sucn+0 {0} = Eq.refl + n+1≡sucn+0 {suc n} = cong suc n+1≡sucn+0 + + cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → + All (_≈A 0#) (Vec.cast m≡n p) + cast-p≈0⇒p≈0 {n = 0} {[]} m≡n [] = [] + cast-p≈0⇒p≈0 {n = suc n} {a ∷ p} m≡n (a≈0 ∷ p≈0) + = a≈0 ∷ cast-p≈0⇒p≈0 (cong pred m≡n) p≈0 + + cast-p≈p : (m≡n : m ≡ n) → Vec.cast m≡n p ≈ p + cast-p≈p {n = 0} {[]} Eq.refl = refl + cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) + + +------------------------------------------------------------------ +-- Properties of polynomial shifting + +*-distrib-shift : (p : Poly m) → (q : Poly n) → + p * (shift q) ≈ shift (p * q) +*-distrib-shift {_} {_} [] qs = zerosm≈zerosn +*-distrib-shift {suc m} {n} (a ∷ p) q = begin + (a ∷ p) * (0# ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + a · (0# ∷ q) + p * (0# ∷ 0# ∷ q) + ≈⟨ +-congˡ (consˡ (R.zeroʳ a)) ⟩ + (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) + ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ + (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ consˡ (R.+-identityˡ 0#) ⟩ + 0# ∷ (a · q + p * (0# ∷ q)) + ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟨ + 0# ∷ ((a ∷ p) * q) + ∎ + +·-distrib-shift : (a : A) → (p : Poly m) → a · (shift p) ≈ shift (a · p) +·-distrib-shift a [] = cons (R.zeroʳ a) (refl) +·-distrib-shift a (b ∷ p) = consˡ (R.zeroʳ a) + +---------------------------------------------------------------- +-- Properties of polynomial scaling + +a·p≈a∷[]*p : (a : A) → (p : Poly n) → a · p ≈ (a ∷ []) * p +a·p≈a∷[]*p {_} a [] = refl +a·p≈a∷[]*p {suc n} a (b ∷ p) = begin + a · (b ∷ p) + ≈⟨ cons (R.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ + a *A b +A 0# ∷ (a · p + zeros n) + ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟨ + (a ∷ []) * (b ∷ p) ∎ + +1·p≈p : (p : Poly n) → 1# · p ≈ p +1·p≈p [] = refl +1·p≈p (a ∷ p) = cons (R.*-identityˡ a) (1·p≈p p) + + +pIsZero⇒a·pIsZero : (a : A) → (p : Poly n) → IsZero p → IsZero (a · p) +pIsZero⇒a·pIsZero a p [] = [] +pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) + = (R.trans (R.*-congˡ b≈0) (R.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 + +a≈0⇒a·pIsZero : (a : A) → (p : Poly n) → a ≈A 0# → IsZero (a · p) +a≈0⇒a·pIsZero a [] a≈0 = [] +a≈0⇒a·pIsZero a (b ∷ p) a≈0 + = R.trans (R.*-congʳ a≈0) (R.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) + +·-cong : a ≈A b → p ≈ q → a · p ≈ b · q +·-cong {a = _} {b = b} _ ([]≈ q q≈0) + = sym (IsZero⇒≈0 (pIsZero⇒a·pIsZero b q q≈0)) +·-cong {a = a} {b = _} _ (≈[] p p≈0) + = IsZero⇒≈0 (pIsZero⇒a·pIsZero a p p≈0) +·-cong {a = _} {b = _} c≈d (cons a≈b p≈q) + = cons (R.*-cong c≈d a≈b) (·-cong c≈d p≈q) + +·-congˡ : a ≈A b → a · p ≈ b · p +·-congˡ a≈b = ·-cong a≈b refl + +·-congʳ : p ≈ q → a · p ≈ a · q +·-congʳ = ·-cong R.refl + +·-dist : a · (p + q) ≈ (a · p) + (a · q) +·-dist {p = []} {q = []} = refl +·-dist {p = []} {q = b ∷ q} = refl +·-dist {p = b ∷ p} {q = []} = refl +·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (R.distribˡ a b c) ·-dist + +·-assoc : a · (b · p) ≈ (a *A b) · p +·-assoc {p = []} = refl +·-assoc {a} {b} {p = c ∷ p} = cons (R.sym (R.*-assoc a b c)) ·-assoc + +a·-cong : p ≈ q → a · p ≈ a · q +a·-cong = ·-cong R.refl + +·-distrib-+A : (a b : A) → (p : Poly m) → (a +A b) · p ≈ a · p + b · p +·-distrib-+A a b [] = refl +·-distrib-+A a b (c ∷ p) = cons (R.distribʳ c a b) (·-distrib-+A a b p) + +----------------------------------------------------------------- +-- Properties of polynomial multiplication + +zeroˡ : (p : Poly m) → [] * p ≈ [] +zeroˡ p = zerosm≈zerosn + +zeroʳ : (p : Poly m) → p * [] ≈ [] +zeroʳ [] = refl +zeroʳ {m} (a ∷ p) = begin + (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ + p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ + 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ + 0# ∷ [] ≈⟨ zerosm≈zerosn ⟩ + [] ∎ + +pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) +pIsZero⇒p*qIsZero {n} {p = []} q [] = zerosIsZero (pred n) +pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) + = cast-p≈0⇒p≈0 (cast-lem n m) + (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) + +p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] +p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) + +*-cong : {p : Poly m} → {q : Poly n} → {r : Poly k} → {s : Poly l} → + p ≈ q → r ≈ s → p * r ≈ q * s +*-cong {k = k} {q = q} {r} {s} ([]≈ q q≈0) r≈s = begin + [] * r ≈⟨ p≈[]⇒p*q≈[] r refl ⟩ + [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒≈0 q≈0) ⟨ + q * s ∎ +*-cong {k = k} {q = q} {r} {s} (≈[] p p≈0) r≈s = begin + p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 p≈0) ⟩ + [] ≈⟨ zerosm≈zerosn ⟩ + [] * s ∎ +*-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin + (a ∷ p) * [] + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + [] + p * (0# ∷ []) + ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ + [] + q * (0# ∷ s) + ≈⟨ +-congˡ (zerosm≈zerosn) ⟩ + zeros l + q * (0# ∷ s) + ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero b s s≈0)) ⟨ + (b · s) + q * (0# ∷ s) + ≈⟨ cast-p≈p (cast-lem l n) ⟨ + (b ∷ q) * s + ∎ +*-cong {suc m} {k = k} {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) (≈[] r s≈0) = begin + (a ∷ p) * r + ≈⟨ cast-p≈p (cast-lem k m) ⟩ + (a · r) + p * (0# ∷ r) + ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ ([]≈ r s≈0))) ⟨ + (a · r) + q * (0# ∷ []) + ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero a r s≈0)) ⟩ + zeros k + q * (0# ∷ []) + ≈⟨ +-congˡ zerosm≈zerosn ⟩ + (b · []) + q * (0# ∷ []) + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + (b ∷ q) * [] + ∎ +*-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin + (a ∷ p) * (c ∷ r) + ≈⟨ cast-p≈p (cast-lem (suc k) m)⟩ + (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consˡ (R.*-cong a≈b c≈d)) ⟩ + (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consʳ (·-cong a≈b r≈s)) ⟩ + (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) + ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ + (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) + ≈⟨ cast-p≈p (cast-lem (suc l) n) ⟨ + (b ∷ q) * (d ∷ s) + ∎ + +*-congʳ : q ≈ r → p * q ≈ p * r +*-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r + +*-congˡ : p ≈ q → p * r ≈ q * r +*-congˡ p≈q = *-cong p≈q refl + +qIsZero⇒p*qIsZero : (p : Poly m) → IsZero q → IsZero (p * q) +qIsZero⇒p*qIsZero {m} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) +qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) + = ≈0⇒IsZero ( + begin + p * (b ∷ q) ≈⟨ *-congʳ {p = p} (consˡ b≈0) ⟩ + p * (0# ∷ q) ≈⟨ *-distrib-shift p q ⟩ + 0# ∷ (p * q) ≈⟨ consʳ (IsZero⇒≈0 (qIsZero⇒p*qIsZero p q≈0)) ⟩ + 0# ∷ (zeros m) ≈⟨ zerosm≈zerosn ⟩ + zeros m ∎ + ) + +q≈[]→p*q≈[] : (p : Poly n) → q ≈ [] → p * q ≈ [] +q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero q≈0)) + +shift-distrib-+ : (p : Poly m) → (q : Poly n) → + shift (p + q) ≈ (shift p) + (shift q) +shift-distrib-+ p q = cons (R.sym (R.+-identityʳ 0#)) refl + +*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p +*-identityʳ {0} [] = zerosm≈zerosn +*-identityʳ {suc n} (a ∷ p) = begin + (a ∷ p) * (1# ∷ []) + ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ + (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congˡ (consˡ (R.*-identityʳ a)) ⟩ + (a ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ + (a ∷ []) + (0# ∷ (p * (1# ∷ []))) + ≈⟨ cons (R.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ + a ∷ (p * (1# ∷ [])) + ≈⟨ consʳ (*-identityʳ p) ⟩ + a ∷ p ∎ + +*-identityˡ : (p : Poly n) → (1# ∷ []) * p ≈ p +*-identityˡ [] = refl +*-identityˡ {suc n} (a ∷ p) = begin + (1# ∷ []) * (a ∷ p) + ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟩ + 1# · (a ∷ p) + [] * (0# ∷ a ∷ p) + ≈⟨ +-identityʳ {m = pred (suc (suc n))} (1# · (a ∷ p) + []) ⟩ + 1# · (a ∷ p) + [] + ≈⟨ +-identityʳ {m = 0} (1# · (a ∷ p)) ⟩ + 1# · (a ∷ p) + ≈⟨ cons (R.*-identityˡ a) (1·p≈p p) ⟩ + a ∷ p ∎ + +-- (0# ∷ 1# ∷ []) is the center of a polynomial ring +shiftp≈p*x : (p : Poly n) → shift p ≈ p * (0# ∷ 1# ∷ []) +shiftp≈p*x [] = refl +shiftp≈p*x {suc n} (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ cons (R.+-identityˡ 0#) (cons (R.+-identityʳ a) (+-identityˡ p)) ⟨ + (0# ∷ a ∷ []) + shift (shift p) + ≈⟨ consʳ (consʳ (+-congʳ (*-identityʳ p))) ⟨ + (0# ∷ a ∷ []) + (shift (shift (p * (1# ∷ [])))) + ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (consʳ (*-distrib-shift p (1# ∷ []))) ⟨ + (0# ∷ a ∷ []) + shift (p * shift (1# ∷ [])) + ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (*-distrib-shift p (0# ∷ 1# ∷ [])) ⟨ + (0# ∷ a ∷ []) + p * shift (shift (1# ∷ [])) + ≈⟨ +-congˡ (cons (R.zeroʳ a) (consˡ (R.*-identityʳ a))) ⟨ + a · (0# ∷ 1# ∷ []) + p * (0# ∷ 0# ∷ 1# ∷ []) + ≈⟨ cast-p≈p (cast-lem 2 n) ⟨ + (a ∷ p) * (0# ∷ 1# ∷ []) ∎ + +shiftp≈x*p : (p : Poly n) → shift p ≈ (0# ∷ 1# ∷ []) * p +shiftp≈x*p [] = consˡ (R.sym (R.trans (R.+-identityʳ (1# *A 0#)) (R.zeroʳ 1#))) +shiftp≈x*p {suc n} (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ *-identityˡ (0# ∷ a ∷ p) ⟨ + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟨ + [] + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟩ + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-idˡ (0# *A a ∷ 0# · p) ((1# ∷ []) * (0# ∷ a ∷ p)) + ((R.zeroˡ a) ∷ a≈0⇒a·pIsZero 0# p R.refl) ⟨ + 0# · (a ∷ p) + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ consʳ (cast-p≈p (ℕ.m≤n⇒m⊔n≡n (ℕ.n≤1+n n))) ⟨ + (0# ∷ 1# ∷ []) * (a ∷ p) ∎ + +·-distrib-* : (p : Poly m) → (q : Poly n) → (a : A) → + a · (p * q) ≈ (a · p) * q +·-distrib-* {_} {n} [] q a = begin + a · ([] * q) ≈⟨ ·-congʳ zerosm≈zerosn ⟩ + a · [] ≈⟨ zerosm≈zerosn ⟨ + (a · []) * q ∎ +·-distrib-* {suc m} {_} (b ∷ p) [] a = begin + a · ((b ∷ p) * []) + ≈⟨ a·-cong (cast-p≈p (cong pred n+1≡sucn+0)) ⟩ + a · ((b · []) + (p * (0# ∷ []))) + ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ + a · (p * (0# ∷ [])) + ≈⟨ a·-cong (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ + [] + ≈⟨ q≈[]→p*q≈[] ((a · p)) zerosm≈zerosn ⟨ + (a · p) * (0# ∷ []) + ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ + ((a *A b) · []) + ((a · p) * (0# ∷ [])) + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + (a · (b ∷ p)) * [] + ∎ +·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin + a · ((b ∷ p) * (c ∷ q)) + ≈⟨ a·-cong (cast-p≈p (cast-lem (suc n) m)) ⟩ + a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) + ≈⟨ ·-dist ⟩ + a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congˡ (cons (R.sym (R.*-assoc a b c)) ·-assoc) ⟩ + (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ + (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟨ + (a · (b ∷ p)) * (c ∷ q) + ∎ + +0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → + shift (p * q) ≈ (shift p) * q +0∷[p*q]≈[0∷p]*q {n = n} [] q = begin + shift ([] * q) + ≈⟨ consʳ zerosm≈zerosn ⟩ + shift [] + ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero 0# q R.refl) + (≈0⇒IsZero {m = n} zerosm≈zerosn)) ⟨ + 0# · q + zeros (pred (suc n)) + ≈⟨ cast-p≈p (ℕ.⊔-idem (pred (1 ℕ.+ n))) ⟨ + shift [] * q ∎ +0∷[p*q]≈[0∷p]*q {m = suc m} {n = n} (a ∷ p) (q) = begin + shift ((a ∷ p) * q) + ≈⟨ *-distrib-shift (a ∷ p) q ⟨ + (a ∷ p) * shift q + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + a · shift q + p * (0# ∷ shift q) + ≈⟨ +-idˡ (0# · q) (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) + (a≈0⇒a·pIsZero 0# q R.refl) ⟨ + 0# · q + (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) + ≈⟨ +-congʳ (cast-p≈p (cast-lem (suc n) m)) ⟨ + 0# · q + (a ∷ p) * (0# ∷ q) + ≈⟨ cast-p≈p (cast-lem n (suc m)) ⟨ + shift (a ∷ p) * q ∎ + +*-distribˡ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → + p * (q + r) ≈ p * q + p * r +*-distribˡ-+ [] q r = begin + [] * (q + r) + ≈⟨ zerosm≈zerosn ⟩ + [] + ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ + [] * q + [] * r ∎ +*-distribˡ-+ {m = suc m} {n = n} {k = k} (a ∷ p) q r = begin + (a ∷ p) * (q + r) + ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ + a · (q + r) + p * (0# ∷ q + r) + ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ + (a · q + a · r) + (0# ∷ (p * (q + r))) + ≈⟨ +-congʳ (consʳ (*-distribˡ-+ p q r)) ⟩ + (a · q + a · r) + (0# ∷ (p * q + p * r)) + ≈⟨ +-congʳ (consˡ (R.+-identityʳ 0#)) ⟨ + (a · q + a · r) + ((0# ∷ (p * q)) + (0# ∷ (p * r))) + ≈⟨ middleFour (a · q) (a · r) (0# ∷ p * q) (0# ∷ p * r) ⟩ + ((a · q) + (0# ∷ (p * q))) + ((a · r) + (0# ∷ (p * r))) + ≈⟨ +-cong (+-congʳ (*-distrib-shift p q)) (+-congʳ (*-distrib-shift p r)) ⟨ + (a · q + p * (0# ∷ q)) + (a · r + p * (0# ∷ r)) + ≈⟨ +-cong (cast-p≈p (cast-lem n m)) (cast-p≈p (cast-lem k m)) ⟨ + (a ∷ p) * q + (a ∷ p) * r + ∎ + +*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (q + r) * p ≈ (q * p) + (r * p) +*-distribʳ-+ {m = m} p [] [] = sym (+-identityʳ (zeros (m ℕ.∸ 1))) +*-distribʳ-+ {m = m} {k = suc k} p [] (c ∷ r) = begin + ([] + (c ∷ r)) * p + ≈⟨ cast-p≈p (cast-lem m k) ⟩ + c · p + r * (0# ∷ p) + ≈⟨ cast-p≈p (cast-lem m k) ⟨ + (c ∷ r) * p + ≈⟨ +-identityˡ ((c ∷ r) * p) ⟨ + [] * p + (c ∷ r) * p + ∎ +*-distribʳ-+ {m = m} {n = suc n} p (b ∷ q) [] = begin + ((b ∷ q) + []) * p + ≈⟨ cast-p≈p (cast-lem m n) ⟩ + b · p + q * (0# ∷ p) + ≈⟨ cast-p≈p (cast-lem m n) ⟨ + (b ∷ q) * p + ≈⟨ +-identityʳ ((b ∷ q) * p) ⟨ + (b ∷ q) * p + [] * p + ∎ +*-distribʳ-+ {m} {suc n} {suc k} p (b ∷ q) (c ∷ r) = begin + ((b ∷ q) + (c ∷ r)) * p + ≈⟨ cast-p≈p (cast-lem m (n ⊔ k)) ⟩ + (b +A c) · p + (q + r) * (0# ∷ p) + ≈⟨ +-cong (·-distrib-+A b c p) (*-distribʳ-+ (0# ∷ p) q r) ⟩ + ((b · p) + (c · p)) + (q * (0# ∷ p) + r * (0# ∷ p)) + ≈⟨ middleFour (b · p) (c · p) (q * (0# ∷ p)) (r * (0# ∷ p)) ⟩ + (b · p + q * (0# ∷ p)) + (c · p + r * (0# ∷ p)) + ≈⟨ +-cong (cast-p≈p (cast-lem m n)) (cast-p≈p (cast-lem m k)) ⟨ + (b ∷ q) * p + (c ∷ r) * p + ∎ + +*-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (p * q) * r ≈ p * (q * r) +*-assoc {n = n} {k} [] q r = begin + zeros (n ℕ.∸ 1) * r + ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 (zerosIsZero (n ℕ.∸ 1))) ⟩ + [] + ≈⟨ zerosm≈zerosn ⟩ + zeros (pred (0 ℕ.+ pred (n ℕ.+ k))) + ∎ +*-assoc {suc m} {n} {k} (a ∷ p) q r = begin + ((a ∷ p) * q) * r + ≈⟨ *-congˡ (cast-p≈p (cast-lem n m)) ⟩ + ((a · q) + (p * (0# ∷ q))) * r + ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ + ((a · q) + (0# ∷ (p * q))) * r + ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ + ((a · q) * r) + ((0# ∷ (p * q)) * r) + ≈⟨ +-congʳ step1 ⟨ + ((a · q) * r) + (0# ∷ (p * (q * r))) + ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ + (a · (q * r)) + (0# ∷ (p * (q * r))) + ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ + (a · (q * r)) + (p * (0# ∷ (q * r))) + ≈⟨ cast-p≈p (cast-lem (pred (n ℕ.+ k)) m) ⟨ + (a ∷ p) * (q * r) + ∎ + where + step1 = begin + 0# ∷ (p * (q * r)) + ≈⟨ consʳ (*-assoc p q r) ⟨ + 0# ∷ ((p * q) * r) + ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ + (0# ∷ (p * q)) * r + ≈⟨ cast-p≈p (cast-lem k (m ℕ.+ n ℕ.∸ 1)) ⟩ + (0# · r) + ((p * q) * (0# ∷ r)) + ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r R.refl) ) ⟩ + zeros k + ((p * q) * (0# ∷ r)) + ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ + zeros k + (0# ∷ ((p * q) * r)) + ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ + zeros k + ((0# ∷ (p * q)) * r) + ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ + (0# ∷ (p * q)) * r + ∎ + + diff --git a/src/Algebra/Polynomial/Poly/Properties2.agda b/src/Algebra/Polynomial/Poly/Properties2.agda new file mode 100644 index 0000000000..56c7f0612c --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Properties2.agda @@ -0,0 +1,663 @@ +open import Algebra.Bundles using (CommutativeRing) + +module Algebra.Polynomial.Poly.Properties2 + {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Base2 R as P + using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) +open import Algebra.Properties.Ring +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +import Data.Nat.Properties as ℕ +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All using (All ; []; _∷_; head; tail) +import Level as L +open import Relation.Binary +open import Relation.Binary.PropositionalEquality as Eq + using (_≡_; module ≡-Reasoning) +open import Relation.Binary.PropositionalEquality.Core using (cong) + +module CR = CommutativeRing R +open CR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +private + variable + m n k l : ℕ + a b c d : A + p : Poly m + q : Poly n + r : Poly k + s : Poly l + +--------------------------------------------------------------------- +-- Equational reasoning for Poly n and Poly m +-- where m is not necesarily the same as n +private + + infix 4 _IsRelatedTo_ + + data _IsRelatedTo_ (p : Poly m) (q : Poly n) : Set (ℓ₁ L.⊔ ℓ₂) where + relTo : (p≈q : p ≈ q) → p IsRelatedTo q + + start : _IsRelatedTo_ {m} {n} ⇒ _≈_ + start (relTo p≈q) = p≈q + + ∼-go : Trans (_≈_) (_IsRelatedTo_ {n} {k}) (_IsRelatedTo_ {m} {k}) + ∼-go p≈q (relTo q≈r) = relTo (trans p≈q q≈r) + + stop : Reflexive (_IsRelatedTo_ {m} {m}) + stop = relTo refl + + forward : (p : Poly m) → q IsRelatedTo r → p ≈ q → p IsRelatedTo r + forward p qRr p≈q = ∼-go p≈q qRr + + backward : (p : Poly m) → q IsRelatedTo r → q ≈ p → p IsRelatedTo r + backward p qRr q≈p = ∼-go (sym q≈p) qRr + + infix 1 begin_ + begin_ : p IsRelatedTo q → p ≈ q + begin_ = start + + infixr 2 step-∼-⟩ + step-∼-⟩ = forward + syntax step-∼-⟩ p qRr p≈q = p ≈⟨ p≈q ⟩ qRr + + infixr 2 step-∼-⟨ + step-∼-⟨ = backward + syntax step-∼-⟨ p qRr q≈p = p ≈⟨ q≈p ⟨ qRr + + infix 3 _∎ + _∎ : (p : Poly m) → p IsRelatedTo p + p ∎ = stop + +----------------------------------------------------------------- +-- Properties of zero polynomial + +zerosIsZero : (n : ℕ) → IsZero (zeros n) +zerosIsZero 0 = [] +zerosIsZero (suc n) = CR.refl ∷ (zerosIsZero n) + +zerosm≈zerosn : zeros m ≈ zeros n +zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) + +≈0⇒IsZero : p ≈ zeros m → IsZero p +≈0⇒IsZero ([]≈ zeros zeros≈0) = [] +≈0⇒IsZero (≈[] p p≈0) = p≈0 +≈0⇒IsZero (cons a≈0 p≈0) = a≈0 ∷ ≈0⇒IsZero p≈0 + +IsZero⇒≈0 : IsZero p → p ≈ zeros m +IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) + +All-p≈0∧q≈0⇒p+q≈0 : All (_≈A 0#) p → All (_≈A 0#) q → All (_≈A 0#) (p + q) +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] [] = [] +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +All-p≈0∧q≈0⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = CR.trans (CR.+-cong a≈0 b≈0) (CR.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 + +------------------------------------------------------ +-- Additive inverse + +[-p]+pIsZero : {p : Poly m} → IsZero ((- p) + p) +[-p]+pIsZero {p = []} = [] +[-p]+pIsZero {p = a ∷ p} = CR.-‿inverseˡ a ∷ [-p]+pIsZero + +p+[-p]IsZero : {p : Poly m} → IsZero (p + (- p)) +p+[-p]IsZero {p = []} = [] +p+[-p]IsZero {p = a ∷ p} = CR.-‿inverseʳ a ∷ p+[-p]IsZero + ++-inverseˡ : (p : Poly m) → (- p) + p ≈ [] ++-inverseˡ [] = refl ++-inverseˡ (a ∷ p) + = ≈[] ((- (a ∷ p)) + (a ∷ p)) (CR.-‿inverseˡ a ∷ [-p]+pIsZero) + ++-inverseʳ : (p : Poly m) → p + (- p) ≈ [] ++-inverseʳ [] = refl ++-inverseʳ (a ∷ p) + = ≈[] ((a ∷ p) + (- (a ∷ p))) ((CR.-‿inverseʳ a) ∷ p+[-p]IsZero) + +------------------------------------------------------- +-- Negation is congruent + +-⁺ : IsZero p → IsZero (- p) +-⁺ [] = [] +-⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε CR.ring a≈0 ∷ (-⁺ p≈0) + +-⁻ : IsZero (- p) → IsZero p +-⁻ {p = []} -p≈0 = -p≈0 +-⁻ {p = a ∷ p} (-a≈0 ∷ -p≈0) = x⁻¹≈ε⇒x≈ε CR.ring -a≈0 ∷ (-⁻ -p≈0) + +-‿cong : p ≈ q → - p ≈ - q +-‿cong ([]≈ q q≈0) = []≈ (- q) (-⁺ q≈0) +-‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) +-‿cong (cons a≈b p≈q) = cons (CR.-‿cong a≈b) (-‿cong p≈q) + +----------------------------------------------------- +-- Properties of polynomial addition + ++-comm : (p : Poly m) → (q : Poly n) → p + q ≈ q + p ++-comm [] [] = refl ++-comm [] (a ∷ p) = refl ++-comm (a ∷ p) [] = refl ++-comm (a ∷ p) (b ∷ q) = cons (CR.+-comm a b) (+-comm p q) + ++-idʳ : (p : Poly n) → (q : Poly m) → IsZero q → p + q ≈ p ++-idʳ [] q [] = refl ++-idʳ (a ∷ p) q [] = refl ++-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) ++-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) + = cons (CR.trans (CR.+-congˡ b≈0) (CR.+-identityʳ a)) (+-idʳ p q q≈0) + ++-idˡ : (p : Poly n) → (q : Poly m) → IsZero p → p + q ≈ q ++-idˡ p q p≈0 = begin + p + q ≈⟨ +-comm p q ⟩ + q + p ≈⟨ +-idʳ q p p≈0 ⟩ + q ∎ + ++-identityʳ : (p : Poly n) → p + (zeros m) ≈ p ++-identityʳ {m = m} p = +-idʳ p (zeros m) (zerosIsZero m) + ++-identityˡ : (p : Poly n) → (zeros m) + p ≈ p ++-identityˡ {m = m} p = +-idˡ (zeros m) p (zerosIsZero m) + ++-cong : p ≈ q → r ≈ s → p + r ≈ q + s ++-cong {p = _} {q = _} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin + [] + r ≈⟨ +-identityˡ r ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-idˡ q s q≈0 ⟨ + q + s ∎ ++-cong {p = _} {q = _} {r = r} {s = s} (≈[] p p≈0) r≈s = begin + p + r ≈⟨ +-idˡ p r p≈0 ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-identityˡ s ⟨ + [] + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} {r = _} {s = s} (cons a≈b p≈q) ([]≈ s s≈0) = begin + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ + (b ∷ q) + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} {r = r} {s = _} (cons a≈b p≈q) (≈[] r r≈0) = begin + (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ∎ ++-cong (cons a≈b p≈q) (cons c≈d r≈s) + = cons (CR.+-cong a≈b c≈d) (+-cong p≈q r≈s) + ++-congˡ : p ≈ q → p + r ≈ q + r ++-congˡ p≈q = +-cong p≈q refl + ++-congʳ : q ≈ r → p + q ≈ p + r ++-congʳ q≈r = +-cong refl q≈r + ++-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (p + q) + r ≈ p + (q + r) ++-assoc [] q r = begin + ([] + q) + r ≈⟨ +-congˡ (+-identityˡ q) ⟩ + q + r ≈⟨ +-identityˡ (q + r) ⟨ + [] + (q + r) ∎ ++-assoc (a ∷ p) [] r = +-congʳ (sym (+-identityˡ r)) ++-assoc (a ∷ p) (b ∷ q) [] = refl ++-assoc (a ∷ p) (b ∷ q) (c ∷ r) + = cons (CR.+-assoc a b c) (+-assoc p q r) + +middleFour : (p : Poly m) → (q : Poly n) → (r : Poly k) → (w : Poly l) → + (p + q) + (r + w) ≈ (p + r) + (q + w) +middleFour p q r w = begin + (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ + (p + q + r) + w ≈⟨ +-congˡ (+-assoc p q r) ⟩ + (p + (q + r)) + w ≈⟨ +-congˡ (+-congʳ (+-comm q r)) ⟩ + (p + (r + q)) + w ≈⟨ +-congˡ (+-assoc p r q) ⟨ + (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ + (p + r) + (q + w) ∎ + +------------------------------------------------------------------ +-- Vector casting lemmas + +private + n+1≡sucn+0 : (n ℕ.+ 1) ≡ suc (n ℕ.+ 0) + n+1≡sucn+0 {0} = Eq.refl + n+1≡sucn+0 {suc n} = cong suc n+1≡sucn+0 + + cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → + All (_≈A 0#) (Vec.cast m≡n p) + cast-p≈0⇒p≈0 {n = 0} {[]} m≡n [] = [] + cast-p≈0⇒p≈0 {n = suc n} {a ∷ p} m≡n (a≈0 ∷ p≈0) + = a≈0 ∷ cast-p≈0⇒p≈0 (cong pred m≡n) p≈0 + +cast-p≈p : (m≡n : m ≡ n) → Vec.cast m≡n p ≈ p +cast-p≈p {n = 0} {[]} Eq.refl = refl +cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) + +------------------------------------------------------------------ +-- Properties of polynomial shifting + +*-distrib-shift : (p : Poly m) → (q : Poly n) → + p * (shift q) ≈ shift (p * q) +*-distrib-shift {_} {_} [] qs = zerosm≈zerosn +*-distrib-shift {suc m} {n} (a ∷ p) q = begin + (a ∷ p) * (0# ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + a · (0# ∷ q) + p * (0# ∷ 0# ∷ q) + ≈⟨ +-congˡ (consˡ (CR.zeroʳ a)) ⟩ + (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) + ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ + (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ consˡ (CR.+-identityˡ 0#) ⟩ + 0# ∷ (a · q + p * (0# ∷ q)) + ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟨ + 0# ∷ ((a ∷ p) * q) + ∎ + +·-distrib-shift : (a : A) → (p : Poly m) → a · (shift p) ≈ shift (a · p) +·-distrib-shift a [] = cons (CR.zeroʳ a) (refl) +·-distrib-shift a (b ∷ p) = consˡ (CR.zeroʳ a) + +---------------------------------------------------------------- +-- Properties of polynomial scaling + +a·p≈a∷[]*p : (a : A) → (p : Poly n) → a · p ≈ (a ∷ []) * p +a·p≈a∷[]*p {_} a [] = refl +a·p≈a∷[]*p {suc n} a (b ∷ p) = begin + a · (b ∷ p) + ≈⟨ cons (CR.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ + a *A b +A 0# ∷ (a · p + zeros n) + ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟨ + (a ∷ []) * (b ∷ p) ∎ + +pIsZero⇒a·pIsZero : (a : A) → (p : Poly n) → IsZero p → IsZero (a · p) +pIsZero⇒a·pIsZero a p [] = [] +pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) + = (CR.trans (CR.*-congˡ b≈0) (CR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 + +a≈0⇒a·pIsZero : (a : A) → (p : Poly n) → a ≈A 0# → IsZero (a · p) +a≈0⇒a·pIsZero a [] a≈0 = [] +a≈0⇒a·pIsZero a (b ∷ p) a≈0 + = CR.trans (CR.*-congʳ a≈0) (CR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) + +·-cong : a ≈A b → p ≈ q → a · p ≈ b · q +·-cong {a = _} {b = b} _ ([]≈ q q≈0) + = sym (IsZero⇒≈0 (pIsZero⇒a·pIsZero b q q≈0)) +·-cong {a = a} {b = _} _ (≈[] p p≈0) + = IsZero⇒≈0 (pIsZero⇒a·pIsZero a p p≈0) +·-cong {a = _} {b = _} c≈d (cons a≈b p≈q) + = cons (CR.*-cong c≈d a≈b) (·-cong c≈d p≈q) + +·-congˡ : a ≈A b → a · p ≈ b · p +·-congˡ a≈b = ·-cong a≈b refl + +·-congʳ : p ≈ q → a · p ≈ a · q +·-congʳ = ·-cong CR.refl + +·-dist : a · (p + q) ≈ (a · p) + (a · q) +·-dist {a = _} {p = []} {q = []} = refl +·-dist {a = _} {p = []} {q = b ∷ q} = refl +·-dist {a = _} {p = b ∷ p} {q = []} = refl +·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (CR.distribˡ a b c) ·-dist + +·-assoc : a · (b · p) ≈ (a *A b) · p +·-assoc {_} {_} {p = []} = refl +·-assoc {a} {b} {p = c ∷ p} = cons (CR.sym (CR.*-assoc a b c)) ·-assoc + +a·-cong : p ≈ q → a · p ≈ a · q +a·-cong = ·-cong CR.refl + +----------------------------------------------------------------- +-- Properties of polynomial multiplication + +zeroˡ : (p : Poly m) → [] * p ≈ [] +zeroˡ p = zerosm≈zerosn + +zeroʳ : (p : Poly m) → p * [] ≈ [] +zeroʳ {_} [] = refl +zeroʳ {m} (a ∷ p) = begin + (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ + p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ + 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ + 0# ∷ [] ≈⟨ zerosm≈zerosn ⟩ + [] ∎ + +pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) +pIsZero⇒p*qIsZero {n} {_} {p = []} q [] = zerosIsZero (pred n) +pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) + = cast-p≈0⇒p≈0 (cast-lem n m) + (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) + +p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] +p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) + +*-cong : {p : Poly m} → {q : Poly n} → {r : Poly k} → {s : Poly l} → + p ≈ q → r ≈ s → p * r ≈ q * s +*-cong {k = k} {q = q} {r} {s} ([]≈ q q≈0) r≈s = begin + [] * r ≈⟨ p≈[]⇒p*q≈[] r refl ⟩ + [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒≈0 q≈0) ⟨ + q * s ∎ +*-cong {k = k} {q = q} {r} {s} (≈[] p p≈0) r≈s = begin + p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 p≈0) ⟩ + [] ≈⟨ zerosm≈zerosn ⟩ + [] * s ∎ +*-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin + (a ∷ p) * [] + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + [] + p * (0# ∷ []) + ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ + [] + q * (0# ∷ s) + ≈⟨ +-congˡ (zerosm≈zerosn) ⟩ + zeros l + q * (0# ∷ s) + ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero b s s≈0)) ⟨ + (b · s) + q * (0# ∷ s) + ≈⟨ cast-p≈p (cast-lem l n) ⟨ + (b ∷ q) * s + ∎ +*-cong {suc m} {k = k} {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) (≈[] r s≈0) = begin + (a ∷ p) * r + ≈⟨ cast-p≈p (cast-lem k m) ⟩ + (a · r) + p * (0# ∷ r) + ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ ([]≈ r s≈0))) ⟨ + (a · r) + q * (0# ∷ []) + ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero a r s≈0)) ⟩ + zeros k + q * (0# ∷ []) + ≈⟨ +-congˡ zerosm≈zerosn ⟩ + (b · []) + q * (0# ∷ []) + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + (b ∷ q) * [] + ∎ +*-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin + (a ∷ p) * (c ∷ r) + ≈⟨ cast-p≈p (cast-lem (suc k) m)⟩ + (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consˡ (CR.*-cong (CR.sym a≈b) (CR.sym c≈d))) ⟨ + (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consʳ ((·-cong (CR.sym a≈b) (sym r≈s)))) ⟨ + (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) + ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ + (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) + ≈⟨ cast-p≈p (cast-lem (suc l) n) ⟨ + (b ∷ q) * (d ∷ s) + ∎ + +*-congʳ : q ≈ r → p * q ≈ p * r +*-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r + +*-congˡ : p ≈ q → p * r ≈ q * r +*-congˡ p≈q = *-cong p≈q refl + +qIsZero⇒p*qIsZero : (p : Poly m) → IsZero q → IsZero (p * q) +qIsZero⇒p*qIsZero {m} {_} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) +qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) + = ≈0⇒IsZero ( + begin + p * (b ∷ q) ≈⟨ *-congʳ {p = p} (consˡ b≈0) ⟩ + p * (0# ∷ q) ≈⟨ *-distrib-shift p q ⟩ + 0# ∷ (p * q) ≈⟨ consʳ (IsZero⇒≈0 (qIsZero⇒p*qIsZero p q≈0)) ⟩ + 0# ∷ (zeros m) ≈⟨ zerosm≈zerosn ⟩ + zeros m ∎ + ) + +q≈[]→p*q≈[] : (p : Poly n) → q ≈ [] → p * q ≈ [] +q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero q≈0)) + +*-comm : (p : Poly m) → (q : Poly n) → p * q ≈ q * p +*-comm {_} {_} [] [] = refl +*-comm {_} {suc n} [] (b ∷ q) = sym ( begin + (b ∷ q) * [] + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + [] + (q * (0# ∷ [])) + ≈⟨ +-congʳ (q≈[]→p*q≈[] q zerosm≈zerosn) ⟩ + [] + [] + ≈⟨ zerosm≈zerosn ⟩ + zeros (pred (0 ℕ.+ suc n)) + ∎) +*-comm {suc m} {_} (a ∷ p) [] = begin + (a ∷ p) * [] + ≈⟨(cast-p≈p (cong pred n+1≡sucn+0))⟩ + [] + p * (0# ∷ []) + ≈⟨ +-congʳ (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ + [] + [] + ≈⟨ zerosm≈zerosn ⟩ + zeros (pred (0 ℕ.+ suc m)) + ∎ +*-comm {suc m} {suc n} (a ∷ p) (b ∷ q) = begin + (a ∷ p) * (b ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + a · (b ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congˡ (*-comm-lem (a *A b) a) ⟩ + (a *A b ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congˡ (consˡ (CR.+-congʳ (CR.*-comm a b))) ⟩ + (b *A a ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congʳ step1 ⟩ + (b *A a ∷ []) + (a · (0# ∷ q)) + ((b · (0# ∷ p)) + (0# ∷ 0# ∷ p * q)) + ≈⟨ step2 ⟩ + ((b *A a ∷ []) + b · (0# ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ p * q)) + ≈⟨ step3 ⟩ + (b · (a ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))) + ≈⟨ +-congʳ step4 ⟨ + (b · (a ∷ p) + q * (0# ∷ a ∷ p)) + ≈⟨ cast-p≈p (cast-lem (suc m) n) ⟨ + (b ∷ q) * (a ∷ p) + ∎ + where + *-comm-lem : ∀ {m} → {p : Poly m} → (a b : A) → + a ∷ (b · p) ≈ (a ∷ []) + (b · (0# ∷ p)) + *-comm-lem {p = []} a b + = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ b)) (CR.+-identityʳ a))) + *-comm-lem {p = a ∷ p} b c + = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ c)) (CR.+-identityʳ b))) + + step1 = begin + p * (0# ∷ b ∷ q) + ≈⟨ *-distrib-shift p (b ∷ q) ⟩ + 0# ∷ (p * (b ∷ q)) + ≈⟨ consʳ (*-comm p (b ∷ q)) ⟩ + 0# ∷ ((b ∷ q) * p) + ≈⟨ consʳ (cast-p≈p (cast-lem m n)) ⟩ + 0# ∷ (b · p + q * (0# ∷ p)) + ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ + (0# ∷ (b · p)) + (0# ∷ (q * (0# ∷ p))) + ≈⟨ +-congˡ {r = (0# ∷ (q * (0# ∷ p)))} (·-distrib-shift b p) ⟨ + (b · (0# ∷ p)) + (0# ∷ (q * (0# ∷ p))) + ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (*-distrib-shift q p)) ⟩ + b · (0# ∷ p) + (0# ∷ 0# ∷ (q * p)) + ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (consʳ (*-comm q p))) ⟩ + b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) + ∎ + + step2 + = middleFour (b *A a ∷ []) (a · (0# ∷ q)) + (b · (0# ∷ p)) (0# ∷ 0# ∷ (p * q)) + + step3 + = +-congˡ {r = a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))} + (sym (*-comm-lem {p = p} (b *A a) b)) + + step4 = begin + q * (0# ∷ a ∷ p) + ≈⟨ *-distrib-shift q (a ∷ p) ⟩ + 0# ∷ (q * (a ∷ p)) + ≈⟨ consʳ (*-comm q (a ∷ p)) ⟩ + 0# ∷ ((a ∷ p) * q) + ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟩ + 0# ∷ (a · q + p * (0# ∷ q)) + ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ + (0# ∷ (a · q)) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ +-congˡ {r = (0# ∷ (p * (0# ∷ q)))} (·-distrib-shift a q) ⟨ + a · (0# ∷ q) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ +-congʳ {p = a · (0# ∷ q)} (consʳ (*-distrib-shift p q))⟩ + a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) + ∎ + +shift-distrib-+ : (p : Poly m) → (q : Poly n) → + shift (p + q) ≈ (shift p) + (shift q) +shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl + +0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ (shift p) * q +0∷[p*q]≈[0∷p]*q p q = begin + 0# ∷ (p * q) ≈⟨ consʳ (*-comm p q) ⟩ + 0# ∷ (q * p) ≈⟨ *-distrib-shift q p ⟨ + q * (0# ∷ p) ≈⟨ *-comm q (0# ∷ p) ⟩ + (0# ∷ p) * q ∎ + +0∷[p*q]≈q*[0∷p] : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ q * (shift p) +0∷[p*q]≈q*[0∷p] p q = begin + 0# ∷ (p * q) ≈⟨ 0∷[p*q]≈[0∷p]*q p q ⟩ + (0# ∷ p) * q ≈⟨ *-comm (0# ∷ p) q ⟩ + q * (0# ∷ p) ∎ + +*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (q + r) * p ≈ (q * p) + (r * p) +*-distribʳ-+ {_} {_} {_} [] q r = begin + (q + r) * [] + ≈⟨ q≈[]→p*q≈[] (q + r) refl ⟩ + [] + [] + ≈⟨ +-cong (zeroʳ q) (zeroʳ r)⟨ + (q * []) + (r * []) + ∎ +*-distribʳ-+ {suc m} {n} {k} (a ∷ p) q r = begin + ((q + r) * (a ∷ p)) + ≈⟨ *-comm (q + r) (a ∷ p) ⟩ + ((a ∷ p) * (q + r)) + ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ + (a · (q + r)) + (p * (0# ∷ (q + r))) + ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ + (a · q + a · r) + (0# ∷ (p * (q + r))) + ≈⟨ +-congʳ step5 ⟩ + (a · q + a · r) + ((0# ∷ (q * p)) + (0# ∷ (r * p))) + ≈⟨ middleFour (a · q) (a · r) (0# ∷ (q * p)) (0# ∷ (r * p)) ⟩ + (a · q + (0# ∷ (q * p))) + (a · r + (0# ∷ (r * p))) + ≈⟨ +-congˡ step6 ⟩ + q * (a ∷ p) + (a · r + (0# ∷ r * p)) + ≈⟨ +-congʳ step7 ⟩ + (q * (a ∷ p) + r * (a ∷ p)) + ∎ + where + step5 = begin + 0# ∷ p * (q + r) + ≈⟨ consʳ (*-comm p (q + r)) ⟩ + 0# ∷ ((q + r) * p) + ≈⟨ consʳ (*-distribʳ-+ p q r) ⟩ + 0# ∷ q * p + r * p + ≈⟨ shift-distrib-+ (q * p) (r * p) ⟩ + (0# ∷ q * p) + (0# ∷ r * p) ∎ + + step6 = begin + a · q + (0# ∷ q * p) + ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] q p) ⟩ + a · q + p * (0# ∷ q) + ≈⟨ cast-p≈p (cast-lem n m) ⟨ + (a ∷ p) * q + ≈⟨ *-comm (a ∷ p) q ⟩ + q * (a ∷ p) ∎ + + step7 = begin + a · r + (0# ∷ r * p) + ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] r p) ⟩ + a · r + p * (0# ∷ r) + ≈⟨ cast-p≈p (cast-lem k m) ⟨ + (a ∷ p) * r + ≈⟨ *-comm (a ∷ p) r ⟩ + r * (a ∷ p) ∎ + +·-distrib-* : (p : Poly m) → (q : Poly n) → (a : A) → + a · (p * q) ≈ (a · p) * q +·-distrib-* {_} {n} [] q a = begin + a · ([] * q) ≈⟨ ·-congʳ zerosm≈zerosn ⟩ + a · [] ≈⟨ zerosm≈zerosn ⟨ + (a · []) * q ∎ +·-distrib-* {suc m} {_} (b ∷ p) [] a = begin + a · ((b ∷ p) * []) + ≈⟨ a·-cong (cast-p≈p (cong pred n+1≡sucn+0)) ⟩ + a · ((b · []) + (p * (0# ∷ []))) + ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ + a · (p * (0# ∷ [])) + ≈⟨ a·-cong (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ + [] + ≈⟨ q≈[]→p*q≈[] ((a · p)) zerosm≈zerosn ⟨ + (a · p) * (0# ∷ []) + ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ + ((a *A b) · []) + ((a · p) * (0# ∷ [])) + ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + (a · (b ∷ p)) * [] + ∎ +·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin + a · ((b ∷ p) * (c ∷ q)) + ≈⟨ a·-cong (cast-p≈p (cast-lem (suc n) m)) ⟩ + a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) + ≈⟨ ·-dist ⟩ + a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congˡ (cons (CR.sym (CR.*-assoc a b c)) ·-assoc) ⟩ + (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ + (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) + ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟨ + (a · (b ∷ p)) * (c ∷ q) + ∎ + +*-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → + (p * q) * r ≈ p * (q * r) +*-assoc {_} {n} {k} [] q r = begin + zeros (n ℕ.∸ 1) * r + ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 (zerosIsZero (n ℕ.∸ 1))) ⟩ + [] + ≈⟨ zerosm≈zerosn ⟩ + zeros (pred (0 ℕ.+ pred (n ℕ.+ k))) + ∎ +*-assoc {suc m} {n} {k} (a ∷ p) q r = begin + ((a ∷ p) * q) * r + ≈⟨ *-congˡ (cast-p≈p (cast-lem n m)) ⟩ + ((a · q) + (p * (0# ∷ q))) * r + ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ + ((a · q) + (0# ∷ (p * q))) * r + ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ + ((a · q) * r) + ((0# ∷ (p * q)) * r) + ≈⟨ +-congʳ step8 ⟨ + ((a · q) * r) + (0# ∷ (p * (q * r))) + ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ + (a · (q * r)) + (0# ∷ (p * (q * r))) + ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ + (a · (q * r)) + (p * (0# ∷ (q * r))) + ≈⟨ cast-p≈p (cast-lem (pred (n ℕ.+ k)) m) ⟨ + (a ∷ p) * (q * r) + ∎ + where + step8 = begin + 0# ∷ (p * (q * r)) + ≈⟨ consʳ (*-assoc p q r) ⟨ + 0# ∷ ((p * q) * r) + ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ + (0# ∷ (p * q)) * r + ≈⟨ cast-p≈p (cast-lem k (m ℕ.+ n ℕ.∸ 1)) ⟩ + (0# · r) + ((p * q) * (0# ∷ r)) + ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r CR.refl) ) ⟩ + zeros k + ((p * q) * (0# ∷ r)) + ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ + zeros k + (0# ∷ ((p * q) * r)) + ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ + zeros k + ((0# ∷ (p * q)) * r) + ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ + (0# ∷ (p * q)) * r + ∎ + +--------------------------------------------------------------------- +-- Multiplicative identity + +*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p +*-identityʳ {0} [] = zerosm≈zerosn +*-identityʳ {suc n} (a ∷ p) = begin + (a ∷ p) * (1# ∷ []) + ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ + (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congˡ (consˡ (CR.*-identityʳ a)) ⟩ + (a ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ + (a ∷ []) + (0# ∷ (p * (1# ∷ []))) + ≈⟨ cons (CR.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ + a ∷ (p * (1# ∷ [])) + ≈⟨ consʳ (*-identityʳ p) ⟩ + a ∷ p ∎ diff --git a/src/Algebra/Polynomial/Properties.agda b/src/Algebra/Polynomial/Properties.agda index b888069cfb..3b84fe5220 100644 --- a/src/Algebra/Polynomial/Properties.agda +++ b/src/Algebra/Polynomial/Properties.agda @@ -1,23 +1,20 @@ -open import Algebra.Bundles using (Magma; CommutativeRing) +open import Algebra.Bundles using (Magma; Semiring) module Algebra.Polynomial.Properties {ℓ₁ ℓ₂} - (CR : CommutativeRing ℓ₁ ℓ₂) + (SR : Semiring ℓ₁ ℓ₂) where -import Algebra.Consequences.Setoid as C - using (comm∧distrʳ⇒distrˡ ; comm∧idʳ⇒idˡ) +open import Algebra.Bundles.Raw import Algebra.Definitions as Def -import Algebra.Polynomial.Poly.Properties CR as Poly -open import Algebra.Polynomial.Base CR +import Algebra.Polynomial.Poly.Properties SR as Poly +open import Algebra.Polynomial.Base SR using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ - ; zero; one; -_; refl; sym; trans) -open import Algebra.Properties.AbelianGroup -open import Algebra.Properties.Ring + ; zero; one; refl; sym; trans) open import Algebra.Structures using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid - ; IsGroup; IsAbelianGroup; IsCommutativeMonoid; IsSemiring - ; IsRing; IsCommutativeSemiring; IsCommutativeRing ) + ; IsSemiring; IsCommutativeMonoid + ) open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) open import Data.Product.Base using (_,_) open import Data.Vec.Base as Vec using ([]; _∷_) @@ -25,7 +22,7 @@ open import Relation.Binary using (IsEquivalence) open Polynomial -open CommutativeRing CR +open Semiring SR using (0#; 1#) renaming (Carrier to A) @@ -53,18 +50,6 @@ private +-assoc : Associative _+_ +-assoc P Q R = Poly.+-assoc (polynomial P) (polynomial Q) (polynomial R) - -+-inverseˡ : LeftInverse zero -_ _+_ -+-inverseˡ P = Poly.+-inverseˡ (polynomial P) - -+-inverseʳ : RightInverse zero -_ _+_ -+-inverseʳ P = Poly.+-inverseʳ (polynomial P) - -+-inverse : Inverse zero -_ _+_ -+-inverse = +-inverseˡ , +-inverseʳ - --‿cong : P ≈ Q → - P ≈ - Q --‿cong = Poly.-‿cong --------------------------------------------------------------- -- Additive structures @@ -106,20 +91,26 @@ isEquivalence = record ; comm = +-comm } -+-isGroup : IsGroup _≈_ _+_ zero -_ -+-isGroup = record - { isMonoid = +-isMonoid - ; inverse = +-inverse - ; ⁻¹-cong = -‿cong +--------------------------------------------------------------- +-- Additive raw bundles ++-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ ++-rawMagma = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _∙_ = _+_ } -+-isAbelianGroup : IsAbelianGroup _≈_ _+_ zero -_ -+-isAbelianGroup = record - { isGroup = +-isGroup - ; comm = +-comm ++-rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ ++-rawSemiring = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = zero + ; 1# = one } ---------------------------------------------------------------- + -- Additive bundles +-magma : Algebra.Bundles.Magma _ _ @@ -147,25 +138,17 @@ isEquivalence = record { isCommutativeMonoid = +-isCommutativeMonoid } -+-abelianGroup : Algebra.Bundles.AbelianGroup _ _ -+-abelianGroup = record - { isAbelianGroup = +-isAbelianGroup - } - ----------------------------------------------------------------- -- Algebraic properties of multiplication a·p≈a∷[]*p : (a : A) → (P : Polynomial) → a · P ≈ (1 , (a ∷ [])) * P a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) -*-comm : Commutative _*_ -*-comm P Q = Poly.*-comm (polynomial P) (polynomial Q) - *-identityʳ : RightIdentity one _*_ *-identityʳ P = Poly.*-identityʳ (polynomial P) *-identityˡ : LeftIdentity one _*_ -*-identityˡ = C.comm∧idʳ⇒idˡ (Magma.setoid +-magma) *-comm *-identityʳ +*-identityˡ P = Poly.*-identityˡ (polynomial P) *-identity : Identity one _*_ *-identity = *-identityˡ , *-identityʳ @@ -188,8 +171,8 @@ a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) = Poly.*-distribʳ-+ (polynomial P) (polynomial Q) (polynomial R) *-distribˡ-+ : _*_ DistributesOverˡ _+_ -*-distribˡ-+ - = C.comm∧distrʳ⇒distrˡ (Magma.setoid +-magma) Poly.+-cong *-comm *-distribʳ-+ +*-distribˡ-+ P Q R + = Poly.*-distribˡ-+ (polynomial P) (polynomial Q) (polynomial R) *-distrib-+ : _*_ DistributesOver _+_ *-distrib-+ = *-distribˡ-+ , *-distribʳ-+ @@ -209,24 +192,12 @@ a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) ; assoc = *-assoc } -*-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _*_ -*-isCommutativeSemigroup = record - { isSemigroup = *-isSemigroup - ; comm = *-comm - } - *-isMonoid : IsMonoid _≈_ _*_ one *-isMonoid = record { isSemigroup = *-isSemigroup ; identity = *-identity } -*-isCommutativeMonoid : IsCommutativeMonoid _≈_ _*_ one -*-isCommutativeMonoid = record - { isMonoid = *-isMonoid - ; comm = *-comm - } - +-*-isSemiring : IsSemiring _≈_ _+_ _*_ zero one +-*-isSemiring = record { isSemiringWithoutAnnihilatingZero = record @@ -239,27 +210,6 @@ a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) ; zero = *-zero } -+-*-isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ zero one -+-*-isCommutativeSemiring = record - { isSemiring = +-*-isSemiring - ; *-comm = *-comm - } - -+-*-isRing : IsRing _≈_ _+_ _*_ -_ zero one -+-*-isRing = record - { +-isAbelianGroup = +-isAbelianGroup - ; *-cong = Poly.*-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - -+-*-isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ zero one -+-*-isCommutativeRing = record - { isRing = +-*-isRing - ; *-comm = *-comm - } - --------------------------------------------------------------- -- Multiplicative bundles @@ -273,32 +223,12 @@ a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) { isSemigroup = *-isSemigroup } -*-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ -*-commutativeSemigroup = record - { isCommutativeSemigroup = *-isCommutativeSemigroup - } - *-monoid : Algebra.Bundles.Monoid _ _ *-monoid = record { isMonoid = *-isMonoid } -*-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ -*-commutativeMonoid = record - { isCommutativeMonoid = *-isCommutativeMonoid - } - -+-*-commutativeSemiring : Algebra.Bundles.CommutativeSemiring _ _ -+-*-commutativeSemiring = record - { isCommutativeSemiring = +-*-isCommutativeSemiring - } - -+-*-ring : Algebra.Bundles.Ring _ _ -+-*-ring = record - { isRing = +-*-isRing - } - -+-*-commutativeRing : Algebra.Bundles.CommutativeRing _ _ -+-*-commutativeRing = record - { isCommutativeRing = +-*-isCommutativeRing ++-*-semiring : Semiring _ _ ++-*-semiring = record + { isSemiring = +-*-isSemiring } diff --git a/src/Algebra/Polynomial/Properties1.agda b/src/Algebra/Polynomial/Properties1.agda new file mode 100644 index 0000000000..c0d139b15d --- /dev/null +++ b/src/Algebra/Polynomial/Properties1.agda @@ -0,0 +1,292 @@ +open import Algebra.Bundles using (Magma; Ring) + +module Algebra.Polynomial.Properties1 + {ℓ₁ ℓ₂} + (R : Ring ℓ₁ ℓ₂) + where + +open import Algebra.Bundles.Raw +import Algebra.Definitions as Def +import Algebra.Polynomial.Poly.Properties1 R as Poly +open import Algebra.Polynomial.Base1 R + using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ + ; zero; one; -_; refl; sym; trans) +open import Algebra.Properties.AbelianGroup +open import Algebra.Properties.Ring +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsGroup; IsAbelianGroup; IsSemiring; IsCommutativeMonoid + ; IsRing) +open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) +open import Data.Product.Base using (_,_) +open import Data.Vec.Base as Vec using ([]; _∷_) +open import Relation.Binary using (IsEquivalence) + +open Polynomial + +open Ring R + using (0#; 1#) + renaming (Carrier to A) + +open Def _≈_ + +private + variable + P Q W : Polynomial + +-------------------------------------------------------------- +-- Algebraic properties of addition + ++-identityˡ : LeftIdentity zero _+_ ++-identityˡ P = Poly.+-identityˡ (polynomial P) + ++-identityʳ : RightIdentity zero _+_ ++-identityʳ P = Poly.+-identityʳ (polynomial P) + ++-identity : Identity zero _+_ ++-identity = +-identityˡ , +-identityʳ + ++-comm : Commutative _+_ ++-comm P Q = Poly.+-comm (polynomial P) (polynomial Q) + ++-assoc : Associative _+_ ++-assoc P Q W + = Poly.+-assoc (polynomial P) (polynomial Q) (polynomial W) + ++-inverseˡ : LeftInverse zero -_ _+_ ++-inverseˡ P = Poly.+-inverseˡ (polynomial P) + ++-inverseʳ : RightInverse zero -_ _+_ ++-inverseʳ P = Poly.+-inverseʳ (polynomial P) + ++-inverse : Inverse zero -_ _+_ ++-inverse = +-inverseˡ , +-inverseʳ + +-‿cong : P ≈ Q → - P ≈ - Q +-‿cong = Poly.-‿cong + +--------------------------------------------------------------- +-- Additive structures + +isEquivalence : IsEquivalence _≈_ +isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + ++-isMagma : IsMagma _≈_ _+_ ++-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = Poly.+-cong + } + ++-isSemigroup : IsSemigroup _≈_ _+_ ++-isSemigroup = record + { isMagma = +-isMagma + ; assoc = +-assoc + } + ++-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ ++-isCommutativeSemigroup = record + { isSemigroup = +-isSemigroup + ; comm = +-comm + } + ++-isMonoid : IsMonoid _≈_ _+_ zero ++-isMonoid = record + { isSemigroup = +-isSemigroup + ; identity = +-identity + } + ++-isGroup : IsGroup _≈_ _+_ zero -_ ++-isGroup = record + { isMonoid = +-isMonoid + ; inverse = +-inverse + ; ⁻¹-cong = -‿cong + } + ++-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ zero ++-isCommutativeMonoid = record + { isMonoid = +-isMonoid + ; comm = +-comm + } + ++-isAbelianGroup : IsAbelianGroup _≈_ _+_ zero -_ ++-isAbelianGroup = record + { isGroup = +-isGroup + ; comm = +-comm + } + +--------------------------------------------------------------- +-- Additive bundles + ++-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ ++-rawMagma = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _∙_ = _+_ + } + +*-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ +*-rawMagma = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _∙_ = _*_ + } + +rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ +rawSemiring = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = zero + ; 1# = one + } + +rawRing : Algebra.Bundles.Raw.RawRing _ _ +rawRing = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; -_ = -_ + ; 0# = zero + ; 1# = one + } + ++-magma : Algebra.Bundles.Magma _ _ ++-magma = record + { isMagma = +-isMagma + } + ++-semigroup : Algebra.Bundles.Semigroup _ _ ++-semigroup = record + { isSemigroup = +-isSemigroup + } + ++-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ ++-commutativeSemigroup = record + { isCommutativeSemigroup = +-isCommutativeSemigroup + } + ++-monoid : Algebra.Bundles.Monoid _ _ ++-monoid = record + { isMonoid = +-isMonoid + } + ++-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ ++-commutativeMonoid = record + { isCommutativeMonoid = +-isCommutativeMonoid + } + ++-abelianGroup : Algebra.Bundles.AbelianGroup _ _ ++-abelianGroup = record + { isAbelianGroup = +-isAbelianGroup + } + +----------------------------------------------------------------- +-- Algebraic properties of multiplication + +a·p≈a∷[]*p : (a : A) → (P : Polynomial) → a · P ≈ (1 , (a ∷ [])) * P +a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) + +*-identityʳ : RightIdentity one _*_ +*-identityʳ P = Poly.*-identityʳ (polynomial P) + +*-identityˡ : LeftIdentity one _*_ +*-identityˡ P = Poly.*-identityˡ (polynomial P) + +*-identity : Identity one _*_ +*-identity = *-identityˡ , *-identityʳ + +*-zeroˡ : LeftZero zero _*_ +*-zeroˡ P = Poly.zeroˡ (polynomial P) + +*-zeroʳ : RightZero zero _*_ +*-zeroʳ P = Poly.zeroʳ (polynomial P) + +*-zero : Zero zero _*_ +*-zero = *-zeroˡ , *-zeroʳ + +*-assoc : Associative _*_ +*-assoc P Q R + = Poly.*-assoc (polynomial P) (polynomial Q) (polynomial R) + +*-distribʳ-+ : _*_ DistributesOverʳ _+_ +*-distribʳ-+ P Q R + = Poly.*-distribʳ-+ (polynomial P) (polynomial Q) (polynomial R) + +*-distribˡ-+ : _*_ DistributesOverˡ _+_ +*-distribˡ-+ P Q W + = Poly.*-distribˡ-+ (polynomial P) (polynomial Q) (polynomial W) + +*-distrib-+ : _*_ DistributesOver _+_ +*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ + +------------------------------------------------------------------ +-- Multiplicative structure + +*-isMagma : IsMagma _≈_ _*_ +*-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = Poly.*-cong + } + +*-isSemigroup : IsSemigroup _≈_ _*_ +*-isSemigroup = record + { isMagma = *-isMagma + ; assoc = *-assoc + } + +*-isMonoid : IsMonoid _≈_ _*_ one +*-isMonoid = record + { isSemigroup = *-isSemigroup + ; identity = *-identity + } + ++-*-isSemiring : IsSemiring _≈_ _+_ _*_ zero one ++-*-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = +-isCommutativeMonoid + ; *-cong = Poly.*-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + ; zero = *-zero + } + ++-*-isRing : IsRing _≈_ _+_ _*_ -_ zero one ++-*-isRing = record + { +-isAbelianGroup = +-isAbelianGroup + ; *-cong = Poly.*-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + +--------------------------------------------------------------- +-- Multiplicative bundles + +*-magma : Algebra.Bundles.Magma _ _ +*-magma = record + { isMagma = *-isMagma + } + +*-semigroup : Algebra.Bundles.Semigroup _ _ +*-semigroup = record + { isSemigroup = *-isSemigroup + } + +*-monoid : Algebra.Bundles.Monoid _ _ +*-monoid = record + { isMonoid = *-isMonoid + } + ++-*-ring : Algebra.Bundles.Ring _ _ ++-*-ring = record + { isRing = +-*-isRing + } + diff --git a/src/Algebra/Polynomial/Properties2.agda b/src/Algebra/Polynomial/Properties2.agda new file mode 100644 index 0000000000..c239ab54d4 --- /dev/null +++ b/src/Algebra/Polynomial/Properties2.agda @@ -0,0 +1,352 @@ +open import Algebra.Bundles using (Magma; CommutativeRing) +open import Algebra.Bundles.Raw + +module Algebra.Polynomial.Properties2 + {ℓ₁ ℓ₂} + (CR : CommutativeRing ℓ₁ ℓ₂) + where + +import Algebra.Consequences.Setoid as C + using (comm∧distrʳ⇒distrˡ ; comm∧idʳ⇒idˡ) +import Algebra.Definitions as Def +import Algebra.Polynomial.Poly.Properties2 CR as Poly +open import Algebra.Polynomial.Base2 CR + using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ + ; zero; one; -_; refl; sym; trans) +open import Algebra.Properties.AbelianGroup +open import Algebra.Properties.Ring +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsGroup; IsAbelianGroup; IsCommutativeMonoid; IsSemiring + ; IsRing; IsCommutativeSemiring; IsCommutativeRing ) +open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) +open import Data.Product.Base using (_,_) +open import Data.Vec.Base as Vec using ([]; _∷_) +open import Relation.Binary using (IsEquivalence) + +open Polynomial + +open CommutativeRing CR + using (0#; 1#) + renaming (Carrier to A) + +open Def _≈_ + +private + variable + P Q R : Polynomial + +-------------------------------------------------------------- +-- Algebraic properties of addition + ++-identityˡ : LeftIdentity zero _+_ ++-identityˡ P = Poly.+-identityˡ (polynomial P) + ++-identityʳ : RightIdentity zero _+_ ++-identityʳ P = Poly.+-identityʳ (polynomial P) + ++-identity : Identity zero _+_ ++-identity = +-identityˡ , +-identityʳ + ++-comm : Commutative _+_ ++-comm P Q = Poly.+-comm (polynomial P) (polynomial Q) + ++-assoc : Associative _+_ ++-assoc P Q R + = Poly.+-assoc (polynomial P) (polynomial Q) (polynomial R) + ++-inverseˡ : LeftInverse zero -_ _+_ ++-inverseˡ P = Poly.+-inverseˡ (polynomial P) + ++-inverseʳ : RightInverse zero -_ _+_ ++-inverseʳ P = Poly.+-inverseʳ (polynomial P) + ++-inverse : Inverse zero -_ _+_ ++-inverse = +-inverseˡ , +-inverseʳ + +-‿cong : P ≈ Q → - P ≈ - Q +-‿cong = Poly.-‿cong + +--------------------------------------------------------------- +-- Additive structures + +isEquivalence : IsEquivalence _≈_ +isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + ++-isMagma : IsMagma _≈_ _+_ ++-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = Poly.+-cong + } + ++-isSemigroup : IsSemigroup _≈_ _+_ ++-isSemigroup = record + { isMagma = +-isMagma + ; assoc = +-assoc + } + ++-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ ++-isCommutativeSemigroup = record + { isSemigroup = +-isSemigroup + ; comm = +-comm + } + ++-isMonoid : IsMonoid _≈_ _+_ zero ++-isMonoid = record + { isSemigroup = +-isSemigroup + ; identity = +-identity + } + ++-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ zero ++-isCommutativeMonoid = record + { isMonoid = +-isMonoid + ; comm = +-comm + } + ++-isGroup : IsGroup _≈_ _+_ zero -_ ++-isGroup = record + { isMonoid = +-isMonoid + ; inverse = +-inverse + ; ⁻¹-cong = -‿cong + } + ++-isAbelianGroup : IsAbelianGroup _≈_ _+_ zero -_ ++-isAbelianGroup = record + { isGroup = +-isGroup + ; comm = +-comm + } + +--------------------------------------------------------------- +-- Additive bundles +-- Additive bundles + ++-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ ++-rawMagma = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _∙_ = _+_ + } + +*-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ +*-rawMagma = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _∙_ = _*_ + } + +rawNearSemiring : Algebra.Bundles.Raw.RawNearSemiring _ _ +rawNearSemiring = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = zero + } + +rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ +rawSemiring = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = zero + ; 1# = one + } + + + +rawRing : Algebra.Bundles.Raw.RawRing _ _ +rawRing = record + { Carrier = Polynomial + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; -_ = -_ + ; 0# = zero + ; 1# = one + } + ++-magma : Algebra.Bundles.Magma _ _ ++-magma = record + { isMagma = +-isMagma + } + ++-semigroup : Algebra.Bundles.Semigroup _ _ ++-semigroup = record + { isSemigroup = +-isSemigroup + } + ++-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ ++-commutativeSemigroup = record + { isCommutativeSemigroup = +-isCommutativeSemigroup + } + ++-monoid : Algebra.Bundles.Monoid _ _ ++-monoid = record + { isMonoid = +-isMonoid + } + ++-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ ++-commutativeMonoid = record + { isCommutativeMonoid = +-isCommutativeMonoid + } + ++-abelianGroup : Algebra.Bundles.AbelianGroup _ _ ++-abelianGroup = record + { isAbelianGroup = +-isAbelianGroup + } + +----------------------------------------------------------------- +-- Algebraic properties of multiplication + +a·p≈a∷[]*p : (a : A) → (P : Polynomial) → a · P ≈ (1 , (a ∷ [])) * P +a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) + +*-comm : Commutative _*_ +*-comm P Q = Poly.*-comm (polynomial P) (polynomial Q) + +*-identityʳ : RightIdentity one _*_ +*-identityʳ P = Poly.*-identityʳ (polynomial P) + +*-identityˡ : LeftIdentity one _*_ +*-identityˡ = C.comm∧idʳ⇒idˡ (Magma.setoid +-magma) *-comm *-identityʳ + +*-identity : Identity one _*_ +*-identity = *-identityˡ , *-identityʳ + +*-zeroˡ : LeftZero zero _*_ +*-zeroˡ P = Poly.zeroˡ (polynomial P) + +*-zeroʳ : RightZero zero _*_ +*-zeroʳ P = Poly.zeroʳ (polynomial P) + +*-zero : Zero zero _*_ +*-zero = *-zeroˡ , *-zeroʳ + +*-assoc : Associative _*_ +*-assoc P Q R + = Poly.*-assoc (polynomial P) (polynomial Q) (polynomial R) + +*-distribʳ-+ : _*_ DistributesOverʳ _+_ +*-distribʳ-+ P Q R + = Poly.*-distribʳ-+ (polynomial P) (polynomial Q) (polynomial R) + +*-distribˡ-+ : _*_ DistributesOverˡ _+_ +*-distribˡ-+ + = C.comm∧distrʳ⇒distrˡ (Magma.setoid +-magma) Poly.+-cong *-comm *-distribʳ-+ + +*-distrib-+ : _*_ DistributesOver _+_ +*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ + +------------------------------------------------------------------ +-- Multiplicative structure + +*-isMagma : IsMagma _≈_ _*_ +*-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = Poly.*-cong + } + +*-isSemigroup : IsSemigroup _≈_ _*_ +*-isSemigroup = record + { isMagma = *-isMagma + ; assoc = *-assoc + } + +*-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _*_ +*-isCommutativeSemigroup = record + { isSemigroup = *-isSemigroup + ; comm = *-comm + } + +*-isMonoid : IsMonoid _≈_ _*_ one +*-isMonoid = record + { isSemigroup = *-isSemigroup + ; identity = *-identity + } + +*-isCommutativeMonoid : IsCommutativeMonoid _≈_ _*_ one +*-isCommutativeMonoid = record + { isMonoid = *-isMonoid + ; comm = *-comm + } + ++-*-isSemiring : IsSemiring _≈_ _+_ _*_ zero one ++-*-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = +-isCommutativeMonoid + ; *-cong = Poly.*-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + ; zero = *-zero + } + ++-*-isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ zero one ++-*-isCommutativeSemiring = record + { isSemiring = +-*-isSemiring + ; *-comm = *-comm + } + ++-*-isRing : IsRing _≈_ _+_ _*_ -_ zero one ++-*-isRing = record + { +-isAbelianGroup = +-isAbelianGroup + ; *-cong = Poly.*-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + ++-*-isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ zero one ++-*-isCommutativeRing = record + { isRing = +-*-isRing + ; *-comm = *-comm + } + +--------------------------------------------------------------- +-- Multiplicative bundles + +*-magma : Algebra.Bundles.Magma _ _ +*-magma = record + { isMagma = *-isMagma + } + +*-semigroup : Algebra.Bundles.Semigroup _ _ +*-semigroup = record + { isSemigroup = *-isSemigroup + } + +*-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ +*-commutativeSemigroup = record + { isCommutativeSemigroup = *-isCommutativeSemigroup + } + +*-monoid : Algebra.Bundles.Monoid _ _ +*-monoid = record + { isMonoid = *-isMonoid + } + +*-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ +*-commutativeMonoid = record + { isCommutativeMonoid = *-isCommutativeMonoid + } + ++-*-commutativeSemiring : Algebra.Bundles.CommutativeSemiring _ _ ++-*-commutativeSemiring = record + { isCommutativeSemiring = +-*-isCommutativeSemiring + } + ++-*-ring : Algebra.Bundles.Ring _ _ ++-*-ring = record + { isRing = +-*-isRing + } + ++-*-commutativeRing : Algebra.Bundles.CommutativeRing _ _ ++-*-commutativeRing = record + { isCommutativeRing = +-*-isCommutativeRing + } From a6055ab25475fa560dcdf14ab8537213aa59e382 Mon Sep 17 00:00:00 2001 From: Sam Park Date: Fri, 24 Oct 2025 04:00:06 -0400 Subject: [PATCH 3/8] Work-in-progress edits for Dr. Forsberg and Allais --- .../{Base2.agda => Base/CommutativeRing.agda} | 11 +- .../Polynomial/{Base1.agda => Base/Ring.agda} | 13 +- .../{Base.agda => Base/Semiring.agda} | 13 +- src/Algebra/Polynomial/Morphism/Morphism.agda | 643 ++++++++---------- .../Polynomial/Poly/{Base.agda => Base/Base} | 2 +- .../{Base2.agda => Base/CommutativeRing.agda} | 9 +- .../Poly/{Base1.agda => Base/Ring.agda} | 10 +- .../Polynomial/Poly/Base/Semiring.agda | 147 ++++ .../CommutativeRing.agda} | 48 +- .../Ring.agda} | 35 +- .../Semiring.agda} | 36 +- .../CommutativeRing.agda} | 8 +- .../Ring.agda} | 6 +- .../Semiring.agda} | 6 +- src/Algebra/Properties/Group.agda | 3 +- src/Data/Nat/Properties.agda | 4 + 16 files changed, 545 insertions(+), 449 deletions(-) rename src/Algebra/Polynomial/{Base2.agda => Base/CommutativeRing.agda} (80%) rename src/Algebra/Polynomial/{Base1.agda => Base/Ring.agda} (78%) rename src/Algebra/Polynomial/{Base.agda => Base/Semiring.agda} (77%) rename src/Algebra/Polynomial/Poly/{Base.agda => Base/Base} (98%) rename src/Algebra/Polynomial/Poly/{Base2.agda => Base/CommutativeRing.agda} (95%) rename src/Algebra/Polynomial/Poly/{Base1.agda => Base/Ring.agda} (95%) create mode 100644 src/Algebra/Polynomial/Poly/Base/Semiring.agda rename src/Algebra/Polynomial/Poly/{Properties2.agda => Properties/CommutativeRing.agda} (92%) rename src/Algebra/Polynomial/Poly/{Properties1.agda => Properties/Ring.agda} (94%) rename src/Algebra/Polynomial/Poly/{Properties.agda => Properties/Semiring.agda} (94%) rename src/Algebra/Polynomial/{Properties2.agda => Properties/CommutativeRing.agda} (97%) rename src/Algebra/Polynomial/{Properties1.agda => Properties/Ring.agda} (97%) rename src/Algebra/Polynomial/{Properties.agda => Properties/Semiring.agda} (97%) diff --git a/src/Algebra/Polynomial/Base2.agda b/src/Algebra/Polynomial/Base/CommutativeRing.agda similarity index 80% rename from src/Algebra/Polynomial/Base2.agda rename to src/Algebra/Polynomial/Base/CommutativeRing.agda index a4316f82f8..3bf52b5e8a 100644 --- a/src/Algebra/Polynomial/Base2.agda +++ b/src/Algebra/Polynomial/Base/CommutativeRing.agda @@ -4,11 +4,11 @@ open import Data.Product.Base using (_,_) open import Data.Vec.Base as Vec using ([]; _∷_) import Level as L -module Algebra.Polynomial.Base2 +module Algebra.Polynomial.Base.CommutativeRing {ℓ₁ ℓ₂} (CR : CommutativeRing ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base2 CR as Poly +open import Algebra.Polynomial.Poly.Base.CommutativeRing CR as Poly using (Poly; zeros) open CommutativeRing CR @@ -25,6 +25,8 @@ private --------------------------------------------------- -- Types +-- The degree of the polynomial denotes the length of the vector +-- The polynomial a₀ + a₁x + ⋯ + aₙxⁿ has degree n+1 record Polynomial : Set ℓ₁ where constructor _,_ field @@ -65,6 +67,11 @@ one = (1 , (1# ∷ [])) shift : Polynomial → Polynomial shift (m , p) = (suc m , Poly.shift p) +-- Multiply the polynomial by xⁿ +shift-by-n : (n : ℕ) → Polynomial → Polynomial +shift-by-n 0 (m , p) = (m , p) +shift-by-n (suc n) (m , p) = shift (shift-by-n n (m , p)) + -- Negation -_ : Polynomial → Polynomial - (m , p) = (m , Poly.- p) diff --git a/src/Algebra/Polynomial/Base1.agda b/src/Algebra/Polynomial/Base/Ring.agda similarity index 78% rename from src/Algebra/Polynomial/Base1.agda rename to src/Algebra/Polynomial/Base/Ring.agda index bc68980ffd..dd50f9349e 100644 --- a/src/Algebra/Polynomial/Base1.agda +++ b/src/Algebra/Polynomial/Base/Ring.agda @@ -4,11 +4,11 @@ open import Data.Product.Base using (_,_) open import Data.Vec.Base as Vec using ([]; _∷_) import Level as L -module Algebra.Polynomial.Base1 +module Algebra.Polynomial.Base.Ring {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base1 R as Poly +open import Algebra.Polynomial.Poly.Base.Ring R as Poly using (Poly; zeros) open Ring R @@ -25,6 +25,8 @@ private --------------------------------------------------- -- Types +-- The degree of the polynomial denotes the length of the vector +-- The polynomial a₀ + a₁x + ⋯ + aₙxⁿ has degree n+1 record Polynomial : Set ℓ₁ where constructor _,_ field @@ -61,10 +63,15 @@ one = (1 , (1# ∷ [])) --------------------------------------------------- -- Operations --- Multiply the polynomial by a factor of x +-- Multiply the polynomial by x shift : Polynomial → Polynomial shift (m , p) = (suc m , Poly.shift p) +-- Multiply the polynomial by xⁿ +shift-by-n : (n : ℕ) → Polynomial → Polynomial +shift-by-n 0 (m , p) = (m , p) +shift-by-n (suc n) (m , p) = shift (shift-by-n n (m , p)) + -- Negation -_ : Polynomial → Polynomial - (m , p) = (m , Poly.- p) diff --git a/src/Algebra/Polynomial/Base.agda b/src/Algebra/Polynomial/Base/Semiring.agda similarity index 77% rename from src/Algebra/Polynomial/Base.agda rename to src/Algebra/Polynomial/Base/Semiring.agda index 84ae5763e0..de7317f9a5 100644 --- a/src/Algebra/Polynomial/Base.agda +++ b/src/Algebra/Polynomial/Base/Semiring.agda @@ -4,11 +4,11 @@ open import Data.Product.Base using (_,_) open import Data.Vec.Base as Vec using ([]; _∷_) import Level as L -module Algebra.Polynomial.Base +module Algebra.Polynomial.Base.Semiring {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base SR as Poly +open import Algebra.Polynomial.Poly.Base.Semiring SR as Poly using (Poly; zeros) open Semiring SR @@ -25,6 +25,8 @@ private --------------------------------------------------- -- Types +-- The degree of the polynomial denotes the length of the vector +-- The polynomial a₀ + a₁x + ⋯ + aₙxⁿ has degree n+1 record Polynomial : Set ℓ₁ where constructor _,_ field @@ -61,10 +63,15 @@ one = (1 , (1# ∷ [])) --------------------------------------------------- -- Operations --- Multiply the polynomial by a factor of x +-- Multiply the polynomial by x shift : Polynomial → Polynomial shift (m , p) = (suc m , Poly.shift p) +-- Multiply the polynomial by xⁿ +shift-by-n : (n : ℕ) → Polynomial → Polynomial +shift-by-n 0 (m , p) = (m , p) +shift-by-n (suc n) (m , p) = shift (shift-by-n n (m , p)) + -- Scaling _·_ : A → Polynomial → Polynomial a · (m , p) = (m , a Poly.· p) diff --git a/src/Algebra/Polynomial/Morphism/Morphism.agda b/src/Algebra/Polynomial/Morphism/Morphism.agda index 05020c0b93..76bfe19f87 100644 --- a/src/Algebra/Polynomial/Morphism/Morphism.agda +++ b/src/Algebra/Polynomial/Morphism/Morphism.agda @@ -3,44 +3,42 @@ open import Algebra.Bundles using (CommutativeRing ; CommutativeSemiring; Ring; SemiringWithoutAnnihilatingZero; Semiring) -module ALgebra.Polynomial.Morphism.Morphism +module Algebra.Polynomial.Morphism.Morphism {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) where open import Algebra.Bundles.Raw using (RawRing) +import Algebra.Definitions as Def open import Algebra.Morphism.Bundles using (RingHomomorphism ; MagmaHomomorphism ; MonoidHomomorphism) open import Algebra.Morphism.Structures using (IsRingHomomorphism ; IsMagmaHomomorphism ; IsSemiringHomomorphism; IsNearSemiringHomomorphism ; IsMonoidHomomorphism) -open import Algebra.Polynomial.Poly.Base2 R +open import Algebra.Polynomial.Base.CommutativeRing R +open import Algebra.Polynomial.Poly.Base.CommutativeRing R using (Poly; []≈ ; ≈[]; cons ; cast-lem ; consˡ ; consʳ) renaming ( sym to P-sym ; _·_ to _·P_ ; _+_ to _+P_ ; _*_ to _*P_; _≈_ to _≈P_; -_ to -P_) -open import Algebra.Polynomial.Poly.Properties2 R - using (cast-p≈p; IsZero⇒≈0; ≈0⇒IsZero; a·p≈a∷[]*p ; *-distrib-shift) - renaming (+-identityˡ to +-P-identityˡ ; +-identityʳ to +-P-identityʳ +open import Algebra.Polynomial.Poly.Properties.CommutativeRing R + using (cast-p≈p; IsZero⇒≈0; ≈0⇒IsZero; a·p≈a∷[]*p ; *-distrib-shift; shift-is-x*) + renaming (+-identityˡ to +-P-identityˡ ; +-identityʳ to +-P-identityʳ ; zeroˡ to P-zeroˡ; zeroʳ to P-zeroʳ ; *-comm to *-P-comm ) -open import Algebra.Polynomial.Base2 R -open import Algebra.Polynomial.Properties2 R as P +open import Algebra.Polynomial.Properties.CommutativeRing R as P using (+-identityˡ; +-identityʳ; +-*-commutativeRing; *-zeroˡ ; *-zeroʳ) - -import Algebra.Definitions.RawSemiring as Def -import Algebra.Definitions as D + renaming (rawRing to PolyrawRing) open import Algebra.Properties.Group -open import Algebra.Properties.Ring +open import Algebra.Properties.Ring using (-‿distribʳ-*) +open import Data.Product.Base using (proj₁ ; proj₂) open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) open import Data.Vec.Base as Vec using (Vec; []; _∷_) open import Data.Vec.Relation.Unary.All -open import Data.Product.Base using (proj₁ ; proj₂) import Level as L import Relation.Binary.Morphism.Structures as S using (IsRelHomomorphism) -open import Relation.Binary.PropositionalEquality.Core using (cong) -module R = CommutativeRing R -open R +module A = CommutativeRing R +open A hiding (distrib) renaming ( Carrier to A @@ -63,15 +61,13 @@ private module PolynomialRingMorphism {ℓ₃ ℓ₄} (B : CommutativeRing ℓ₃ ℓ₄) - (β : CommutativeRing.Carrier B) - (f : RingHomomorphism {ℓ₁} {ℓ₂} - (CommutativeRing.rawRing R) (CommutativeRing.rawRing B) ) + (f : RingHomomorphism {ℓ₁} {ℓ₂} (CommutativeRing.rawRing R) (CommutativeRing.rawRing B)) where module B = CommutativeRing B open B - using (semiringWithoutOne ; isSemiringWithoutOne ; distrib) + using (distrib) renaming (_≈_ to _≈B_ ; _+_ to _+B_ @@ -81,430 +77,329 @@ module PolynomialRingMorphism using (0#; 1#) open import Relation.Binary.Reasoning.Setoid B-Set - open RingHomomorphism f using (⟦_⟧) - open D {A = B.Carrier} (_≈B_) - using (_MiddleFourExchange_; _DistributesOverˡ_) + open Def {A = B.Carrier} (_≈B_) - eval-p : Poly m → CommutativeRing.Carrier B - eval-p [] = 0# - eval-p (a ∷ p) = ⟦ a ⟧ +B (β *B eval-p p ) + eval-poly : CommutativeRing.Carrier B → (Poly m) → CommutativeRing.Carrier B + eval-poly β [] = 0# + eval-poly β (a ∷ p) = ⟦ a ⟧ +B (β *B eval-poly β p) + eval : CommutativeRing.Carrier B → Polynomial → CommutativeRing.Carrier B + eval β (ℕ.zero , []) = 0# + eval β (suc n , (a ∷ p)) = ⟦ a ⟧ +B (β *B (eval β (n , p))) - eval : Polynomial → CommutativeRing.Carrier B - eval (ℕ.zero , []) = 0# - eval (suc n , (a ∷ p)) = ⟦ a ⟧ +B (β *B eval (n , p) ) + -- prove that eval (0 ∷ 1 ∷ []) is β - - - eval-equiv : (p : Poly m) → eval-p p ≈B (eval (m , p)) - eval-equiv {ℕ.zero} [] = B.refl - eval-equiv {suc m} (a ∷ p) = begin - ⟦ a ⟧ +B β *B eval-p p - ≈⟨ B.+-congˡ (B.*-congˡ (eval-equiv p) ) ⟩ - ⟦ a ⟧ +B β *B eval (m , p) - ∎ + eval-equiv : (β : CommutativeRing.Carrier B) → (p : Poly m) → eval-poly β p ≈B (eval β (m , p)) + eval-equiv {ℕ.zero} β [] = B.refl + eval-equiv {suc m} β (a ∷ p) = B.+-congˡ (B.*-congˡ (eval-equiv β p)) - - eval-p-cong : ∀ {p : Poly m} → ∀ {q : Poly n} → p ≈P q → (eval-p p) ≈B (eval-p q) - eval-p-cong {p = []} {[]} P≈Q = B.refl - eval-p-cong {p = []} {b ∷ q} p≈q = begin - eval-p [] + eval-poly-cong : ∀ {p : Poly m} → ∀ {q : Poly n} → p ≈P q → + (β : CommutativeRing.Carrier B) → (eval-poly β p) ≈B (eval-poly β q) + eval-poly-cong {p = []} {[]} P≈Q β = B.refl + eval-poly-cong {p = []} {b ∷ q} p≈q β = begin + eval-poly β [] ≈⟨ B.zeroʳ β ⟨ β *B 0# - ≈⟨ B.+-identityˡ (β *B eval-p []) ⟨ - 0# +B β *B eval-p [] + ≈⟨ B.+-identityˡ (β *B eval-poly β []) ⟨ + 0# +B β *B eval-poly β [] ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo (RingHomomorphism.+-monoidHomomorphism f)) ⟨ - ⟦ A0# ⟧ +B β *B eval-p [] - ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-cong {p = []} {q = q} - (P-sym (IsZero⇒≈0 (tail (≈0⇒IsZero (P-sym p≈q))))))) ⟩ - ⟦ A0# ⟧ +B β *B eval-p q + ⟦ A0# ⟧ +B β *B eval-poly β [] + ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-cong {p = []} {q = q} + (P-sym (IsZero⇒≈0 (tail (≈0⇒IsZero (P-sym p≈q))))) β)) ⟩ + ⟦ A0# ⟧ +B β *B eval-poly β q ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero (P-sym p≈q)))) ⟨ - eval-p (b ∷ q) + eval-poly β (b ∷ q) ∎ - eval-p-cong {p = a ∷ p} {[]} p≈q = begin - eval-p (a ∷ p) + eval-poly-cong {p = a ∷ p} {[]} p≈q β = begin + eval-poly β (a ∷ p) ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero p≈q))) ⟩ - ⟦ A0# ⟧ +B β *B eval-p p - ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-cong {p = p} {q = []} - (IsZero⇒≈0 (tail (≈0⇒IsZero p≈q))))) ⟩ - ⟦ A0# ⟧ +B β *B eval-p [] + ⟦ A0# ⟧ +B β *B eval-poly β p + ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-cong {p = p} {q = []} + (IsZero⇒≈0 (tail (≈0⇒IsZero p≈q))) β)) ⟩ + ⟦ A0# ⟧ +B β *B eval-poly β [] ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo (RingHomomorphism.+-monoidHomomorphism f)) ⟩ - 0# +B β *B eval-p [] + 0# +B β *B eval-poly β [] ≈⟨ B.+-congˡ (B.zeroʳ β) ⟩ 0# +B 0# ≈⟨ B.+-identityʳ 0# ⟩ - eval-p [] + eval-poly β [] ∎ - eval-p-cong {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) + eval-poly-cong {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) β = B.+-cong (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) a≈b) - (B.*-congˡ (eval-p-cong p≈q)) - - - eval-cong : P ≈ Q → eval P ≈B eval Q - eval-cong {P = (m , p)} {Q = (n , q)} P≈Q = begin - eval (m , p) - ≈⟨ eval-equiv p ⟨ - eval-p p - ≈⟨ eval-p-cong P≈Q ⟩ - eval-p q - ≈⟨ eval-equiv q ⟩ - eval (n , q) + (B.*-congˡ (eval-poly-cong p≈q β)) + + eval-cong : (β : CommutativeRing.Carrier B) → P ≈ Q → eval β P ≈B eval β Q + eval-cong {P = (m , p)} {Q = (n , q)} β P≈Q = begin + eval β (m , p) + ≈⟨ eval-equiv β p ⟨ + eval-poly β p + ≈⟨ eval-poly-cong P≈Q β ⟩ + eval-poly β q + ≈⟨ eval-equiv β q ⟩ + eval β (n , q) ∎ - - - eval-p-+-homomorphic : (p : Poly m) → (q : Poly n) → eval-p (p +P q) ≈B eval-p p +B eval-p q - eval-p-+-homomorphic [] q = begin - eval-p ([] +P q) - ≈⟨ eval-p-cong (+-P-identityˡ {m = 0} q) ⟩ - eval-p q - ≈⟨ B.+-identityˡ (eval-p q) ⟨ - eval-p [] +B eval-p q + eval-poly-+-homomorphic : (β : CommutativeRing.Carrier B) → (p : Poly m) → (q : Poly n) → + eval-poly β (p +P q) ≈B eval-poly β p +B eval-poly β q + eval-poly-+-homomorphic β [] q = begin + eval-poly β ([] +P q) + ≈⟨ eval-poly-cong (+-P-identityˡ {m = 0} q) β ⟩ + eval-poly β q + ≈⟨ B.+-identityˡ (eval-poly β q) ⟨ + eval-poly β [] +B eval-poly β q ∎ - eval-p-+-homomorphic (a ∷ p) [] = B.sym (B.+-identityʳ (eval-p (a ∷ p))) - eval-p-+-homomorphic (a ∷ p) (b ∷ q) = begin - eval-p ((a ∷ p) +P (b ∷ q)) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-+-homomorphic p q)) ⟩ - ⟦ a +A b ⟧ +B (β *B (eval-p p +B eval-p q)) - ≈⟨ B.+-congˡ (proj₁ distrib β (eval-p p) (eval-p q)) ⟩ - ⟦ a +A b ⟧ +B (β *B eval-p p +B β *B eval-p q) + eval-poly-+-homomorphic β (a ∷ p) [] = B.sym (B.+-identityʳ (eval-poly β (a ∷ p))) + eval-poly-+-homomorphic β (a ∷ p) (b ∷ q) = begin + eval-poly β ((a ∷ p) +P (b ∷ q)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-+-homomorphic β p q)) ⟩ + ⟦ a +A b ⟧ +B (β *B (eval-poly β p +B eval-poly β q)) + ≈⟨ B.+-congˡ (proj₁ distrib β (eval-poly β p) (eval-poly β q)) ⟩ + ⟦ a +A b ⟧ +B (β *B eval-poly β p +B β *B eval-poly β q) ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.+-isMagmaHomomorphism f) a b) ⟩ - ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval-p p +B β *B eval-p q) - ≈⟨ B.+-assoc (⟦ a ⟧ +B ⟦ b ⟧) (β *B eval-p p) (β *B eval-p q) ⟨ - ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval-p p +B β *B eval-p q - ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval-p p)) ⟩ - ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval-p p) +B β *B eval-p q - ≈⟨ B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval-p p) (β *B eval-p q) ⟩ - ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval-p p +B (β *B eval-p q)) - ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval-p p) ⟦ b ⟧))) ⟨ - ⟦ a ⟧ +B ((β *B eval-p p) +B ⟦ b ⟧ +B (β *B eval-p q)) - ≈⟨ B.+-congˡ (B.+-assoc (β *B eval-p p) ⟦ b ⟧ (β *B eval-p q)) ⟩ - ⟦ a ⟧ +B (β *B eval-p p +B eval-p (b ∷ q)) - ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval-p p) (eval-p (b ∷ q)) ⟨ - ⟦ a ⟧ +B β *B eval-p p +B eval-p (b ∷ q) + ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval-poly β p +B β *B eval-poly β q) + ≈⟨ B.+-assoc (⟦ a ⟧ +B ⟦ b ⟧) (β *B eval-poly β p) (β *B eval-poly β q) ⟨ + ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval-poly β p +B β *B eval-poly β q + ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval-poly β p)) ⟩ + ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval-poly β p) +B β *B eval-poly β q + ≈⟨ B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval-poly β p) (β *B eval-poly β q) ⟩ + ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval-poly β p +B (β *B eval-poly β q)) + ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval-poly β p) ⟦ b ⟧))) ⟨ + ⟦ a ⟧ +B ((β *B eval-poly β p) +B ⟦ b ⟧ +B (β *B eval-poly β q)) + ≈⟨ B.+-congˡ (B.+-assoc (β *B eval-poly β p) ⟦ b ⟧ (β *B eval-poly β q)) ⟩ + ⟦ a ⟧ +B (β *B eval-poly β p +B eval-poly β (b ∷ q)) + ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval-poly β p) (eval-poly β (b ∷ q)) ⟨ + ⟦ a ⟧ +B β *B eval-poly β p +B eval-poly β (b ∷ q) ∎ - - - eval-+-homomorphic : (P : Polynomial) → (Q : Polynomial) → eval (P + Q) ≈B eval P +B eval Q - eval-+-homomorphic (m , p) (n , q) = begin - eval ((m , p) + (n , q)) - ≈⟨ eval-equiv (p +P q) ⟨ - eval-p (p +P q) - ≈⟨ eval-p-+-homomorphic p q ⟩ - eval-p p +B eval-p q - ≈⟨ B.+-cong (eval-equiv p) (eval-equiv q) ⟩ - eval (m , p) +B eval (n , q) + eval-+-homomorphic : (β : CommutativeRing.Carrier B) → (P : Polynomial) → (Q : Polynomial) → + eval β (P + Q) ≈B eval β P +B eval β Q + eval-+-homomorphic β (m , p) (n , q) = begin + eval β ((m , p) + (n , q)) + ≈⟨ eval-equiv β (p +P q) ⟨ + eval-poly β (p +P q) + ≈⟨ eval-poly-+-homomorphic β p q ⟩ + eval-poly β p +B eval-poly β q + ≈⟨ B.+-cong (eval-equiv β p) (eval-equiv β q) ⟩ + eval β (m , p) +B eval β (n , q) ∎ - eval-p-1#-homomorphic : eval-p (A1# ∷ []) ≈B 1# - eval-p-1#-homomorphic = begin - eval-p (A1# ∷ []) + eval-poly-1#-homomorphic : (β : CommutativeRing.Carrier B) → eval-poly β (A1# ∷ []) ≈B 1# + eval-poly-1#-homomorphic β = begin + eval-poly β (A1# ∷ []) ≈⟨ B.+-cong (RingHomomorphism.1#-homo f) (B.zeroʳ β) ⟩ 1# +B 0# ≈⟨ B.+-identityʳ 1# ⟩ 1# ∎ - eval-1#-homomorphic : eval one ≈B 1# - eval-1#-homomorphic = begin - eval (1 , (A1# ∷ [])) - ≈⟨ eval-equiv (A1# ∷ []) ⟨ - eval-p (A1# ∷ []) - ≈⟨ eval-p-1#-homomorphic ⟩ + eval-1#-homomorphic : (β : CommutativeRing.Carrier B) → eval β one ≈B 1# + eval-1#-homomorphic β = begin + eval β (1 , (A1# ∷ [])) + ≈⟨ eval-equiv β (A1# ∷ []) ⟨ + eval-poly β (A1# ∷ []) + ≈⟨ eval-poly-1#-homomorphic β ⟩ 1# ∎ - - eval-p-scale : (a : A) → (p : Poly m) → eval-p (a ·P p) ≈B eval-p (a ∷ []) *B (eval-p p) - eval-p-scale a [] = begin + eval-poly-scale : (β : CommutativeRing.Carrier B) → (a : A) → (p : Poly m) → + eval-poly β (a ·P p) ≈B eval-poly β (a ∷ []) *B (eval-poly β p) + eval-poly-scale β a [] = begin 0# ≈⟨ B.zeroʳ (⟦ a ⟧ +B β *B 0#) ⟨ (⟦ a ⟧ +B β *B 0#) *B 0# ∎ - eval-p-scale a (b ∷ p) = begin - ⟦ a *A b ⟧ +B β *B eval-p (a ·P p) + eval-poly-scale β a (b ∷ p) = begin + ⟦ a *A b ⟧ +B β *B eval-poly β (a ·P p) ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.*-isMagmaHomomorphism f) a b) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B eval-p (a ·P p) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-scale a p)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B (eval-p (a ∷ []) *B (eval-p p)) + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B eval-poly β (a ·P p) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-scale β a p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B (eval-poly β (a ∷ []) *B (eval-poly β p)) ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-congˡ (B.zeroʳ β)))) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B ((⟦ a ⟧ +B 0#) *B (eval-p p)) + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B ((⟦ a ⟧ +B 0#) *B (eval-poly β p)) ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧))) ⟩ - ⟦ a ⟧ *B ⟦ b ⟧ +B β *B ((⟦ a ⟧ *B eval-p p)) - ≈⟨ B.+-congˡ (B.*-assoc β ⟦ a ⟧ (eval-p p)) ⟨ - ⟦ a ⟧ *B ⟦ b ⟧ +B (β *B (⟦ a ⟧) *B (eval-p p)) + ⟦ a ⟧ *B ⟦ b ⟧ +B β *B ((⟦ a ⟧ *B eval-poly β p)) + ≈⟨ B.+-congˡ (B.*-assoc β ⟦ a ⟧ (eval-poly β p)) ⟨ + ⟦ a ⟧ *B ⟦ b ⟧ +B (β *B (⟦ a ⟧) *B (eval-poly β p)) ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm β ⟦ a ⟧)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B (⟦ a ⟧ *B β) *B eval-p p - ≈⟨ B.+-congˡ (B.*-assoc ⟦ a ⟧ β (eval-p p)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B ⟦ a ⟧ *B (β *B eval-p p) - ≈⟨ proj₁ distrib ⟦ a ⟧ ⟦ b ⟧ ( β *B eval-p p) ⟨ - (⟦ a ⟧) *B (⟦ b ⟧ +B β *B eval-p p) + (⟦ a ⟧ *B ⟦ b ⟧) +B (⟦ a ⟧ *B β) *B eval-poly β p + ≈⟨ B.+-congˡ (B.*-assoc ⟦ a ⟧ β (eval-poly β p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B ⟦ a ⟧ *B (β *B eval-poly β p) + ≈⟨ proj₁ distrib ⟦ a ⟧ ⟦ b ⟧ ( β *B eval-poly β p) ⟨ + (⟦ a ⟧) *B (⟦ b ⟧ +B β *B eval-poly β p) ≈⟨ B.*-congʳ (B.+-identityʳ ⟦ a ⟧) ⟨ - (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-p p) + (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-poly β p) ≈⟨ B.*-congʳ (B.+-congˡ (B.zeroʳ β)) ⟨ - (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval-p p) + (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval-poly β p) ∎ - - eval-p-shift : (p : Poly m) → eval-p (A0# ∷ p) ≈B β *B eval-p p - eval-p-shift p = begin - ⟦ A0# ⟧ +B β *B eval-p p + + eval-poly-shift : (β : CommutativeRing.Carrier B) → (p : Poly m) → eval-poly β (A0# ∷ p) ≈B β *B eval-poly β p + eval-poly-shift β p = begin + ⟦ A0# ⟧ +B β *B eval-poly β p ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo (RingHomomorphism.+-monoidHomomorphism f)) ⟩ - 0# +B β *B eval-p p - ≈⟨ B.+-identityˡ (β *B eval-p p) ⟩ - β *B eval-p p + 0# +B β *B eval-poly β p + ≈⟨ B.+-identityˡ (β *B eval-poly β p) ⟩ + β *B eval-poly β p ∎ - - eval-p-*-homomorphic : (p : Poly m) → (q : Poly n) → eval-p (p *P q) ≈B eval-p p *B eval-p q - eval-p-*-homomorphic [] q = begin - eval-p ([] *P q) - ≈⟨ eval-p-cong (P-zeroˡ q) ⟩ - eval-p [] - ≈⟨ B.zeroˡ (eval-p q) ⟨ - eval-p [] *B eval-p q + eval-poly-*-homomorphic : (β : CommutativeRing.Carrier B) → (p : Poly m) → + (q : Poly n) → eval-poly β (p *P q) ≈B eval-poly β p *B eval-poly β q + eval-poly-*-homomorphic β [] q = begin + eval-poly β ([] *P q) + ≈⟨ eval-poly-cong (P-zeroˡ q) β ⟩ + eval-poly β [] + ≈⟨ B.zeroˡ (eval-poly β q) ⟨ + eval-poly β [] *B eval-poly β q ∎ - eval-p-*-homomorphic (a ∷ p) [] = begin - eval-p ((a ∷ p) *P []) - ≈⟨ eval-p-cong (P-zeroʳ (a ∷ p)) ⟩ - eval-p [] - ≈⟨ B.zeroʳ (eval-p (a ∷ p)) ⟨ - eval-p (a ∷ p) *B eval-p [] + eval-poly-*-homomorphic β (a ∷ p) [] = begin + eval-poly β ((a ∷ p) *P []) + ≈⟨ eval-poly-cong (P-zeroʳ (a ∷ p)) β ⟩ + eval-poly β [] + ≈⟨ B.zeroʳ (eval-poly β (a ∷ p)) ⟨ + eval-poly β (a ∷ p) *B eval-poly β [] ∎ - eval-p-*-homomorphic {suc m} {suc n} (a ∷ p) (b ∷ q) = begin - eval-p ((a ∷ p) *P (b ∷ q)) - ≈⟨ eval-p-cong (cast-p≈p (cast-lem (suc n) (m))) ⟩ - eval-p (a ·P (b ∷ q) +P p *P (A0# ∷ b ∷ q)) - ≈⟨ eval-p-+-homomorphic (a ·P (b ∷ q)) (p *P (A0# ∷ b ∷ q)) ⟩ - eval-p (a ·P (b ∷ q)) +B eval-p (p *P (A0# ∷ b ∷ q)) - ≈⟨ B.+-congʳ (eval-p-scale a (b ∷ q)) ⟩ - (eval-p (a ∷ []) *B eval-p (b ∷ q)) +B eval-p (p *P (A0# ∷ b ∷ q)) - ≈⟨ B.+-congˡ (eval-p-*-homomorphic p (A0# ∷ b ∷ q)) ⟩ - (eval-p (a ∷ []) *B eval-p (b ∷ q)) +B (eval-p p) *B eval-p (A0# ∷ b ∷ q) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-shift (b ∷ q))) ⟩ - (eval-p (a ∷ []) *B eval-p (b ∷ q)) +B (eval-p p) *B (β *B eval-p (b ∷ q)) + eval-poly-*-homomorphic {suc m} {suc n} β (a ∷ p) (b ∷ q) = begin + eval-poly β ((a ∷ p) *P (b ∷ q)) + ≈⟨ eval-poly-cong (cast-p≈p (cast-lem (suc n) (m))) β ⟩ + eval-poly β (a ·P (b ∷ q) +P p *P (A0# ∷ b ∷ q)) + ≈⟨ eval-poly-+-homomorphic β (a ·P (b ∷ q)) (p *P (A0# ∷ b ∷ q)) ⟩ + eval-poly β (a ·P (b ∷ q)) +B eval-poly β (p *P (A0# ∷ b ∷ q)) + ≈⟨ B.+-congʳ (eval-poly-scale β a (b ∷ q)) ⟩ + (eval-poly β (a ∷ []) *B eval-poly β (b ∷ q)) +B eval-poly β (p *P (A0# ∷ b ∷ q)) + ≈⟨ B.+-congˡ (eval-poly-*-homomorphic β p (A0# ∷ b ∷ q)) ⟩ + (eval-poly β (a ∷ []) *B eval-poly β (b ∷ q)) +B (eval-poly β p) *B eval-poly β (A0# ∷ b ∷ q) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-shift β (b ∷ q))) ⟩ + (eval-poly β (a ∷ []) *B eval-poly β (b ∷ q)) +B (eval-poly β p) *B (β *B eval-poly β (b ∷ q)) ≈⟨ B.+-congʳ (B.*-congʳ (B.+-congˡ (B.zeroʳ β))) ⟩ - (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-p q) +B eval-p p *B (β *B (⟦ b ⟧ +B β *B eval-p q)) + (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-poly β q) +B eval-poly β p *B (β *B (⟦ b ⟧ +B β *B eval-poly β q)) ≈⟨ B.+-congʳ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧)) ⟩ - (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-p q) +B eval-p p *B (β *B (⟦ b ⟧ +B β *B eval-p q))) - ≈⟨ B.+-congˡ (B.*-assoc (eval-p p) β (⟦ b ⟧ +B β *B eval-p q)) ⟨ - (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-p q) +B (eval-p p *B β) *B (⟦ b ⟧ +B β *B eval-p q)) - ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm (eval-p p) β)) ⟩ - (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-p q) +B (β *B eval-p p) *B (⟦ b ⟧ +B β *B eval-p q)) - ≈⟨ proj₂ distrib (⟦ b ⟧ +B β *B eval-p q) ⟦ a ⟧ (β *B eval-p p) ⟨ - (⟦ a ⟧ +B β *B eval-p p) *B (⟦ b ⟧ +B β *B eval-p q) + (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-poly β q) +B eval-poly β p *B (β *B (⟦ b ⟧ +B β *B eval-poly β q))) + ≈⟨ B.+-congˡ (B.*-assoc (eval-poly β p) β (⟦ b ⟧ +B β *B eval-poly β q)) ⟨ + (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-poly β q) +B (eval-poly β p *B β) *B (⟦ b ⟧ +B β *B eval-poly β q)) + ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm (eval-poly β p) β)) ⟩ + (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-poly β q) +B (β *B eval-poly β p) *B (⟦ b ⟧ +B β *B eval-poly β q)) + ≈⟨ proj₂ distrib (⟦ b ⟧ +B β *B eval-poly β q) ⟦ a ⟧ (β *B eval-poly β p) ⟨ + (⟦ a ⟧ +B β *B eval-poly β p) *B (⟦ b ⟧ +B β *B eval-poly β q) ∎ - eval-*-homomorphic : (P : Polynomial) → (Q : Polynomial) → eval (P * Q) ≈B eval P *B eval Q - eval-*-homomorphic (m , p) (n , q) = begin - eval ((m , p) * (n , q)) - ≈⟨ eval-equiv ((p *P q)) ⟨ - eval-p (p *P q) - ≈⟨ eval-p-*-homomorphic p q ⟩ - (eval-p p *B eval-p q) - ≈⟨ B.*-cong (eval-equiv p) (eval-equiv q) ⟩ - eval (m , p) *B eval (n , q) + eval-*-homomorphic : (β : CommutativeRing.Carrier B) → (P : Polynomial) → (Q : Polynomial) → + eval β (P * Q) ≈B eval β P *B eval β Q + eval-*-homomorphic β (m , p) (n , q) = begin + eval β ((m , p) * (n , q)) + ≈⟨ eval-equiv β ((p *P q)) ⟨ + eval-poly β (p *P q) + ≈⟨ eval-poly-*-homomorphic β p q ⟩ + (eval-poly β p *B eval-poly β q) + ≈⟨ B.*-cong (eval-equiv β p) (eval-equiv β q) ⟩ + eval β (m , p) *B eval β (n , q) ∎ - eval-p-inverse-homomorphic : (p : Poly m) → eval-p (-P p) ≈B -B (eval-p p) - eval-p-inverse-homomorphic [] = B.sym (ε⁻¹≈ε B.+-group) - eval-p-inverse-homomorphic (a ∷ p) = begin - eval-p (-P (a ∷ p)) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-p-inverse-homomorphic p)) ⟩ - ⟦ -A a ⟧ +B β *B (-B (eval-p p)) - ≈⟨ B.+-congˡ step1 ⟩ - ⟦ -A a ⟧ +B -B (β *B eval-p p) + eval-poly-inverse-homomorphic : (β : CommutativeRing.Carrier B) → (p : Poly m) → + eval-poly β (-P p) ≈B -B (eval-poly β p) + eval-poly-inverse-homomorphic β [] = B.sym (ε⁻¹≈ε B.+-group) + eval-poly-inverse-homomorphic β (a ∷ p) = begin + eval-poly β (-P (a ∷ p)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-inverse-homomorphic β p)) ⟩ + ⟦ -A a ⟧ +B β *B (-B (eval-poly β p)) + ≈⟨ B.+-congˡ (-‿distribʳ-* (CommutativeRing.ring B) β (eval-poly β p)) ⟨ + ⟦ -A a ⟧ +B -B (β *B eval-poly β p) ≈⟨ B.+-congʳ (RingHomomorphism.-‿homo f a) ⟩ - -B ⟦ a ⟧ +B -B (β *B eval-p p) - ≈⟨ B.+-comm (-B (β *B eval-p p)) (-B ⟦ a ⟧) ⟨ - -B (β *B eval-p p) +B -B ⟦ a ⟧ - ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval-p p) ⟨ - -B eval-p (a ∷ p) + -B ⟦ a ⟧ +B -B (β *B eval-poly β p) + ≈⟨ B.+-comm (-B (β *B eval-poly β p)) (-B ⟦ a ⟧) ⟨ + -B (β *B eval-poly β p) +B -B ⟦ a ⟧ + ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval-poly β p) ⟨ + -B eval-poly β (a ∷ p) ∎ - where - step1 = begin - β *B -B eval-p p - ≈⟨ B.*-congˡ (-1*x≈-x B.ring (eval-p p)) ⟨ - β *B (-B 1# *B eval-p p) - ≈⟨ B.*-assoc β (-B 1#) (eval-p p) ⟨ - (β *B -B 1#) *B eval-p p - ≈⟨ B.*-congʳ (B.*-comm (-B 1#) β) ⟨ - (-B 1# *B β) *B eval-p p - ≈⟨ B.*-assoc (-B 1#) β (eval-p p) ⟩ - (-B 1#) *B (β *B eval-p p) - ≈⟨ -1*x≈-x B.ring (β *B eval-p p) ⟩ - -B (β *B eval-p p) - ∎ - - - - eval-inverse-homomorphic : (P : Polynomial) → eval (- P) ≈B -B (eval P) - eval-inverse-homomorphic (m , p) = begin - eval (- (m , p)) - ≈⟨ eval-equiv (-P p) ⟨ - eval-p (-P p) - ≈⟨ eval-p-inverse-homomorphic p ⟩ - -B eval-p p - ≈⟨ B.-‿cong (eval-equiv p) ⟩ - -B eval (m , p) + eval-inverse-homomorphic : (β : CommutativeRing.Carrier B) → (P : Polynomial) → + eval β (- P) ≈B -B (eval β P) + eval-inverse-homomorphic β (m , p) = begin + eval β (- (m , p)) + ≈⟨ eval-equiv β (-P p) ⟨ + eval-poly β (-P p) + ≈⟨ eval-poly-inverse-homomorphic β p ⟩ + -B eval-poly β p + ≈⟨ B.-‿cong (eval-equiv β p) ⟩ + -B eval β (m , p) ∎ - - eval-+-isMagmaHomomorphism : IsMagmaHomomorphism (CommutativeRing.+-rawMagma +-*-commutativeRing) - (CommutativeRing.+-rawMagma B) eval - eval-+-isMagmaHomomorphism = record - { isRelHomomorphism = record { cong = eval-cong } - ; homo = eval-+-homomorphic - } - - eval-+-isMonoidHomomorphism : IsMonoidHomomorphism (CommutativeRing.+-rawMonoid +-*-commutativeRing) - (CommutativeRing.+-rawMonoid B) eval - eval-+-isMonoidHomomorphism = record - { isMagmaHomomorphism = eval-+-isMagmaHomomorphism - ; ε-homo = B.refl - } - - eval-isNearSemiringHomomorphism : IsNearSemiringHomomorphism (SemiringWithoutAnnihilatingZero.rawNearSemiring - (Semiring.semiringWithoutAnnihilatingZero (CommutativeRing.semiring +-*-commutativeRing))) - (SemiringWithoutAnnihilatingZero.rawNearSemiring - (Semiring.semiringWithoutAnnihilatingZero (CommutativeRing.semiring B))) eval - eval-isNearSemiringHomomorphism = record - { +-isMonoidHomomorphism = eval-+-isMonoidHomomorphism - ; *-homo = eval-*-homomorphic } - - eval-isSemiringHomomorphism : IsSemiringHomomorphism (CommutativeSemiring.rawSemiring - (CommutativeRing.commutativeSemiring +-*-commutativeRing)) - (CommutativeSemiring.rawSemiring (CommutativeRing.commutativeSemiring B)) eval - eval-isSemiringHomomorphism = record - { isNearSemiringHomomorphism = eval-isNearSemiringHomomorphism - ; 1#-homo = eval-1#-homomorphic } - - eval-isRingHomomorphism : IsRingHomomorphism (CommutativeRing.rawRing +-*-commutativeRing) (CommutativeRing.rawRing B) eval - eval-isRingHomomorphism = record - { isSemiringHomomorphism = eval-isSemiringHomomorphism - ; -‿homo = eval-inverse-homomorphic + + eval-isRingHomomorphism : (β : CommutativeRing.Carrier B) → IsRingHomomorphism + (CommutativeRing.rawRing +-*-commutativeRing) (CommutativeRing.rawRing B) (eval β) + eval-isRingHomomorphism β = record + { isSemiringHomomorphism = record + { isNearSemiringHomomorphism = record + { +-isMonoidHomomorphism = record + { isMagmaHomomorphism = record + { isRelHomomorphism = record + { cong = eval-cong β } + ; homo = eval-+-homomorphic β + } + ; ε-homo = B.refl + } + ; *-homo = eval-*-homomorphic β + } + ; 1#-homo = eval-1#-homomorphic β + } + ; -‿homo = eval-inverse-homomorphic β } - - - -{- - eval-cong : P ≈ Q → eval P ≈B eval Q - eval-cong {P = 0 , []} {Q = ℕ.zero , []} P≈Q = B.refl - eval-cong {P = suc n , (a ∷ p)} {Q = ℕ.zero , []} P≈Q = begin - eval (suc n , (a ∷ p)) - ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong - (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero P≈Q))) ⟩ - ⟦ A0# ⟧ +B β *B eval (n , p) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {P = n , p} {Q = ℕ.zero , []} - (IsZero⇒≈0 (tail (≈0⇒IsZero P≈Q))))) ⟩ - ⟦ A0# ⟧ +B β *B eval(ℕ.zero , []) - ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo - (RingHomomorphism.+-monoidHomomorphism f)) ⟩ - (0# +B β *B eval(ℕ.zero , [])) - ≈⟨ B.+-congˡ (B.zeroʳ β) ⟩ - (0# +B 0#) - ≈⟨ B.+-identityʳ 0# ⟩ - eval (ℕ.zero , []) - ∎ - eval-cong {P = ℕ.zero , []} {Q = suc n , (a ∷ q)} P≈Q = begin - eval (ℕ.zero , []) - ≈⟨ B.zeroʳ β ⟨ - β *B eval (ℕ.zero , []) - ≈⟨ B.+-identityˡ (β *B eval (ℕ.zero , [])) ⟨ - 0# +B β *B eval (ℕ.zero , []) - ≈⟨ B.+-congʳ ( (MonoidHomomorphism.ε-homo - (RingHomomorphism.+-monoidHomomorphism f))) ⟨ - ⟦ A0# ⟧ +B β *B eval (ℕ.zero , []) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {P = 0 , []} {Q = n , q} - (P-sym (IsZero⇒≈0 (tail (≈0⇒IsZero (P-sym P≈Q))))))) ⟩ - ⟦ A0# ⟧ +B β *B eval (n , q) - ≈⟨ B.+-congʳ ((S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) - (head (≈0⇒IsZero (P-sym P≈Q))))) ⟨ - eval (suc n , (a ∷ q)) - ∎ - eval-cong {P = suc m , (a ∷ p)} {Q = suc n , (b ∷ q)} (cons a≈b p≈q) - = B.+-cong (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) a≈b) - (B.*-congˡ (eval-cong p≈q)) - -} - - -{-eval-+-homomorphic (0 , []) (n , q) = begin - eval ((ℕ.zero , []) + (n , q)) - ≈⟨ eval-cong (P.+-identityˡ ((n , q))) ⟩ - eval (n , q) - ≈⟨ B.+-identityˡ (eval (n , q)) ⟨ - eval (ℕ.zero , []) +B eval (n , q) - ∎ - eval-+-homomorphic (suc m , (a ∷ p)) (0 , []) = B.sym (B.+-identityʳ (eval (suc m , (a ∷ p)))) - eval-+-homomorphic (suc m , (a ∷ p)) (suc n , (b ∷ q)) = begin - eval ((suc m , (a ∷ p)) + (suc n , (b ∷ q))) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-+-homomorphic (m , p) (n , q))) ⟩ - ⟦ a +A b ⟧ +B (β *B (eval (m , p) +B eval (n , q))) - ≈⟨ B.+-congˡ (proj₁ distrib β (eval (m , p)) (eval (n , q))) ⟩ - ⟦ a +A b ⟧ +B (β *B eval (m , p) +B β *B eval (n , q)) - ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.+-isMagmaHomomorphism f) a b) ⟩ - ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval (m , p) +B β *B eval (n , q)) - ≈⟨ B.+-assoc ( ⟦ a ⟧ +B ⟦ b ⟧) (β *B eval (m , p)) (β *B eval (n , q)) ⟨ - ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval (m , p) +B β *B eval (n , q) - ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval (m , p))) ⟩ - ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval (m , p)) +B β *B eval (n , q) - ≈⟨ (B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval (m , p)) (β *B eval (n , q))) ⟩ - ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval (m , p) +B (β *B eval (n , q))) - ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval (m , p)) ⟦ b ⟧))) ⟨ - ⟦ a ⟧ +B ((β *B eval (m , p)) +B ⟦ b ⟧ +B (β *B eval (n , q))) - ≈⟨ B.+-congˡ (B.+-assoc (β *B eval (m , p)) ⟦ b ⟧ (β *B eval (n , q))) ⟩ - ⟦ a ⟧ +B (β *B eval (m , p) +B eval (suc n , (b ∷ q))) - ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval (m , p)) (eval (suc n , (b ∷ q))) ⟨ - eval (suc m , (a ∷ p)) +B eval (suc n , (b ∷ q)) +---------------- Universal Property of Polynomial Rings ---------------- + + x-mapsto-β : (β : CommutativeRing.Carrier B) → eval β (2 , (A0# ∷ A1# ∷ [])) ≈B β + x-mapsto-β β = begin + ⟦ A0# ⟧ +B β *B (⟦ A1# ⟧ +B β *B 0#) + ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo (RingHomomorphism.+-monoidHomomorphism f)) ⟩ + 0# +B (β *B (⟦ A1# ⟧ +B β *B 0#)) + ≈⟨ B.+-identityˡ (β *B (⟦ A1# ⟧ +B β *B 0#))⟩ + β *B (⟦ A1# ⟧ +B β *B 0#) + ≈⟨ B.*-congˡ (B.+-cong (RingHomomorphism.1#-homo f) (B.zeroʳ β)) ⟩ + β *B (1# +B 0#) + ≈⟨ B.*-congˡ (B.+-identityʳ 1#) ⟩ + β *B 1# + ≈⟨ B.*-identityʳ β ⟩ + β ∎ - -} - - -{- eval-1#-homomorphic = begin - eval (1 , (A1# ∷ [])) - ≈⟨ B.+-cong (RingHomomorphism.1#-homo f) (B.zeroʳ β) ⟩ - 1# +B 0# - ≈⟨ B.+-identityʳ (1#) ⟩ - 1# +-- define a canonical inclusion homomorphism from R to R[x]) + i : A.Carrier → Polynomial + i r = (1 , (r ∷ [])) + + eval-comm : (β : CommutativeRing.Carrier B) → ∀ (r : A.Carrier) → ⟦ r ⟧ ≈B eval β (i r) + eval-comm β r = begin + ⟦ r ⟧ + ≈⟨ B.+-identityʳ ⟦ r ⟧ ⟨ + ⟦ r ⟧ +B 0# + ≈⟨ B.+-congˡ (B.zeroʳ β) ⟨ + eval β (1 , (r ∷ [])) ∎ + + eval-unique : (β : CommutativeRing.Carrier B) → + ∀ (ϕ : RingHomomorphism {ℓ₁} {ℓ₁ L.⊔ ℓ₂} (PolyrawRing) (CommutativeRing.rawRing B)) → + (∀ (r : A.Carrier) → RingHomomorphism.⟦ ϕ ⟧ (i r) ≈B (⟦ r ⟧)) → + RingHomomorphism.⟦ ϕ ⟧ (2 , (A0# ∷ A1# ∷ [])) ≈B β → + ∀ (p : Polynomial) → RingHomomorphism.⟦ ϕ ⟧ p ≈B eval β p + eval-unique β ϕ _ _ (ℕ.zero , []) = MonoidHomomorphism.ε-homo (RingHomomorphism.+-monoidHomomorphism ϕ) + eval-unique β ϕ ϕ-comm x-mapsto-β (suc n , (a ∷ p)) = begin + RingHomomorphism.⟦ ϕ ⟧ (suc n , (a ∷ p)) + ≈⟨ S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism ϕ) + (cons ((A.+-identityʳ a)) (P.+-identityˡ (n , p))) ⟨ + RingHomomorphism.⟦ ϕ ⟧ ((1 , (a ∷ [])) + (suc n , (A0# ∷ p))) + ≈⟨ IsMagmaHomomorphism.homo (RingHomomorphism.+-isMagmaHomomorphism ϕ) + (1 , (a ∷ [])) (suc n , (A0# ∷ p)) ⟩ + RingHomomorphism.⟦ ϕ ⟧ (1 , (a ∷ [])) +B RingHomomorphism.⟦ ϕ ⟧ (suc n , (A0# ∷ p)) + ≈⟨ B.+-congˡ (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism ϕ) (shift-is-x* (p))) ⟩ + RingHomomorphism.⟦ ϕ ⟧ (1 , (a ∷ [])) +B RingHomomorphism.⟦ ϕ ⟧ ((2 , (A0# ∷ A1# ∷ [])) * (n , p)) + ≈⟨ B.+-congˡ (IsMagmaHomomorphism.homo (RingHomomorphism.*-isMagmaHomomorphism ϕ) + (2 , (A0# ∷ A1# ∷ [])) (n , p)) ⟩ + RingHomomorphism.⟦ ϕ ⟧ (1 , (a ∷ [])) +B RingHomomorphism.⟦ ϕ ⟧ (2 , (A0# ∷ A1# ∷ [])) *B (RingHomomorphism.⟦ ϕ ⟧ (n , p)) + ≈⟨ B.+-congˡ (B.*-cong x-mapsto-β (eval-unique β ϕ ϕ-comm x-mapsto-β (n , p))) ⟩ + RingHomomorphism.⟦ ϕ ⟧ (i a) +B β *B eval β (n , p) + ≈⟨ B.+-congʳ (ϕ-comm a) ⟩ + eval β (suc n , (a ∷ p)) + ∎ --} - - -{-eval-inverse-homomorphic (0 , []) = B.sym (ε⁻¹≈ε B.+-group) - eval-inverse-homomorphic (suc m , (a ∷ p)) = begin - eval (- (suc m , (a ∷ p))) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-inverse-homomorphic (m , p))) ⟩ - ⟦ -A a ⟧ +B β *B (-B (eval (m , p))) - ≈⟨ B.+-congˡ step1 ⟩ - ⟦ -A a ⟧ +B -B (β *B eval (m , p)) - ≈⟨ B.+-congʳ (RingHomomorphism.-‿homo f a) ⟩ - -B ⟦ a ⟧ +B -B (β *B eval (m , p)) - ≈⟨ B.+-comm (-B (β *B eval (m , p))) (-B ⟦ a ⟧) ⟨ - -B (β *B eval (m , p)) +B (-B ⟦ a ⟧) - ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval (m , p)) ⟨ - (-B eval (suc m , (a ∷ p))) - ∎ - where - step1 = begin - β *B (-B (eval (m , p))) - ≈⟨ B.*-congˡ (-1*x≈-x B.ring (eval (m , p))) ⟨ - β *B (-B 1# *B eval (m , p)) - ≈⟨ B.*-assoc β (-B 1#) (eval (m , p)) ⟨ - (β *B -B 1#) *B eval (m , p) - ≈⟨ B.*-congʳ (B.*-comm (-B 1#) β) ⟨ - (-B 1# *B β) *B eval (m , p) - ≈⟨ B.*-assoc (-B 1#) β (eval (m , p)) ⟩ - (-B 1#) *B (β *B eval (m , p)) - ≈⟨ -1*x≈-x B.ring (β *B eval (m , p)) ⟩ - -B (β *B eval (m , p)) - ∎ - -} diff --git a/src/Algebra/Polynomial/Poly/Base.agda b/src/Algebra/Polynomial/Poly/Base/Base similarity index 98% rename from src/Algebra/Polynomial/Poly/Base.agda rename to src/Algebra/Polynomial/Poly/Base/Base index b150951622..b20a535cfd 100644 --- a/src/Algebra/Polynomial/Poly/Base.agda +++ b/src/Algebra/Polynomial/Poly/Base/Base @@ -1,6 +1,6 @@ open import Algebra.Bundles using (Semiring) -module Algebra.Polynomial.Poly.Base +module Algebra.Polynomial.Poly.Base.Semiring {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where diff --git a/src/Algebra/Polynomial/Poly/Base2.agda b/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda similarity index 95% rename from src/Algebra/Polynomial/Poly/Base2.agda rename to src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda index aac53f2489..b5670936c3 100644 --- a/src/Algebra/Polynomial/Poly/Base2.agda +++ b/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda @@ -1,6 +1,6 @@ open import Algebra.Bundles using (CommutativeRing) -module Algebra.Polynomial.Poly.Base2 +module Algebra.Polynomial.Poly.Base.CommutativeRing {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) where @@ -54,10 +54,15 @@ zeros n = Vec.replicate n (0#) _·_ : A → Poly n → Poly n a · p = Vec.map (a *A_) p --- Multiply a polynomial by a factor of x +-- Multiply a polynomial by x shift : Poly n → Poly (suc n) shift p = 0# ∷ p +-- Multiply a polynomial by xⁿ +shift-by-n : (n : ℕ) → Poly m → Poly (n ℕ.+ m) +shift-by-n 0 p = p +shift-by-n (suc n) p = 0# ∷ shift-by-n n p + IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) IsZero = All (_≈A 0#) diff --git a/src/Algebra/Polynomial/Poly/Base1.agda b/src/Algebra/Polynomial/Poly/Base/Ring.agda similarity index 95% rename from src/Algebra/Polynomial/Poly/Base1.agda rename to src/Algebra/Polynomial/Poly/Base/Ring.agda index 814f134482..8d403764df 100644 --- a/src/Algebra/Polynomial/Poly/Base1.agda +++ b/src/Algebra/Polynomial/Poly/Base/Ring.agda @@ -1,6 +1,6 @@ open import Algebra.Bundles using (Ring) -module Algebra.Polynomial.Poly.Base1 +module Algebra.Polynomial.Poly.Base.Ring {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) where @@ -54,14 +54,18 @@ zeros n = Vec.replicate n (0#) _·_ : A → Poly n → Poly n a · p = Vec.map (a *A_) p --- Multiply a polynomial by a factor of x +-- Multiply a polynomial by x shift : Poly n → Poly (suc n) shift p = 0# ∷ p +-- Multiply a polynomial by xⁿ +shift-by-n : (n : ℕ) → Poly m → Poly (n ℕ.+ m) +shift-by-n 0 p = p +shift-by-n (suc n) p = 0# ∷ shift-by-n n p + IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) IsZero = All (_≈A 0#) - -- The additive inverse -_ : Poly n → Poly n - p = Vec.map -A_ p diff --git a/src/Algebra/Polynomial/Poly/Base/Semiring.agda b/src/Algebra/Polynomial/Poly/Base/Semiring.agda new file mode 100644 index 0000000000..848af27bae --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Base/Semiring.agda @@ -0,0 +1,147 @@ +open import Algebra.Bundles using (Semiring) + +module Algebra.Polynomial.Poly.Base.Semiring + {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) + where + +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +import Data.Nat.Properties as ℕ +open import Data.Vec.Base as Vec using (Vec; []; _∷_) +open import Data.Vec.Relation.Unary.All using (All ; []; _∷_) +import Level as L +open import Relation.Binary.PropositionalEquality.Core using (cong) +open import Relation.Binary.PropositionalEquality + using (_≡_; cong; module ≡-Reasoning) + +module SR = Semiring SR +open SR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ) + using (0#; 1#) + +infixl 7 _*_ +infix 7 _·_ +infixl 6 _+_ +infix 4 _≈_ + +private + variable + m n k l : ℕ + a b c d : A + +-- Polynomial of degree most n is represented as a vector of length n + 1 +-- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∷ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ + +Poly : ℕ → Set ℓ₁ +Poly n = Vec A n + +private + variable + p : Poly m + q : Poly n + r : Poly k + s : Poly l + +zeros : (n : ℕ) → Poly n +zeros n = Vec.replicate n (0#) + +-- Scaling a polynomial by a +_·_ : A → Poly n → Poly n +a · p = Vec.map (a *A_) p + +-- Multiply a polynomial by x +shift : Poly n → Poly (suc n) +shift p = 0# ∷ p + +-- Multiply a polynomial by xⁿ +shift-by-n : (n : ℕ) → Poly m → Poly (n ℕ.+ m) +shift-by-n 0 p = p +shift-by-n (suc n) p = 0# ∷ shift-by-n n p + +IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) +IsZero = All (_≈A 0#) + +-- The representation of a polynomial is not unique +-- because we allow coefficients to be zero +-- We define an equivalence relation which takes this into account + +data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where + []≈ : (q : Poly n) → IsZero q → [] ≈ q + ≈[] : (p : Poly m) → IsZero p → p ≈ [] + cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) + +-- Properties of Polynomial Equality + +zeros-unique : IsZero p → IsZero q → p ≈ q +zeros-unique [] [] = []≈ [] [] +zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = cons (SR.trans a≈0 (SR.sym b≈0)) (zeros-unique p≈0 q≈0) + +IsZero-cong : IsZero p → p ≈ q → IsZero q +IsZero-cong [] ([]≈ q q≈0) = q≈0 +IsZero-cong [] (≈[] p p≈0) = p≈0 +IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] +IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) + = (SR.trans (SR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q + +-- _≈_ is an equivalence relation + +refl : p ≈ p +refl {p = []} = []≈ [] [] +refl {p = a ∷ p} = cons SR.refl refl + +sym : p ≈ q → q ≈ p +sym ([]≈ q q≈0) = ≈[] q q≈0 +sym (≈[] p p≈0) = []≈ p p≈0 +sym (cons a≈b p≈q) = cons (SR.sym a≈b) (sym p≈q) + +trans : p ≈ q → q ≈ r → p ≈ r +trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) +trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) +trans (cons a≈b p≈q) (≈[] q q≈0) + = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) +trans (cons a≈b p≈q) (cons b≈c q≈r) + = cons (SR.trans a≈b b≈c) (trans p≈q q≈r) + +consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) +consˡ a≈b = cons a≈b refl + +consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) +consʳ = cons SR.refl + +---------------------------------------------------------------- +-- Operations + +-- Addition +_+_ : Poly m → Poly n → Poly (m ⊔ n) +[] + [] = [] +[] + (a ∷ p) = a ∷ p +(a ∷ p) + [] = a ∷ p +(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) + +private + pred[n+sucm]≡n+m : ∀ n → ∀ m → pred (n ℕ.+ suc m) ≡ n ℕ.+ m + pred[n+sucm]≡n+m n m = begin + pred (n ℕ.+ suc m) ≡⟨ cong pred (ℕ.+-comm n (suc m)) ⟩ + pred (suc m ℕ.+ n) ≡⟨ ℕ.+-comm m n ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +cast-lem : ∀ m → ∀ n → m ⊔ pred (n ℕ.+ suc m) ≡ (n ℕ.+ m) +cast-lem m n = begin + m ⊔ pred (n ℕ.+ suc m) ≡⟨ cong (m ⊔_) (pred[n+sucm]≡n+m n m) ⟩ + m ⊔ (n ℕ.+ m) ≡⟨ ℕ.m≤n⇒m⊔n≡n (ℕ.m≤n+m m n) ⟩ + n ℕ.+ m ∎ + where open ≡-Reasoning + +-- Multiplication +_*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) +_*_ {m = m} [] p = zeros (pred m) +_*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) + diff --git a/src/Algebra/Polynomial/Poly/Properties2.agda b/src/Algebra/Polynomial/Poly/Properties/CommutativeRing.agda similarity index 92% rename from src/Algebra/Polynomial/Poly/Properties2.agda rename to src/Algebra/Polynomial/Poly/Properties/CommutativeRing.agda index 56c7f0612c..af17b46aec 100644 --- a/src/Algebra/Polynomial/Poly/Properties2.agda +++ b/src/Algebra/Polynomial/Poly/Properties/CommutativeRing.agda @@ -1,10 +1,10 @@ open import Algebra.Bundles using (CommutativeRing) -module Algebra.Polynomial.Poly.Properties2 +module Algebra.Polynomial.Poly.Properties.CommutativeRing {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base2 R as P +open import Algebra.Polynomial.Poly.Base.CommutativeRing R as P using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) open import Algebra.Properties.Ring @@ -96,12 +96,12 @@ zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) IsZero⇒≈0 : IsZero p → p ≈ zeros m IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) -All-p≈0∧q≈0⇒p+q≈0 : All (_≈A 0#) p → All (_≈A 0#) q → All (_≈A 0#) (p + q) -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] [] = [] -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 -All-p≈0∧q≈0⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = CR.trans (CR.+-cong a≈0 b≈0) (CR.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 +All[p≈0∧q≈0]⇒p+q≈0 : All (_≈A 0#) p → All (_≈A 0#) q → All (_≈A 0#) (p + q) +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] [] = [] +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +All[p≈0∧q≈0]⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = CR.trans (CR.+-cong a≈0 b≈0) (CR.+-identityˡ 0#) ∷ All[p≈0∧q≈0]⇒p+q≈0 p≈0 q≈0 ------------------------------------------------------ -- Additive inverse @@ -281,6 +281,10 @@ a≈0⇒a·pIsZero a [] a≈0 = [] a≈0⇒a·pIsZero a (b ∷ p) a≈0 = CR.trans (CR.*-congʳ a≈0) (CR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) +1·p≈p : (p : Poly n) → 1# · p ≈ p +1·p≈p [] = []≈ [] [] +1·p≈p (a ∷ p) = cons (CR.*-identityˡ a) (1·p≈p p) + ·-cong : a ≈A b → p ≈ q → a · p ≈ b · q ·-cong {a = _} {b = b} _ ([]≈ q q≈0) = sym (IsZero⇒≈0 (pIsZero⇒a·pIsZero b q q≈0)) @@ -328,7 +332,7 @@ pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) pIsZero⇒p*qIsZero {n} {_} {p = []} q [] = zerosIsZero (pred n) pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) = cast-p≈0⇒p≈0 (cast-lem n m) - (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) + (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) @@ -661,3 +665,29 @@ shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl a ∷ (p * (1# ∷ [])) ≈⟨ consʳ (*-identityʳ p) ⟩ a ∷ p ∎ + +shift-is-x* : (p : Poly n) → (shift p) ≈ (0# ∷ 1# ∷ []) * p +shift-is-x* {n} [] = begin + 0# ∷ [] + ≈⟨ zerosm≈zerosn ⟩ + [] + ≈⟨ zeroʳ (0# ∷ 1# ∷ []) ⟨ + (0# ∷ 1# ∷ []) * [] + ∎ +shift-is-x* {suc n} (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ consʳ (consʳ (1·p≈p p)) ⟨ + 0# ∷ a ∷ 1# · p + ≈⟨ consʳ (cons (CR.*-identityˡ a) (+-identityʳ (1# · p))) ⟨ + 0# ∷ 1# *A a ∷ (1# · p + zeros n) + ≈⟨ cons (CR.+-identityˡ 0#) (+-identityˡ (1# *A a ∷ (1# · p + zeros n))) ⟨ + 0# +A 0# ∷ (zeros n + (1# *A a ∷ 1# · p + zeros n)) + ≈⟨ consʳ (+-cong (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# p CR.refl)) + (cons (CR.+-identityʳ (1# *A a)) (cast-p≈p (ℕ.⊔-idem n)))) ⟨ + 0# +A 0# ∷ (0# · p + Vec.cast (cong suc (ℕ.⊔-idem n)) (1# · (a ∷ p) + zeros (suc n))) + ≈⟨ consˡ (CR.+-identityˡ (0# +A 0#)) ⟨ + 0# +A (0# +A 0#) ∷ 0# · p + Vec.cast (cong suc (ℕ.⊔-idem n)) (1# · (a ∷ p) + zeros (suc n)) + ≈⟨ cons (CR.+-cong (CR.zeroˡ a) (CR.+-congʳ (CR.zeroʳ 1#))) + (cast-p≈p (ℕ.m≤n⇒m⊔n≡n (ℕ.n≤1+n n))) ⟨ + (0# ∷ 1# ∷ []) * (a ∷ p) + ∎ diff --git a/src/Algebra/Polynomial/Poly/Properties1.agda b/src/Algebra/Polynomial/Poly/Properties/Ring.agda similarity index 94% rename from src/Algebra/Polynomial/Poly/Properties1.agda rename to src/Algebra/Polynomial/Poly/Properties/Ring.agda index de8401c194..14c9f928f2 100644 --- a/src/Algebra/Polynomial/Poly/Properties1.agda +++ b/src/Algebra/Polynomial/Poly/Properties/Ring.agda @@ -1,10 +1,10 @@ open import Algebra.Bundles using (Ring) -module Algebra.Polynomial.Poly.Properties1 +module Algebra.Polynomial.Poly.Properties.Ring {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base1 R as P +open import Algebra.Polynomial.Poly.Base.Ring R as P using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) open import Algebra.Properties.Ring @@ -95,12 +95,12 @@ zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) IsZero⇒≈0 : IsZero p → p ≈ zeros m IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) -All-p≈0∧q≈0⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] [] = [] -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 -All-p≈0∧q≈0⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = R.trans (R.+-cong a≈0 b≈0) (R.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 +All[p≈0∧q≈0]⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] [] = [] +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +All[p≈0∧q≈0]⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = R.trans (R.+-cong a≈0 b≈0) (R.+-identityˡ 0#) ∷ All[p≈0∧q≈0]⇒p+q≈0 p≈0 q≈0 ------------------------------------------------------ -- Additive inverse @@ -220,9 +220,6 @@ middleFour p q r w = begin -- Vector casting lemmas private - n+1≡sucn+0 : (n ℕ.+ 1) ≡ suc (n ℕ.+ 0) - n+1≡sucn+0 {0} = Eq.refl - n+1≡sucn+0 {suc n} = cong suc n+1≡sucn+0 cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → All (_≈A 0#) (Vec.cast m≡n p) @@ -326,7 +323,7 @@ zeroˡ p = zerosm≈zerosn zeroʳ : (p : Poly m) → p * [] ≈ [] zeroʳ [] = refl zeroʳ {m} (a ∷ p) = begin - (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ @@ -337,7 +334,7 @@ pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) pIsZero⇒p*qIsZero {n} {p = []} q [] = zerosIsZero (pred n) pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) = cast-p≈0⇒p≈0 (cast-lem n m) - (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) + (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) @@ -354,7 +351,7 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero [] * s ∎ *-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin (a ∷ p) * [] - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ [] + p * (0# ∷ []) ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ [] + q * (0# ∷ s) @@ -375,7 +372,7 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero zeros k + q * (0# ∷ []) ≈⟨ +-congˡ zerosm≈zerosn ⟩ (b · []) + q * (0# ∷ []) - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ (b ∷ q) * [] ∎ *-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin @@ -487,7 +484,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin (a · []) * q ∎ ·-distrib-* {suc m} {_} (b ∷ p) [] a = begin a · ((b ∷ p) * []) - ≈⟨ a·-cong (cast-p≈p (cong pred n+1≡sucn+0)) ⟩ + ≈⟨ a·-cong (cast-p≈p (cong pred ℕ.n+1≡suc[n+0])) ⟩ a · ((b · []) + (p * (0# ∷ []))) ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ a · (p * (0# ∷ [])) @@ -497,7 +494,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin (a · p) * (0# ∷ []) ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ ((a *A b) · []) + ((a · p) * (0# ∷ [])) - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ (a · (b ∷ p)) * [] ∎ ·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin @@ -520,7 +517,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin shift ([] * q) ≈⟨ consʳ zerosm≈zerosn ⟩ shift [] - ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero 0# q R.refl) + ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero 0# q R.refl) (≈0⇒IsZero {m = n} zerosm≈zerosn)) ⟨ 0# · q + zeros (pred (suc n)) ≈⟨ cast-p≈p (ℕ.⊔-idem (pred (1 ℕ.+ n))) ⟨ @@ -545,7 +542,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin [] * (q + r) ≈⟨ zerosm≈zerosn ⟩ [] - ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ + ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ [] * q + [] * r ∎ *-distribˡ-+ {m = suc m} {n = n} {k = k} (a ∷ p) q r = begin (a ∷ p) * (q + r) diff --git a/src/Algebra/Polynomial/Poly/Properties.agda b/src/Algebra/Polynomial/Poly/Properties/Semiring.agda similarity index 94% rename from src/Algebra/Polynomial/Poly/Properties.agda rename to src/Algebra/Polynomial/Poly/Properties/Semiring.agda index ff614789c9..1d51e6922f 100644 --- a/src/Algebra/Polynomial/Poly/Properties.agda +++ b/src/Algebra/Polynomial/Poly/Properties/Semiring.agda @@ -1,10 +1,10 @@ open import Algebra.Bundles using (Semiring) -module Algebra.Polynomial.Poly.Properties +module Algebra.Polynomial.Poly.Properties.Semiring {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base SR as P +open import Algebra.Polynomial.Poly.Base.Semiring SR as P using ( Poly; _+_ ; _*_ ; _·_ ; shift; _≈_; refl; trans; sym; zeros ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) @@ -94,12 +94,12 @@ zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) IsZero⇒≈0 : IsZero p → p ≈ zeros m IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) -All-p≈0∧q≈0⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] [] = [] -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 -All-p≈0∧q≈0⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 -All-p≈0∧q≈0⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = SR.trans (SR.+-cong a≈0 b≈0) (SR.+-identityˡ 0#) ∷ All-p≈0∧q≈0⇒p+q≈0 p≈0 q≈0 +All[p≈0∧q≈0]⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] [] = [] +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +All[p≈0∧q≈0]⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = SR.trans (SR.+-cong a≈0 b≈0) (SR.+-identityˡ 0#) ∷ All[p≈0∧q≈0]⇒p+q≈0 p≈0 q≈0 ----------------------------------------------------- -- Properties of polynomial addition @@ -182,9 +182,6 @@ middleFour p q r w = begin -- Vector casting lemmas private - n+1≡sucn+0 : (n ℕ.+ 1) ≡ suc (n ℕ.+ 0) - n+1≡sucn+0 {0} = Eq.refl - n+1≡sucn+0 {suc n} = cong suc n+1≡sucn+0 cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → All (_≈A 0#) (Vec.cast m≡n p) @@ -196,7 +193,6 @@ private cast-p≈p {n = 0} {[]} Eq.refl = refl cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) - ------------------------------------------------------------------ -- Properties of polynomial shifting @@ -288,7 +284,7 @@ zeroˡ p = zerosm≈zerosn zeroʳ : (p : Poly m) → p * [] ≈ [] zeroʳ [] = refl zeroʳ {m} (a ∷ p) = begin - (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ @@ -299,7 +295,7 @@ pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) pIsZero⇒p*qIsZero {n} {p = []} q [] = zerosIsZero (pred n) pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) = cast-p≈0⇒p≈0 (cast-lem n m) - (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) + (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) @@ -316,7 +312,7 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero [] * s ∎ *-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin (a ∷ p) * [] - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ + ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ [] + p * (0# ∷ []) ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ [] + q * (0# ∷ s) @@ -337,7 +333,7 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero zeros k + q * (0# ∷ []) ≈⟨ +-congˡ zerosm≈zerosn ⟩ (b · []) + q * (0# ∷ []) - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ (b ∷ q) * [] ∎ *-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin @@ -450,7 +446,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin (a · []) * q ∎ ·-distrib-* {suc m} {_} (b ∷ p) [] a = begin a · ((b ∷ p) * []) - ≈⟨ a·-cong (cast-p≈p (cong pred n+1≡sucn+0)) ⟩ + ≈⟨ a·-cong (cast-p≈p (cong pred ℕ.n+1≡suc[n+0])) ⟩ a · ((b · []) + (p * (0# ∷ []))) ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ a · (p * (0# ∷ [])) @@ -460,7 +456,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin (a · p) * (0# ∷ []) ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ ((a *A b) · []) + ((a · p) * (0# ∷ [])) - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ + ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ (a · (b ∷ p)) * [] ∎ ·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin @@ -483,7 +479,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin shift ([] * q) ≈⟨ consʳ zerosm≈zerosn ⟩ shift [] - ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (a≈0⇒a·pIsZero 0# q SR.refl) + ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero 0# q SR.refl) (≈0⇒IsZero {m = n} zerosm≈zerosn)) ⟨ 0# · q + zeros (pred (suc n)) ≈⟨ cast-p≈p (ℕ.⊔-idem (pred (1 ℕ.+ n))) ⟨ @@ -508,7 +504,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin [] * (q + r) ≈⟨ zerosm≈zerosn ⟩ [] - ≈⟨ IsZero⇒≈0 (All-p≈0∧q≈0⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ + ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ [] * q + [] * r ∎ *-distribˡ-+ {m = suc m} {n = n} {k = k} (a ∷ p) q r = begin (a ∷ p) * (q + r) diff --git a/src/Algebra/Polynomial/Properties2.agda b/src/Algebra/Polynomial/Properties/CommutativeRing.agda similarity index 97% rename from src/Algebra/Polynomial/Properties2.agda rename to src/Algebra/Polynomial/Properties/CommutativeRing.agda index c239ab54d4..c28b138843 100644 --- a/src/Algebra/Polynomial/Properties2.agda +++ b/src/Algebra/Polynomial/Properties/CommutativeRing.agda @@ -1,7 +1,7 @@ open import Algebra.Bundles using (Magma; CommutativeRing) open import Algebra.Bundles.Raw -module Algebra.Polynomial.Properties2 +module Algebra.Polynomial.Properties.CommutativeRing {ℓ₁ ℓ₂} (CR : CommutativeRing ℓ₁ ℓ₂) where @@ -9,8 +9,8 @@ module Algebra.Polynomial.Properties2 import Algebra.Consequences.Setoid as C using (comm∧distrʳ⇒distrˡ ; comm∧idʳ⇒idˡ) import Algebra.Definitions as Def -import Algebra.Polynomial.Poly.Properties2 CR as Poly -open import Algebra.Polynomial.Base2 CR +import Algebra.Polynomial.Poly.Properties.CommutativeRing CR as Poly +open import Algebra.Polynomial.Base.CommutativeRing CR using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ ; zero; one; -_; refl; sym; trans) open import Algebra.Properties.AbelianGroup @@ -157,8 +157,6 @@ rawSemiring = record ; 1# = one } - - rawRing : Algebra.Bundles.Raw.RawRing _ _ rawRing = record { Carrier = Polynomial diff --git a/src/Algebra/Polynomial/Properties1.agda b/src/Algebra/Polynomial/Properties/Ring.agda similarity index 97% rename from src/Algebra/Polynomial/Properties1.agda rename to src/Algebra/Polynomial/Properties/Ring.agda index c0d139b15d..4670897fba 100644 --- a/src/Algebra/Polynomial/Properties1.agda +++ b/src/Algebra/Polynomial/Properties/Ring.agda @@ -1,14 +1,14 @@ open import Algebra.Bundles using (Magma; Ring) -module Algebra.Polynomial.Properties1 +module Algebra.Polynomial.Properties.Ring {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) where open import Algebra.Bundles.Raw import Algebra.Definitions as Def -import Algebra.Polynomial.Poly.Properties1 R as Poly -open import Algebra.Polynomial.Base1 R +import Algebra.Polynomial.Poly.Properties.Ring R as Poly +open import Algebra.Polynomial.Base.Ring R using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ ; zero; one; -_; refl; sym; trans) open import Algebra.Properties.AbelianGroup diff --git a/src/Algebra/Polynomial/Properties.agda b/src/Algebra/Polynomial/Properties/Semiring.agda similarity index 97% rename from src/Algebra/Polynomial/Properties.agda rename to src/Algebra/Polynomial/Properties/Semiring.agda index 3b84fe5220..2785f88d2c 100644 --- a/src/Algebra/Polynomial/Properties.agda +++ b/src/Algebra/Polynomial/Properties/Semiring.agda @@ -1,14 +1,14 @@ open import Algebra.Bundles using (Magma; Semiring) -module Algebra.Polynomial.Properties +module Algebra.Polynomial.Properties.Semiring {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where open import Algebra.Bundles.Raw import Algebra.Definitions as Def -import Algebra.Polynomial.Poly.Properties SR as Poly -open import Algebra.Polynomial.Base SR +import Algebra.Polynomial.Poly.Properties.Semiring SR as Poly +open import Algebra.Polynomial.Base.Semiring SR using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ ; zero; one; refl; sym; trans) open import Algebra.Structures diff --git a/src/Algebra/Properties/Group.agda b/src/Algebra/Properties/Group.agda index 54c5d469fe..02f011096d 100644 --- a/src/Algebra/Properties/Group.agda +++ b/src/Algebra/Properties/Group.agda @@ -136,8 +136,7 @@ x≈ε⇒x⁻¹≈ε {x} x≈ε = begin x⁻¹≈ε⇒x≈ε : ∀ {x} → x ⁻¹ ≈ ε → x ≈ ε x⁻¹≈ε⇒x≈ε {x} x⁻¹≈ε = begin x ≈⟨ ⁻¹-involutive x ⟨ - x ⁻¹ ⁻¹ ≈⟨ ⁻¹-cong x⁻¹≈ε ⟩ - ε ⁻¹ ≈⟨ ε⁻¹≈ε ⟩ + x ⁻¹ ⁻¹ ≈⟨ x≈ε⇒x⁻¹≈ε x⁻¹≈ε ⟩ ε ∎ ⁻¹-injective : Injective _≈_ _≈_ _⁻¹ diff --git a/src/Data/Nat/Properties.agda b/src/Data/Nat/Properties.agda index 6102400d68..8fb91e93f5 100644 --- a/src/Data/Nat/Properties.agda +++ b/src/Data/Nat/Properties.agda @@ -668,6 +668,10 @@ m+n≡0⇒m≡0 zero eq = refl m+n≡0⇒n≡0 : ∀ m {n} → m + n ≡ 0 → n ≡ 0 m+n≡0⇒n≡0 m {n} m+n≡0 = m+n≡0⇒m≡0 n (trans (+-comm n m) (m+n≡0)) +n+1≡suc[n+0] : (n + 1) ≡ suc (n + 0) +n+1≡suc[n+0] {0} = refl +n+1≡suc[n+0] {suc n} = cong suc n+1≡suc[n+0] + ------------------------------------------------------------------------ -- Properties of _+_ and _≤_/_<_ From 5e0c7b603ea90768ba4d36cfa74908be617968bf Mon Sep 17 00:00:00 2001 From: Sam Park Date: Fri, 28 Aug 2026 19:47:34 +0900 Subject: [PATCH 4/8] Add list-based polynomial modules --- .../Polynomial/Morphism/Morphism2.agda | 331 ++++++++ .../Poly/Base/CommutativeRing2.agda | 11 + src/Algebra/Polynomial/Poly/Base/Ring2.agda | 18 + .../Polynomial/Poly/Base/Semiring2.agda | 129 +++ .../Poly/Properties/CommutativeRing2.agda | 171 ++++ .../Polynomial/Poly/Properties/Ring2.agda | 136 ++++ .../Polynomial/Poly/Properties/Semiring2.agda | 756 ++++++++++++++++++ 7 files changed, 1552 insertions(+) create mode 100644 src/Algebra/Polynomial/Morphism/Morphism2.agda create mode 100644 src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda create mode 100644 src/Algebra/Polynomial/Poly/Base/Ring2.agda create mode 100644 src/Algebra/Polynomial/Poly/Base/Semiring2.agda create mode 100644 src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda create mode 100644 src/Algebra/Polynomial/Poly/Properties/Ring2.agda create mode 100644 src/Algebra/Polynomial/Poly/Properties/Semiring2.agda diff --git a/src/Algebra/Polynomial/Morphism/Morphism2.agda b/src/Algebra/Polynomial/Morphism/Morphism2.agda new file mode 100644 index 0000000000..ef404a8fb3 --- /dev/null +++ b/src/Algebra/Polynomial/Morphism/Morphism2.agda @@ -0,0 +1,331 @@ +-- Polynomial Morphisms +-- open import Algebra.Bundles using (CommutativeRing) +open import Algebra.Bundles + renaming (CommutativeRing to CR) + +module Algebra.Polynomial.Morphism.Morphism2 + {ℓ₁ ℓ₂} + (R : CR ℓ₁ ℓ₂) + where + +import Algebra.Definitions as Def +open import Algebra.Morphism.Bundles + renaming (RingHomomorphism to RingHomo; MonoidHomomorphism to MonHomo) +open import Algebra.Morphism.Structures + renaming (IsRingHomomorphism to IsRingHomo; IsMagmaHomomorphism to IsMagmaHomo) +open import Algebra.Polynomial.Poly.Base.CommutativeRing2 R + using (Poly; []≈ ; ≈[]; cons ; consˡ ; consʳ; IsZero⇒p≈[]; + p≈[]⇒IsZero; a·p≈a∷[]*p ; *-distrib-shift; shiftp≈x*p) + renaming ( refl to P-refl ; sym to P-sym ; _·_ to _·P_ + ; _+_ to _+P_ ; _*_ to _*P_; _≈_ to _≈P_; -_ to -P_) +open import Algebra.Polynomial.Poly.Properties.CommutativeRing2 R as P + using (+-*-commutativeRing; *-zeroˡ ; *-zeroʳ) + renaming ( rawRing to PolyrawRing; *-comm to P*-comm + ; +-identityˡ to +-P-identityˡ ; +-identityʳ to +-P-identityʳ + ; zeroˡ to P-zeroˡ; zeroʳ to P-zeroʳ) +open import Algebra.Properties.Group +open import Algebra.Properties.Ring using (-‿distribʳ-*) +open import Data.Product.Base using (proj₁ ; proj₂) +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All +import Level as L +import Relation.Binary.Morphism.Structures as S + renaming (IsRelHomomorphism to IsRelHomo) + +open RingHomo + renaming ( +-isMagmaHomomorphism to +-isMagmaHomo + ; +-monoidHomomorphism to +-monoidHom + ; isRelHomomorphism to isRelHomo + ; *-isMagmaHomomorphism to *-isMagmaHomo) + hiding (⟦_⟧) + +module A = CR R +open A + hiding (distrib) + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_ + ; 0# to A0# + ; 1# to A1#) + +private + variable + a b : A + p : Poly + q : Poly + +module PolynomialRingMorphism + {ℓ₃ ℓ₄} + (B : CR ℓ₃ ℓ₄) + (f : RingHomo {ℓ₁} {ℓ₂} (CR.rawRing R) (CR.rawRing B)) + where + + module B = CR B + open B + using (distrib) + renaming + (_≈_ to _≈B_ + ; _+_ to _+B_ + ; _*_ to _*B_ + ; -_ to -B_ + ; setoid to B-Set) + using (0#; 1#) + + open import Relation.Binary.Reasoning.Setoid B-Set + open RingHomo f using (⟦_⟧) + + open Def {A = B.Carrier} (_≈B_) + +-- evaluate the polynomial given an element β ∈ B + eval : CR.Carrier B → Poly → CR.Carrier B + eval β [] = 0# + eval β (a ∷ p) = ⟦ a ⟧ +B (β *B eval β p) + + eval-equiv : (β : CR.Carrier B) → (p : Poly) → eval β p ≈B (eval β p) + eval-equiv β [] = B.refl + eval-equiv β (a ∷ p) = B.+-congˡ (B.*-congˡ (eval-equiv β p)) + + eval-cong : ∀ {p : Poly} → ∀ {q : Poly} → (β : CR.Carrier B) + → p ≈P q → (eval β p) ≈B (eval β q) + eval-cong {p = []} {q = []} β p≈q = B.refl + eval-cong {p = []} {q = b ∷ q} β p≈q = begin + eval β [] + ≈⟨ B.zeroʳ β ⟨ + β *B 0# + ≈⟨ B.+-identityˡ (β *B eval β []) ⟨ + 0# +B β *B eval β [] + ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟨ + ⟦ A0# ⟧ +B β *B eval β [] + ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {p = []} {q = q} β + (P-sym (IsZero⇒p≈[] (tail (p≈[]⇒IsZero (P-sym p≈q))))))) ⟩ + ⟦ A0# ⟧ +B β *B eval β q + ≈⟨ B.+-congʳ (S.IsRelHomo.cong + (isRelHomo f) (head (p≈[]⇒IsZero (P-sym p≈q)))) ⟨ + eval β (b ∷ q) + ∎ + eval-cong {p = a ∷ p} {[]} β p≈q = begin + eval β (a ∷ p) + ≈⟨ B.+-congʳ (S.IsRelHomo.cong + (isRelHomo f) (head (p≈[]⇒IsZero p≈q))) ⟩ + ⟦ A0# ⟧ +B β *B eval β p + ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {p = p} {q = []} β + (IsZero⇒p≈[] (tail (p≈[]⇒IsZero p≈q))) )) ⟩ + ⟦ A0# ⟧ +B β *B eval β [] + ≈⟨ B.+-congʳ (MonHomo.ε-homo(+-monoidHom f)) ⟩ + 0# +B β *B eval β [] + ≈⟨ B.+-congˡ (B.zeroʳ β) ⟩ + 0# +B 0# + ≈⟨ B.+-identityʳ 0# ⟩ + eval β [] + ∎ + eval-cong {p = a ∷ p} {b ∷ q} β (cons a≈b p≈q) + = B.+-cong (S.IsRelHomo.cong (isRelHomo f) a≈b) + (B.*-congˡ (eval-cong β p≈q )) + + eval-+-homomorphic : (β : CR.Carrier B) → (p : Poly) → (q : Poly) → + eval β (p +P q) ≈B eval β p +B eval β q + eval-+-homomorphic β [] q = begin + eval β ([] +P q) + ≈⟨ eval-cong β (+-P-identityˡ q) ⟩ + eval β q + ≈⟨ B.+-identityˡ (eval β q) ⟨ + eval β [] +B eval β q + ∎ + eval-+-homomorphic β (a ∷ p) [] = B.sym (B.+-identityʳ (eval β (a ∷ p))) + eval-+-homomorphic β (a ∷ p) (b ∷ q) = begin + eval β ((a ∷ p) +P (b ∷ q)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-+-homomorphic β p q)) ⟩ + ⟦ a +A b ⟧ +B (β *B (eval β p +B eval β q)) + ≈⟨ B.+-congˡ (proj₁ distrib β (eval β p) (eval β q)) ⟩ + ⟦ a +A b ⟧ +B (β *B eval β p +B β *B eval β q) + ≈⟨ B.+-congʳ (IsMagmaHomo.homo (+-isMagmaHomo f) a b) ⟩ + ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval β p +B β *B eval β q) + ≈⟨ B.+-assoc (⟦ a ⟧ +B ⟦ b ⟧) (β *B eval β p) (β *B eval β q) ⟨ + ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval β p +B β *B eval β q + ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval β p)) ⟩ + ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval β p) +B β *B eval β q + ≈⟨ B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval β p) (β *B eval β q) ⟩ + ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval β p +B (β *B eval β q)) + ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval β p) ⟦ b ⟧))) ⟨ + ⟦ a ⟧ +B ((β *B eval β p) +B ⟦ b ⟧ +B (β *B eval β q)) + ≈⟨ B.+-congˡ (B.+-assoc (β *B eval β p) ⟦ b ⟧ (β *B eval β q)) ⟩ + ⟦ a ⟧ +B (β *B eval β p +B eval β (b ∷ q)) + ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval β p) (eval β (b ∷ q)) ⟨ + ⟦ a ⟧ +B β *B eval β p +B eval β (b ∷ q) + ∎ + + eval-1#-homomorphic : (β : CR.Carrier B) → eval β (A1# ∷ []) ≈B 1# + eval-1#-homomorphic β = begin + eval β (A1# ∷ []) ≈⟨ B.+-cong (RingHomo.1#-homo f) (B.zeroʳ β) ⟩ + 1# +B 0# ≈⟨ B.+-identityʳ 1# ⟩ + 1# ∎ + + eval-scale : (β : CR.Carrier B) → (a : A) → (p : Poly) → + eval β (a ·P p) ≈B eval β (a ∷ []) *B (eval β p) + eval-scale β a [] = begin + 0# ≈⟨ B.zeroʳ (⟦ a ⟧ +B β *B 0#) ⟨ + (⟦ a ⟧ +B β *B 0#) *B 0# ∎ + eval-scale β a (b ∷ p) = begin + ⟦ a *A b ⟧ +B β *B eval β (a ·P p) + ≈⟨ B.+-congʳ (IsMagmaHomo.homo (*-isMagmaHomo f) a b) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B eval β (a ·P p) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-scale β a p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B (eval β (a ∷ []) *B (eval β p)) + ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-congˡ (B.zeroʳ β)))) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B ((⟦ a ⟧ +B 0#) *B (eval β p)) + ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧))) ⟩ + ⟦ a ⟧ *B ⟦ b ⟧ +B β *B ((⟦ a ⟧ *B eval β p)) + ≈⟨ B.+-congˡ (B.*-assoc β ⟦ a ⟧ (eval β p)) ⟨ + ⟦ a ⟧ *B ⟦ b ⟧ +B (β *B (⟦ a ⟧) *B (eval β p)) + ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm β ⟦ a ⟧)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B (⟦ a ⟧ *B β) *B eval β p + ≈⟨ B.+-congˡ (B.*-assoc ⟦ a ⟧ β (eval β p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B ⟦ a ⟧ *B (β *B eval β p) + ≈⟨ proj₁ distrib ⟦ a ⟧ ⟦ b ⟧ ( β *B eval β p) ⟨ + (⟦ a ⟧) *B (⟦ b ⟧ +B β *B eval β p) + ≈⟨ B.*-congʳ (B.+-identityʳ ⟦ a ⟧) ⟨ + (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval β p) + ≈⟨ B.*-congʳ (B.+-congˡ (B.zeroʳ β)) ⟨ + (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval β p) + ∎ + + eval-shift : (β : CR.Carrier B) → (p : Poly) → eval β (A0# ∷ p) ≈B β *B eval β p + eval-shift β p = begin + ⟦ A0# ⟧ +B β *B eval β p + ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟩ + 0# +B β *B eval β p + ≈⟨ B.+-identityˡ (β *B eval β p) ⟩ + β *B eval β p + ∎ + + eval-*-homomorphic : (β : CR.Carrier B) → (p q : Poly) + → eval β (p *P q) ≈B eval β p *B eval β q + eval-*-homomorphic β [] q = begin + eval β ([] *P q) ≈⟨ eval-cong β (P-zeroˡ q) ⟩ + eval β [] ≈⟨ B.zeroˡ (eval β q) ⟨ + eval β [] *B eval β q ∎ + eval-*-homomorphic β (a ∷ p) q = begin + eval β ((a ∷ p) *P q) + ≈⟨ eval-cong {p = (a ∷ p) *P q} β P-refl ⟩ + eval β (a ·P q +P p *P (A0# ∷ q)) + ≈⟨ eval-+-homomorphic β (a ·P q) (p *P (A0# ∷ q)) ⟩ + eval β (a ·P q) +B eval β (p *P (A0# ∷ q)) + ≈⟨ B.+-cong (eval-scale β a q) (eval-*-homomorphic β p (A0# ∷ q)) ⟩ + ((eval β (a ∷ []) *B eval β q) +B (eval β p *B eval β (A0# ∷ q))) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-shift β q)) ⟩ + (eval β (a ∷ []) *B eval β q) +B (eval β p *B (β *B eval β q)) + ≈⟨ B.+-congˡ step ⟩ + (eval β (a ∷ []) *B eval β q) +B ((β *B eval β p) *B eval β q) + ≈⟨ proj₂ distrib (eval β q) (eval β (a ∷ [])) (β *B eval β p) ⟨ + ((eval β (a ∷ []) +B β *B eval β p) *B eval β q) + ≈⟨ B.*-congʳ ((B.+-congʳ (B.trans (B.+-congˡ + (B.zeroʳ β)) (B.+-identityʳ ⟦ a ⟧)))) ⟩ + (eval β (a ∷ p) *B eval β q) + ∎ + where + step : eval β p *B (β *B eval β q) ≈B (β *B eval β p) *B eval β q + step = begin + eval β p *B (β *B eval β q) + ≈⟨ B.*-assoc (eval β p) β (eval β q) ⟨ + (eval β p *B β) *B eval β q + ≈⟨ B.*-congʳ (B.*-comm (eval β p) β) ⟩ + (β *B eval β p) *B eval β q + ∎ + + eval-inverse-homomorphic : (β : CR.Carrier B) → (p : Poly) → + eval β (-P p) ≈B -B (eval β p) + eval-inverse-homomorphic β [] = B.sym (ε⁻¹≈ε B.+-group) + eval-inverse-homomorphic β (a ∷ p) = begin + eval β (-P (a ∷ p)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-inverse-homomorphic β p)) ⟩ + ⟦ -A a ⟧ +B β *B (-B (eval β p)) + ≈⟨ B.+-congˡ (-‿distribʳ-* (CR.ring B) β (eval β p)) ⟨ + ⟦ -A a ⟧ +B -B (β *B eval β p) + ≈⟨ B.+-congʳ (RingHomo.-‿homo f a) ⟩ + -B ⟦ a ⟧ +B -B (β *B eval β p) + ≈⟨ B.+-comm (-B (β *B eval β p)) (-B ⟦ a ⟧) ⟨ + -B (β *B eval β p) +B -B ⟦ a ⟧ + ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval β p) ⟨ + -B eval β (a ∷ p) + ∎ + + eval-isRingHomomorphism : (β : CR.Carrier B) → IsRingHomo + (CR.rawRing +-*-commutativeRing) (CR.rawRing B) (eval β) + eval-isRingHomomorphism β = record + { isSemiringHomomorphism = record + { isNearSemiringHomomorphism = record + { +-isMonoidHomomorphism = record + { isMagmaHomomorphism = record + { isRelHomomorphism = record + { cong = eval-cong β } + ; homo = eval-+-homomorphic β + } + ; ε-homo = B.refl + } + ; *-homo = eval-*-homomorphic β + } + ; 1#-homo = eval-1#-homomorphic β + } + ; -‿homo = eval-inverse-homomorphic β + } + +---------------- Universal Property of Polynomial Rings ---------------- + + x-mapsto-β : (β : CR.Carrier B) → eval β (A0# ∷ A1# ∷ []) ≈B β + x-mapsto-β β = begin + ⟦ A0# ⟧ +B β *B (⟦ A1# ⟧ +B β *B 0#) + ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟩ + 0# +B (β *B (⟦ A1# ⟧ +B β *B 0#)) + ≈⟨ B.+-identityˡ (β *B (⟦ A1# ⟧ +B β *B 0#))⟩ + β *B (⟦ A1# ⟧ +B β *B 0#) + ≈⟨ B.*-congˡ (B.+-cong (RingHomo.1#-homo f) (B.zeroʳ β)) ⟩ + β *B (1# +B 0#) + ≈⟨ B.*-congˡ (B.+-identityʳ 1#) ⟩ + β *B 1# + ≈⟨ B.*-identityʳ β ⟩ + β + ∎ + +-- define a canonical inclusion homomorphism from R to R[x]) + ı : A.Carrier → Poly + ı r = r ∷ [] + + eval-comm : (β : CR.Carrier B) → ∀ (r : A.Carrier) → ⟦ r ⟧ ≈B eval β (ı r) + eval-comm β r = begin + ⟦ r ⟧ + ≈⟨ B.+-identityʳ ⟦ r ⟧ ⟨ + ⟦ r ⟧ +B 0# + ≈⟨ B.+-congˡ (B.zeroʳ β) ⟨ + eval β (r ∷ []) + ∎ + + eval-unique : (β : CR.Carrier B) → + ∀ (ϕ : RingHomo {ℓ₁} {ℓ₁ L.⊔ ℓ₂} (PolyrawRing) (CR.rawRing B)) → + (∀ (r : A.Carrier) → RingHomo.⟦ ϕ ⟧ (ı r) ≈B (⟦ r ⟧)) → + RingHomo.⟦ ϕ ⟧ (A0# ∷ A1# ∷ []) ≈B β → + ∀ (p : Poly) → RingHomo.⟦ ϕ ⟧ p ≈B eval β p + eval-unique β ϕ _ _ [] = MonHomo.ε-homo (+-monoidHom ϕ) + eval-unique β ϕ ϕ-comm x-mapsto-β (a ∷ p) = begin + RingHomo.⟦ ϕ ⟧ (a ∷ p) + ≈⟨ S.IsRelHomo.cong (isRelHomo ϕ) + (cons ((A.+-identityʳ a)) (P.+-identityˡ p)) ⟨ + RingHomo.⟦ ϕ ⟧ ((a ∷ []) +P (A0# ∷ p)) + ≈⟨ IsMagmaHomo.homo (+-isMagmaHomo ϕ) + (a ∷ []) (A0# ∷ p) ⟩ + RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ (A0# ∷ p) + ≈⟨ B.+-congˡ (S.IsRelHomo.cong (isRelHomo ϕ) (shiftp≈x*p p)) ⟩ + RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ ((A0# ∷ A1# ∷ []) *P p) + ≈⟨ B.+-congˡ (IsMagmaHomo.homo (*-isMagmaHomo ϕ) + (A0# ∷ A1# ∷ []) p) ⟩ + RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ + (A0# ∷ A1# ∷ []) *B (RingHomo.⟦ ϕ ⟧ p) + ≈⟨ B.+-congˡ (B.*-cong x-mapsto-β + (eval-unique β ϕ ϕ-comm x-mapsto-β p)) ⟩ + RingHomo.⟦ ϕ ⟧ (ı a) +B β *B eval β p + ≈⟨ B.+-congʳ (ϕ-comm a) ⟩ + eval β (a ∷ p) + ∎ + diff --git a/src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda b/src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda new file mode 100644 index 0000000000..ecff4c578e --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda @@ -0,0 +1,11 @@ +open import Algebra.Bundles using (CommutativeRing) + +module Algebra.Polynomial.Poly.Base.CommutativeRing2 + {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Properties.Ring2 (CommutativeRing.ring R) public +module CR = CommutativeRing R + + + diff --git a/src/Algebra/Polynomial/Poly/Base/Ring2.agda b/src/Algebra/Polynomial/Poly/Base/Ring2.agda new file mode 100644 index 0000000000..07939515b9 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Base/Ring2.agda @@ -0,0 +1,18 @@ +open import Algebra.Bundles using (Ring) + +module Algebra.Polynomial.Poly.Base.Ring2 + {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) + where + +open import Algebra.Polynomial.Poly.Properties.Semiring2 (Ring.semiring R) public +open import Data.List.Base as List using (List; []; _∷_) + +module R = Ring R + +private + variable + p : Poly + +-- Polynomial subtraction +-_ : Poly → Poly +- p = List.map R.-_ p diff --git a/src/Algebra/Polynomial/Poly/Base/Semiring2.agda b/src/Algebra/Polynomial/Poly/Base/Semiring2.agda new file mode 100644 index 0000000000..8b673a8bd8 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Base/Semiring2.agda @@ -0,0 +1,129 @@ +open import Algebra.Bundles using (Semiring) + +module Algebra.Polynomial.Poly.Base.Semiring2 + {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) + where + +open import Agda.Builtin.List using (List; []; _∷_) +open import Data.List.Base as List +open import Data.List.Relation.Unary.All using (All ; [] ; _∷_) +open import Data.Nat.Base as ℕ using (ℕ; suc) +import Level as L + +module SR = Semiring SR +open SR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ) + using (0#; 1#) + +infixl 7 _*_ +infix 7 _·_ +infixl 6 _+_ +infix 4 _≈_ + + +private + variable + a b : A + + +-- Polynomial is represented as a list +-- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∶ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ +-- [] represents the zero polynomial 0 + +Poly : Set ℓ₁ +Poly = List A + +private + variable + p : Poly + q : Poly + r : Poly + +-- Scaling a polynomial by a +_·_ : A → Poly → Poly +a · p = List.map (a *A_) p + +-- Multiply a polynomial by x +shift : Poly → Poly +shift p = 0# ∷ p + +-- Multiply a polynomial by xⁿ +shift-by-n : (n : ℕ) → Poly → Poly +shift-by-n 0 p = p +shift-by-n (suc n) p = 0# ∷ shift-by-n n p + +IsZero : Poly → Set (ℓ₁ L.⊔ ℓ₂) +IsZero = All (_≈A 0#) + +-- The representation of a polynomial is not unique +-- because we allow coefficients to be zero +-- We define an equivalence relation which takes this into account + +data _≈_ : Poly → Poly → Set (ℓ₁ L.⊔ ℓ₂) where + []≈ : (q : Poly) → IsZero q → [] ≈ q + ≈[] : (p : Poly) → IsZero p → p ≈ [] + cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) + +-- Properties of Polynomial Equality + +zeros-unique : IsZero p → IsZero q → p ≈ q +zeros-unique [] [] = []≈ [] [] +zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) +zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = cons (SR.trans a≈0 (SR.sym b≈0)) (zeros-unique p≈0 q≈0) + +IsZero-cong : IsZero p → p ≈ q → IsZero q +IsZero-cong [] ([]≈ q q≈0) = q≈0 +IsZero-cong [] (≈[] p p≈0) = p≈0 +IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] +IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) + = (SR.trans (SR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q + +-- _≈_ is an equivalence relation + +refl : p ≈ p +refl {p = []} = []≈ [] [] +refl {p = a ∷ p} = cons SR.refl refl + +sym : p ≈ q → q ≈ p +sym ([]≈ q q≈0) = ≈[] q q≈0 +sym (≈[] p p≈0) = []≈ p p≈0 +sym (cons a≈b p≈q) = cons (SR.sym a≈b) (sym p≈q) + +trans : p ≈ q → q ≈ r → p ≈ r +trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) +trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) +trans (cons a≈b p≈q) (≈[] q q≈0) + = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) +trans (cons a≈b p≈q) (cons b≈c q≈r) + = cons (SR.trans a≈b b≈c) (trans p≈q q≈r) + +consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) +consˡ a≈b = cons a≈b refl + +consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) +consʳ = cons SR.refl + +---------------------------------------------------------------- +-- Operations + +-- Addition +_+_ : Poly → Poly → Poly +[] + [] = [] +[] + (a ∷ p) = a ∷ p +(a ∷ p) + [] = a ∷ p +(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) + +-- Multiplication +_*_ : Poly → Poly → Poly +_*_ [] p = [] +_*_ (a ∷ p) q = (a · q) + (p * (0# ∷ q)) + + + diff --git a/src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda b/src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda new file mode 100644 index 0000000000..d52acf2408 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda @@ -0,0 +1,171 @@ +open import Algebra.Bundles using (CommutativeRing) + +module Algebra.Polynomial.Poly.Properties.CommutativeRing2 + {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) + where + +import Algebra.Definitions as Def +open import Algebra.Polynomial.Poly.Base.CommutativeRing2 R as P public + using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; module CR) +open import Algebra.Polynomial.Poly.Properties.Ring2 (CommutativeRing.ring R) public hiding ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ) +open import Algebra.Properties.Ring +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsGroup; IsAbelianGroup; IsCommutativeMonoid; IsSemiring + ; IsRing; IsCommutativeSemiring; IsCommutativeRing ) +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All using (All ; []; _∷_) +open import Data.Product.Base using (_,_) + +open ≈-Reasoning + +open CR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +open Def _≈_ + +private + variable + + a b : A + p : Poly + q : Poly + +---------------------------------------------------------------------------------- +-- Multiplication of polynomials is commutative + +*-comm : (p : Poly) → (q : Poly) → p * q ≈ q * p +*-comm [] q = begin + [] * (q) + ≈⟨ p≈[]⇒p*q≈[] q refl ⟩ + [] + ≈⟨ p≈[]⇒q*p≈[] q refl ⟨ + q * [] ∎ +*-comm (a ∷ p) [] = begin + (a ∷ p) * [] + ≈⟨ p≈[]⇒q*p≈[] (a ∷ p) refl ⟩ + [] + ≈⟨ p≈[]⇒p*q≈[] (a ∷ p) refl ⟨ + [] * (a ∷ p) ∎ +*-comm (a ∷ p) (b ∷ q) = begin + (a ∷ p) * (b ∷ q) + ≈⟨ refl ⟩ + a · (b ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congˡ (*-comm-lem (a *A b) a) ⟩ + (a *A b ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congˡ (consˡ (CR.+-congʳ (CR.*-comm a b))) ⟩ + (b *A a ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) + ≈⟨ +-congʳ (step1 (*-comm p (b ∷ q)) (*-comm p q)) ⟩ + (b *A a ∷ []) + a · (0# ∷ q) + ((b · (0# ∷ p)) + (0# ∷ 0# ∷ p * q)) + ≈⟨ step2 ⟩ + ((b *A a ∷ []) + b · (0# ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ p * q)) + ≈⟨ step3 ⟩ + (b · (a ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))) + ≈⟨ +-congʳ (step4 (*-comm (a ∷ p) q)) ⟨ + (b · (a ∷ p) + q * (0# ∷ a ∷ p)) + ≈⟨ refl ⟩ + (b ∷ q) * (a ∷ p) + ∎ + where + *-comm-lem : {p : Poly} → (a b : A) → + a ∷ (b · p) ≈ (a ∷ []) + (b · (0# ∷ p)) + *-comm-lem {p = []} a b + = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ b)) (CR.+-identityʳ a))) + *-comm-lem {p = a ∷ p} b c + = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ c)) (CR.+-identityʳ b))) + + step1 : p * (b ∷ q) ≈ (b ∷ q) * p + → p * q ≈ q * p + → p * (0# ∷ b ∷ q) ≈ b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) + step1 p*b∷q≈b∷q*p p*q≈q*p = begin + p * (0# ∷ b ∷ q) + ≈⟨ *-distrib-shift p (b ∷ q) ⟩ + 0# ∷ (p * (b ∷ q)) + ≈⟨ consʳ p*b∷q≈b∷q*p ⟩ + 0# ∷ ((b ∷ q) * p) + ≈⟨ refl ⟩ + 0# ∷ (b · p + q * (0# ∷ p)) + ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ + (0# ∷ (b · p)) + (0# ∷ (q * (0# ∷ p))) + ≈⟨ +-congˡ {r = (0# ∷ (q * (0# ∷ p)))} (·-distrib-shift b p) ⟨ + (b · (0# ∷ p)) + (0# ∷ (q * (0# ∷ p))) + ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (*-distrib-shift q p)) ⟩ + b · (0# ∷ p) + (0# ∷ 0# ∷ (q * p)) + ≈⟨ consʳ (+-congʳ (consʳ (p*q≈q*p))) ⟨ + b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) + ∎ + + step2 + = middleFour (b *A a ∷ []) (a · (0# ∷ q)) + (b · (0# ∷ p)) (0# ∷ 0# ∷ (p * q)) + + step3 + = +-congˡ {r = a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))} + (sym (*-comm-lem {p = p} (b *A a) b)) + + step4 : (a ∷ p) * q ≈ q * (a ∷ p) + → q * (0# ∷ a ∷ p) ≈ a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) + step4 a∷p*q≈q*a∷p = begin + q * (0# ∷ a ∷ p) + ≈⟨ *-distrib-shift q (a ∷ p) ⟩ + 0# ∷ (q * (a ∷ p)) + ≈⟨ consʳ a∷p*q≈q*a∷p ⟨ + 0# ∷ ((a ∷ p) * q) + ≈⟨ refl ⟩ + 0# ∷ (a · q + p * (0# ∷ q)) + ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ + (0# ∷ (a · q)) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ +-congˡ {r = (0# ∷ (p * (0# ∷ q)))} (·-distrib-shift a q) ⟨ + a · (0# ∷ q) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ +-congʳ {p = a · (0# ∷ q)} (consʳ (*-distrib-shift p q))⟩ + a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) + ∎ + + +------------------------------------------------------------------ +-- Multiplicative structure + +*-isCommutativeMonoid : IsCommutativeMonoid _≈_ _*_ (1# ∷ []) +*-isCommutativeMonoid = record + { isMonoid = *-isMonoid + ; comm = *-comm + } + ++-*-isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ [] (1# ∷ []) ++-*-isCommutativeSemiring = record + { isSemiring = +-*-isSemiring + ; *-comm = *-comm + } + ++-*-isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ [] (1# ∷ []) ++-*-isCommutativeRing = record + { isRing = +-*-isRing + ; *-comm = *-comm + } + +--------------------------------------------------------------- +-- Multiplicative bundles + +*-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ +*-commutativeMonoid = record + { isCommutativeMonoid = *-isCommutativeMonoid + } + ++-*-commutativeSemiring : Algebra.Bundles.CommutativeSemiring _ _ ++-*-commutativeSemiring = record + { isCommutativeSemiring = +-*-isCommutativeSemiring + } + ++-*-commutativeRing : Algebra.Bundles.CommutativeRing _ _ ++-*-commutativeRing = record + { isCommutativeRing = +-*-isCommutativeRing + } + diff --git a/src/Algebra/Polynomial/Poly/Properties/Ring2.agda b/src/Algebra/Polynomial/Poly/Properties/Ring2.agda new file mode 100644 index 0000000000..008c80852d --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Properties/Ring2.agda @@ -0,0 +1,136 @@ +open import Algebra.Bundles using (Ring) + +module Algebra.Polynomial.Poly.Properties.Ring2 + {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) + where + +open import Algebra.Bundles.Raw +import Algebra.Definitions as Def +open import Algebra.Polynomial.Poly.Base.Ring2 R as P public + using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; module R) +open import Algebra.Polynomial.Poly.Properties.Semiring2 (Ring.semiring R) public + hiding ( Poly; _+_ ; _*_ ; _·_ ; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ ) +open import Algebra.Properties.Ring +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsGroup; IsAbelianGroup; IsSemiring; IsCommutativeMonoid + ; IsRing) +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All using (All ; []; _∷_) +open import Data.Product.Base using (_,_) +import Level as L + +open Def _≈_ + +open R + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ; -_ to -A_) + using (0#; 1#) + +private + variable + a b : A + p : Poly + q : Poly + +---------------------------------------------------------------------- +-- Additive inverse + +[-p]+pIsZero : {p : Poly} → IsZero ((- p) + p) +[-p]+pIsZero {p = []} = [] +[-p]+pIsZero {p = a ∷ p} = R.-‿inverseˡ a ∷ [-p]+pIsZero + +p+[-p]IsZero : {p : Poly} → IsZero (p + (- p)) +p+[-p]IsZero {p = []} = [] +p+[-p]IsZero {p = a ∷ p} = R.-‿inverseʳ a ∷ p+[-p]IsZero + ++-inverseˡ : (p : Poly) → (- p) + p ≈ [] ++-inverseˡ [] = refl ++-inverseˡ (a ∷ p) + = ≈[] ((- (a ∷ p)) + (a ∷ p)) (R.-‿inverseˡ a ∷ [-p]+pIsZero) + ++-inverseʳ : (p : Poly) → p + (- p) ≈ [] ++-inverseʳ [] = refl ++-inverseʳ (a ∷ p) + = ≈[] ((a ∷ p) + (- (a ∷ p))) ((R.-‿inverseʳ a) ∷ p+[-p]IsZero) + +-⁺ : IsZero p → IsZero (- p) +-⁺ [] = [] +-⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε R a≈0 ∷ (-⁺ p≈0) + +-⁻ : IsZero (- p) → IsZero p +-⁻ {p = []} -p≈0 = -p≈0 +-⁻ {p = a ∷ p} (-a≈0 ∷ -p≈0) = x⁻¹≈ε⇒x≈ε R -a≈0 ∷ (-⁻ -p≈0) + +-‿cong : p ≈ q → - p ≈ - q +-‿cong ([]≈ q q≈0) = []≈ (- q) (-⁺ q≈0) +-‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) +-‿cong (cons a≈b p≈q) = cons (R.-‿cong a≈b) (-‿cong p≈q) + +-------------------------------------------------------------- +-- Algebraic properties of addition + ++-inverse : Inverse [] -_ _+_ ++-inverse = +-inverseˡ , +-inverseʳ + +--------------------------------------------------------------- +-- Additive structures + ++-isGroup : IsGroup _≈_ _+_ [] -_ ++-isGroup = record + { isMonoid = +-isMonoid + ; inverse = +-inverse + ; ⁻¹-cong = -‿cong + } + ++-isAbelianGroup : IsAbelianGroup _≈_ _+_ [] -_ ++-isAbelianGroup = record + { isGroup = +-isGroup + ; comm = +-comm + } + +--------------------------------------------------------------- +-- Additive bundles + +rawRing : Algebra.Bundles.Raw.RawRing _ _ +rawRing = record + { Carrier = Poly + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; -_ = -_ + ; 0# = [] + ; 1# = 1# ∷ [] + } + ++-abelianGroup : Algebra.Bundles.AbelianGroup _ _ ++-abelianGroup = record + { isAbelianGroup = +-isAbelianGroup + } + +------------------------------------------------------------------ +-- Multiplicative structure + ++-*-isRing : IsRing _≈_ _+_ _*_ -_ [] (1# ∷ []) ++-*-isRing = record + { +-isAbelianGroup = +-isAbelianGroup + ; *-cong = *-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + +--------------------------------------------------------------- +-- Multiplicative bundles + ++-*-ring : Algebra.Bundles.Ring _ _ ++-*-ring = record + { isRing = +-*-isRing + } + diff --git a/src/Algebra/Polynomial/Poly/Properties/Semiring2.agda b/src/Algebra/Polynomial/Poly/Properties/Semiring2.agda new file mode 100644 index 0000000000..baf3048901 --- /dev/null +++ b/src/Algebra/Polynomial/Poly/Properties/Semiring2.agda @@ -0,0 +1,756 @@ +open import Algebra.Bundles using (Semiring) + +module Algebra.Polynomial.Poly.Properties.Semiring2 + {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) + where + +open import Algebra.Bundles.Raw +import Algebra.Definitions as Def +open import Algebra.Polynomial.Poly.Base.Semiring2 SR as P public + using ( Poly; _+_; _*_; _·_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ) +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsSemiring; IsCommutativeMonoid) +open import Data.Empty using (⊥; ⊥-elim) +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All using (All ; []; _∷_) +open import Data.Maybe.Base as Maybe using (Maybe; just; nothing) +open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) +open import Data.Product using (_,_) +open import Relation.Binary +open import Relation.Binary.PropositionalEquality as Eq + using (_≡_; _≢_; module ≡-Reasoning) +open import Relation.Binary.PropositionalEquality.Core using (cong) +import Relation.Binary.Reasoning.Setoid as SetoidReasoning +open import Relation.Nullary using (Dec; yes; no) + +open Def _≈_ + +module SR = Semiring SR +open SR + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ) + using (0#; 1#) + +private + variable + a b c d : A + p : Poly + q : Poly + r : Poly + s : Poly + +--------------------------------------------------- +-- Equational reasoning for Polynomials + +≈-setoid : Setoid _ _ +≈-setoid = record + { Carrier = Poly + ; _≈_ = _≈_ + ; isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + } + +open module ≈-Reasoning = SetoidReasoning ≈-setoid + +--Properties of zero polynomial + +IsZero⇒p≈[] : IsZero p → p ≈ [] +IsZero⇒p≈[] [] = refl +IsZero⇒p≈[] (a≈0 ∷ p≈0) = ≈[] (_) (a≈0 ∷ p≈0) + +p≈[]⇒IsZero : p ≈ [] → IsZero p +p≈[]⇒IsZero ([]≈ [] q≈0) = q≈0 +p≈[]⇒IsZero (≈[] _ p≈0) = p≈0 + +IsZero⇒IsZero : IsZero p → IsZero q → p ≈ q +IsZero⇒IsZero [] q≈0 = []≈ _ q≈0 +IsZero⇒IsZero (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) +IsZero⇒IsZero (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = cons (SR.trans a≈0 (SR.sym b≈0)) + (trans (IsZero⇒IsZero p≈0 p≈0) (IsZero⇒IsZero p≈0 q≈0)) + +p≈[]⇒0∷p≈0 : p ≈ [] → IsZero (0# ∷ p) +p≈[]⇒0∷p≈0 ([]≈ [] refl) = SR.refl ∷ refl +p≈[]⇒0∷p≈0 (≈[] p p≈[]) = SR.refl ∷ p≈[] + +a∷p≈[]⇒a≈0 : (a ∷ p) ≈ [] → a ≈A 0# +a∷p≈[]⇒a≈0 (≈[] a∷p (a≈0 ∷ p≈0)) = a≈0 + +p≈[]⇒0∷p≈p : p ≈ [] → p ≈ (0# ∷ p) +p≈[]⇒0∷p≈p ([]≈ [] refl) = []≈ (0# ∷ []) (SR.refl ∷ refl) +p≈[]⇒0∷p≈p (≈[] [] p≈[]) = []≈ (0# ∷ []) (SR.refl ∷ p≈[]) +p≈[]⇒0∷p≈p (≈[] (a ∷ p) (a≈0 ∷ p≈0)) + = IsZero⇒IsZero (a≈0 ∷ p≈0) (SR.refl ∷ a≈0 ∷ p≈0) + +p≈[]∧q≈[]⇒p+q≈[] : IsZero p → IsZero q → IsZero (p + q) +p≈[]∧q≈[]⇒p+q≈[] [] [] = [] +p≈[]∧q≈[]⇒p+q≈[] [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +p≈[]∧q≈[]⇒p+q≈[] (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +p≈[]∧q≈[]⇒p+q≈[] (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = SR.trans (SR.+-cong a≈0 b≈0) (SR.+-identityʳ 0#) ∷ p≈[]∧q≈[]⇒p+q≈[] p≈0 q≈0 + +------------------------------------------- +--Properties of polynomial addition + ++-comm : (p : Poly) → (q : Poly) → p + q ≈ q + p ++-comm [] [] = refl ++-comm [] (a ∷ p) = refl ++-comm (a ∷ p) [] = refl ++-comm (a ∷ p) (b ∷ q) = cons (SR.+-comm a b) (+-comm p q) + ++-idʳ : (p : Poly) → (q : Poly) → IsZero q → p + q ≈ p ++-idʳ [] q [] = refl ++-idʳ (a ∷ p) q [] = refl ++-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) ++-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) + = cons (SR.trans (SR.+-congˡ b≈0) (SR.+-identityʳ a)) (+-idʳ p q q≈0) + ++-idˡ : (p : Poly) → (q : Poly) → IsZero p → p + q ≈ q ++-idˡ p q p≈0 = begin + p + q ≈⟨ +-comm p q ⟩ + q + p ≈⟨ +-idʳ q p p≈0 ⟩ + q ∎ + ++-identityˡ : (p : Poly) → [] + p ≈ p ++-identityˡ p = +-idˡ [] p [] + ++-identityʳ : (p : Poly) → p + [] ≈ p ++-identityʳ p = +-idʳ p [] [] + ++-cong : p ≈ q → r ≈ s → p + r ≈ q + s ++-cong {r = r} {s = s} ([]≈ q q≈0) r≈s = begin + [] + r ≈⟨ +-idˡ [] r [] ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-idˡ q s q≈0 ⟨ + q + s ∎ ++-cong {r = r} {s = s} (≈[] p p≈0) r≈s = begin + p + r ≈⟨ +-idˡ p r p≈0 ⟩ + r ≈⟨ r≈s ⟩ + s ≈⟨ +-idˡ [] s [] ⟨ + [] + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ + (b ∷ q) + s ∎ ++-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) (≈[] r r≈0) = begin + (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ + a ∷ p ≈⟨ cons a≈b p≈q ⟩ + b ∷ q ∎ ++-cong (cons a≈b p≈q) (cons c≈d r≈s) + = cons (SR.+-cong a≈b c≈d) (+-cong p≈q r≈s) + ++-congˡ : p ≈ q → p + r ≈ q + r ++-congˡ p≈q = +-cong p≈q refl + ++-congʳ : q ≈ r → p + q ≈ p + r ++-congʳ q≈r = +-cong refl q≈r + ++-assoc : (p : Poly) → (q : Poly) → (r : Poly) → + (p + q) + r ≈ p + (q + r) ++-assoc [] q r = begin + [] + q + r ≈⟨ +-congˡ (+-idˡ [] q []) ⟩ + q + r ≈⟨ +-idˡ [] (q + r) [] ⟨ + [] + (q + r) ∎ ++-assoc (a ∷ p) [] r = +-congʳ (sym (+-idˡ [] r [])) ++-assoc (a ∷ p) (b ∷ q) [] = refl ++-assoc (a ∷ p) (b ∷ q) (c ∷ r) + = cons (SR.+-assoc a b c) (+-assoc p q r) + +middleFour : (p : Poly) → (q : Poly) → (r : Poly) → (w : Poly) → + (p + q) + (r + w) ≈ (p + r) + (q + w) +middleFour p q r w = begin + (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ + (p + q + r) + w ≈⟨ +-congˡ (+-assoc p q r) ⟩ + (p + (q + r)) + w ≈⟨ +-congˡ (+-congʳ (+-comm q r)) ⟩ + (p + (r + q)) + w ≈⟨ +-congˡ (+-assoc p r q) ⟨ + (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ + (p + r) + (q + w) ∎ + +-------------------------------------------------------------------- +-- Properties of polynomial shifting + +*-distrib-shift : (p : Poly) → (q : Poly) → + p * (shift q) ≈ shift (p * q) +*-distrib-shift [] q = begin + [] * (0# ∷ q) + ≈⟨ []≈ [] [] ⟩ + [] + ≈⟨ ≈[] (0# ∷ [] * q) (SR.refl ∷ []) ⟨ + 0# ∷ [] * q ∎ +*-distrib-shift (a ∷ p) q = begin + (a ∷ p) * (0# ∷ q) + ≈⟨ +-congˡ (consˡ (SR.zeroʳ a)) ⟩ + (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) + ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ + (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) + ≈⟨ consˡ (SR.+-identityˡ 0#) ⟩ + 0# ∷ (a · q + p * (0# ∷ q)) + ≈⟨ consʳ refl ⟨ + 0# ∷ ((a ∷ p) * q) + ∎ + +·-distrib-shift : (a : A) → (p : Poly) → a · (shift p) ≈ shift (a · p) +·-distrib-shift a [] = cons (SR.zeroʳ a) (refl) +·-distrib-shift a (b ∷ p) = consˡ (SR.zeroʳ a) + +---------------------------------------------------------------- +-- Properties of polynomial scaling + +a·p≈a∷[]*p : (a : A) → (p : Poly) → a · p ≈ (a ∷ []) * p +a·p≈a∷[]*p a [] = refl +a·p≈a∷[]*p a (b ∷ p) = begin + a · (b ∷ p) ≈⟨ +-idʳ (a · (b ∷ p)) ([] * (0# ∷ b ∷ p)) [] ⟨ + (a ∷ []) * (b ∷ p) ∎ + +1·p≈p : (p : Poly) → 1# · p ≈ p +1·p≈p [] = refl +1·p≈p (a ∷ p) = cons (SR.*-identityˡ a) (1·p≈p p) + +pIsZero⇒a·pIsZero : (a : A) → (p : Poly) → IsZero p → IsZero (a · p) +pIsZero⇒a·pIsZero a p [] = [] +pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) + = (SR.trans (SR.*-congˡ b≈0) (SR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 + +a≈0⇒a·pIsZero : (a : A) → (p : Poly) → a ≈A 0# → IsZero (a · p) +a≈0⇒a·pIsZero a [] a≈0 = [] +a≈0⇒a·pIsZero a (b ∷ p) a≈0 + = SR.trans (SR.*-congʳ a≈0) (SR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) + +·-cong : a ≈A b → p ≈ q → a · p ≈ b · q +·-cong {a = a} {b = b} _ ([]≈ q q≈0) + = sym (≈[] (b · q) (pIsZero⇒a·pIsZero b q q≈0)) +·-cong {a = a} {b = b} _ (≈[] p p≈0) + = sym ([]≈ (a · p) (pIsZero⇒a·pIsZero a p p≈0)) +·-cong {a = a} {b = b} c≈d (cons a≈b p≈q) + = cons (SR.*-cong c≈d a≈b) (·-cong c≈d p≈q) + +·-congˡ : a ≈A b → a · p ≈ b · p +·-congˡ a≈b = ·-cong a≈b refl + +·-congʳ : p ≈ q → a · p ≈ a · q +·-congʳ = ·-cong SR.refl + +·-dist : a · (p + q) ≈ (a · p) + (a · q) +·-dist {p = []} {q = []} = refl +·-dist {p = []} {q = b ∷ q} = refl +·-dist {p = b ∷ p} {q = []} = refl +·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (SR.distribˡ a b c) ·-dist + +·-assoc : a · (b · p) ≈ (a *A b) · p +·-assoc {p = []} = refl +·-assoc {a = a} {b = b} {p = c ∷ p} = cons (SR.sym (SR.*-assoc a b c)) ·-assoc + +a·-cong : p ≈ q → a · p ≈ a · q +a·-cong = ·-cong SR.refl + +·-distrib-+A : (a b : A) → (p : Poly) → (a +A b) · p ≈ a · p + b · p +·-distrib-+A a b [] = refl +·-distrib-+A a b (c ∷ p) = cons (SR.distribʳ c a b) (·-distrib-+A a b p) + +----------------------------------------------------------------- +-- Properties of polynomial multiplication + +pIsZero⇒p*qIsZero : (q : Poly) → IsZero p → IsZero (p * q) +pIsZero⇒p*qIsZero q [] = [] +pIsZero⇒p*qIsZero {p = a ∷ p} q (a≈0 ∷ p≈0) + = p≈[]∧q≈[]⇒p+q≈[] (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0) + +pIsZero⇒q*pIsZero : (q : Poly) → IsZero p → IsZero (q * p) +pIsZero⇒q*pIsZero [] p≈0 = [] +pIsZero⇒q*pIsZero {p = p} (b ∷ q) p≈0 + = p≈[]∧q≈[]⇒p+q≈[] (pIsZero⇒a·pIsZero b p p≈0) + (pIsZero⇒q*pIsZero q (SR.refl ∷ p≈0)) + +p≈[]⇒p*q≈[] : (q : Poly) → p ≈ [] → p * q ≈ [] +p≈[]⇒p*q≈[] q p≈[] + = IsZero⇒p≈[] (pIsZero⇒p*qIsZero q (p≈[]⇒IsZero p≈[])) + +p≈[]⇒q*p≈[] : (q : Poly) → p ≈ [] → q * p ≈ [] +p≈[]⇒q*p≈[] q p≈[] + = IsZero⇒p≈[] (pIsZero⇒q*pIsZero q (p≈[]⇒IsZero p≈[])) + +zeroˡ : (p : Poly) → [] * p ≈ [] +zeroˡ p = refl + +zeroʳ : (p : Poly) → p * [] ≈ [] +zeroʳ [] = refl +zeroʳ (a ∷ p) = begin + (a ∷ p) * [] + ≈⟨ +-idˡ [] (p * (0# ∷ [])) [] ⟩ + p * (0# ∷ []) + ≈⟨ ≈[] (p * (0# ∷ [])) (pIsZero⇒q*pIsZero p (SR.refl ∷ [])) ⟩ + [] + ∎ + +*-cong : {p : Poly} → {q : Poly} → {r : Poly} → {s : Poly} → + p ≈ q → r ≈ s → p * r ≈ q * s +*-cong {q = q} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin + [] * r ≈⟨ zeroˡ r ⟩ + [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒p≈[] q≈0) ⟨ + q * s ∎ +*-cong {q = q} {r = r} {s = s} (≈[] p p≈0) r≈s = begin + p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒p≈[] p≈0) ⟩ + [] ≈⟨ zeroˡ p ⟨ + [] * s ∎ +*-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin + (a ∷ p) * [] ≈⟨ zeroʳ (a ∷ p) ⟩ + [] ≈⟨ p≈[]⇒q*p≈[] (b ∷ q) (IsZero⇒p≈[] s≈0) ⟨ + (b ∷ q) * s ∎ +*-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) (≈[] r r≈0) = begin + (a ∷ p) * r ≈⟨ p≈[]⇒q*p≈[] (a ∷ p) (IsZero⇒p≈[] r≈0) ⟩ + [] ≈⟨ zeroʳ (b ∷ q) ⟨ + (b ∷ q) * [] ∎ +*-cong {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin + (a ∷ p) * (c ∷ r) + ≈⟨ refl ⟩ + (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consˡ (SR.*-cong a≈b c≈d)) ⟩ + (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) + ≈⟨ +-congˡ (consʳ (·-cong a≈b r≈s)) ⟩ + (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) + ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ + (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) + ≈⟨ refl ⟩ + (b ∷ q) * (d ∷ s) + ∎ + +*-congʳ : q ≈ r → p * q ≈ p * r +*-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r + +*-congˡ : p ≈ q → p * r ≈ q * r +*-congˡ p≈q = *-cong p≈q refl + +shift-distrib-+ : (p : Poly) → (q : Poly) → + shift (p + q) ≈ (shift p) + (shift q) +shift-distrib-+ p q = cons (SR.sym (SR.+-identityʳ 0#)) refl + +*-identityʳ : (p : Poly) → p * (1# ∷ []) ≈ p +*-identityʳ [] = zeroˡ [] +*-identityʳ (a ∷ p) = begin + (a ∷ p) * (1# ∷ []) + ≈⟨ refl ⟩ + (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congˡ (consˡ (SR.*-identityʳ a)) ⟩ + (a ∷ []) + (p * (0# ∷ 1# ∷ [])) + ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ + (a ∷ []) + (0# ∷ (p * (1# ∷ []))) + ≈⟨ cons (SR.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ + a ∷ (p * (1# ∷ [])) + ≈⟨ consʳ (*-identityʳ p) ⟩ + a ∷ p ∎ + +*-identityˡ : (p : Poly) → (1# ∷ []) * p ≈ p +*-identityˡ [] = refl +*-identityˡ (a ∷ p) = begin + (1# ∷ []) * (a ∷ p) + ≈⟨ consʳ refl ⟩ + 1# · (a ∷ p) + [] * (0# ∷ a ∷ p) + ≈⟨ +-identityʳ (1# · (a ∷ p) + []) ⟩ + 1# · (a ∷ p) + [] + ≈⟨ +-identityʳ (1# · (a ∷ p)) ⟩ + 1# · (a ∷ p) + ≈⟨ cons (SR.*-identityˡ a) (1·p≈p p) ⟩ + a ∷ p ∎ + +shiftp≈p*x : (p : Poly) → shift p ≈ p * (0# ∷ 1# ∷ []) +shiftp≈p*x [] = sym (begin + [] * (0# ∷ 1# ∷ []) + ≈⟨ refl ⟩ + [] + ≈⟨ p≈[]⇒0∷p≈p refl ⟩ + 0# ∷ [] ∎) +shiftp≈p*x (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ cons (SR.+-identityˡ 0#) (cons (SR.+-identityʳ a) (+-identityˡ p)) ⟨ + (0# ∷ a ∷ []) + shift (shift p) + ≈⟨ consʳ (consʳ (+-congʳ (*-identityʳ p))) ⟨ + (0# ∷ a ∷ []) + (shift (shift (p * (1# ∷ [])))) + ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (consʳ (*-distrib-shift p (1# ∷ []))) ⟨ + (0# ∷ a ∷ []) + shift (p * shift (1# ∷ [])) + ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (*-distrib-shift p (0# ∷ 1# ∷ [])) ⟨ + (0# ∷ a ∷ []) + p * shift (shift (1# ∷ [])) + ≈⟨ +-congˡ (cons (SR.zeroʳ a) (consˡ (SR.*-identityʳ a))) ⟨ + a · (0# ∷ 1# ∷ []) + p * (0# ∷ 0# ∷ 1# ∷ []) + ≈⟨ refl ⟨ + (a ∷ p) * (0# ∷ 1# ∷ []) ∎ + +shiftp≈x*p : (p : Poly) → shift p ≈ (0# ∷ 1# ∷ []) * p +shiftp≈x*p [] = begin + 0# ∷ [] + ≈⟨ p≈[]⇒0∷p≈p refl ⟨ + [] + ≈⟨ zeroʳ (0# ∷ 1# ∷ []) ⟨ + (0# ∷ 1# ∷ []) * [] + ∎ +shiftp≈x*p (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ 1·p≈p (0# ∷ a ∷ p) ⟨ + 1# · (0# ∷ a ∷ p) + ≈⟨ +-identityʳ (1# · (0# ∷ a ∷ p)) ⟨ + 1# · (0# ∷ a ∷ p) + [] + ≈⟨ refl ⟨ + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-idˡ (0# · (a ∷ p)) ((1# ∷ []) * (0# ∷ a ∷ p)) + (a≈0⇒a·pIsZero 0# (a ∷ p) SR.refl)⟨ + (0# · (a ∷ p)) + ((1# ∷ []) * (0# ∷ a ∷ p)) + ≈⟨ refl ⟨ + (0# ∷ 1# ∷ []) * (a ∷ p) + ∎ + +·-distrib-* : (p : Poly) → (q : Poly) → (a : A) → + a · (p * q) ≈ (a · p) * q +·-distrib-* [] q a = refl +·-distrib-* (b ∷ p) [] a = begin + a · ((b ∷ p) * []) + ≈⟨ a·-cong ( +-idʳ [] (p * (0# ∷ [])) + (pIsZero⇒q*pIsZero p (p≈[]⇒0∷p≈0 refl))) ⟩ + [] + ≈⟨ zeroʳ (a · (b ∷ p)) ⟨ + (a · (b ∷ p)) * [] + ∎ +·-distrib-* (b ∷ p) (c ∷ q) a = begin + a · ((b ∷ p) * (c ∷ q)) + ≈⟨ refl ⟩ + a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) + ≈⟨ ·-dist ⟩ + a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congˡ (cons (SR.sym (SR.*-assoc a b c)) ·-assoc) ⟩ + (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) + ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ + (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) + ≈⟨ refl ⟩ + (a · (b ∷ p)) * (c ∷ q) ∎ + +0∷[p*q]≈[0∷p]*q : (p : Poly) → (q : Poly) → shift (p * q) ≈ (shift p) * q +0∷[p*q]≈[0∷p]*q [] q = begin + shift ([] * q) + ≈⟨ consʳ (refl) ⟩ + shift [] + ≈⟨ p≈[]⇒0∷p≈p refl ⟨ + [] + ≈⟨ p≈[]⇒p*q≈[] q (sym (p≈[]⇒0∷p≈p refl)) ⟨ + (0# ∷ []) * q + ∎ +0∷[p*q]≈[0∷p]*q (a ∷ p) q = begin + shift ((a ∷ p) * q) + ≈⟨ *-distrib-shift (a ∷ p) q ⟨ + (a ∷ p) * shift q + ≈⟨ refl ⟩ + a · shift q + p * (0# ∷ shift q) + ≈⟨ +-idˡ (0# · q) (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) + (a≈0⇒a·pIsZero 0# q SR.refl) ⟨ + 0# · q + (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) + ≈⟨ refl ⟩ + shift (a ∷ p) * q + ∎ + +*-distribˡ-+ : (p : Poly) → (q : Poly) → (r : Poly) → + p * (q + r) ≈ p * q + p * r +*-distribˡ-+ [] q r = begin + [] * (q + r) ≈⟨ zeroˡ (q + r) ⟩ + [] ≈⟨ refl ⟩ + [] * q + [] * r ∎ +*-distribˡ-+ (a ∷ p) q r = begin + (a ∷ p) * (q + r) + ≈⟨ refl ⟩ + a · (q + r) + p * (0# ∷ q + r) + ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ + (a · q + a · r) + (0# ∷ (p * (q + r))) + ≈⟨ +-congʳ (consʳ (*-distribˡ-+ p q r)) ⟩ + (a · q + a · r) + (0# ∷ (p * q + p * r)) + ≈⟨ +-congʳ (consˡ (SR.+-identityʳ 0#)) ⟨ + (a · q + a · r) + ((0# ∷ (p * q)) + (0# ∷ (p * r))) + ≈⟨ middleFour (a · q) (a · r) (0# ∷ p * q) (0# ∷ p * r) ⟩ + ((a · q) + (0# ∷ (p * q))) + ((a · r) + (0# ∷ (p * r))) + ≈⟨ +-cong (+-congʳ (*-distrib-shift p q)) (+-congʳ (*-distrib-shift p r)) ⟨ + (a · q + p * (0# ∷ q)) + (a · r + p * (0# ∷ r)) + ≈⟨ refl ⟨ + (a ∷ p) * q + (a ∷ p) * r + ∎ + +*-distribʳ-+ : (p : Poly) → (q : Poly) → (r : Poly) → + (q + r) * p ≈ (q * p) + (r * p) +*-distribʳ-+ p [] [] = sym (+-identityʳ ([])) +*-distribʳ-+ p [] (c ∷ r) = begin + ([] + (c ∷ r)) * p ≈⟨ refl ⟩ + (c ∷ r) * p ≈⟨ +-identityˡ ((c ∷ r) * p) ⟨ + [] * p + (c ∷ r) * p ∎ +*-distribʳ-+ p (b ∷ q) [] = begin + ((b ∷ q) + []) * p ≈⟨ refl ⟩ + (b ∷ q) * p ≈⟨ +-identityʳ ((b ∷ q) * p) ⟨ + (b ∷ q) * p + [] * p ∎ +*-distribʳ-+ p (b ∷ q) (c ∷ r) = begin + ((b ∷ q) + (c ∷ r)) * p + ≈⟨ refl ⟩ + (b +A c) · p + (q + r) * (0# ∷ p) + ≈⟨ +-cong (·-distrib-+A b c p) (*-distribʳ-+ (0# ∷ p) q r) ⟩ + ((b · p) + (c · p)) + (q * (0# ∷ p) + r * (0# ∷ p)) + ≈⟨ middleFour (b · p) (c · p) (q * (0# ∷ p)) (r * (0# ∷ p)) ⟩ + (b · p + q * (0# ∷ p)) + (c · p + r * (0# ∷ p)) + ≈⟨ refl ⟨ + (b ∷ q) * p + (c ∷ r) * p + ∎ + +*-assoc : (p : Poly) → (q : Poly) → (r : Poly) → + (p * q) * r ≈ p * (q * r) +*-assoc [] q r = refl +*-assoc (a ∷ p) q r = begin + ((a ∷ p) * q) * r + ≈⟨ refl ⟩ + ((a · q) + (p * (0# ∷ q))) * r + ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ + ((a · q) + (0# ∷ (p * q))) * r + ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ + ((a · q) * r) + ((0# ∷ (p * q)) * r) + ≈⟨ +-congʳ step1 ⟨ + ((a · q) * r) + (0# ∷ (p * (q * r))) + ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ + (a · (q * r)) + (0# ∷ (p * (q * r))) + ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ + (a · (q * r)) + (p * (0# ∷ (q * r))) + ≈⟨ refl ⟩ + (a ∷ p) * (q * r) + ∎ + where + step1 = begin + 0# ∷ (p * (q * r)) + ≈⟨ consʳ (*-assoc p q r) ⟨ + 0# ∷ ((p * q) * r) + ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ + (0# ∷ (p * q)) * r + ≈⟨ refl ⟩ + (0# · r) + ((p * q) * (0# ∷ r)) + ≈⟨ +-congˡ (IsZero⇒p≈[] (a≈0⇒a·pIsZero 0# r SR.refl) ) ⟩ + [] + ((p * q) * (0# ∷ r)) + ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ + [] + (0# ∷ ((p * q) * r)) + ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ + [] + ((0# ∷ (p * q)) * r) + ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ + (0# ∷ (p * q)) * r + ∎ + +-------------------------------------------------------------- +-- Algebraic properties of addition ++-identity : Identity [] _+_ ++-identity = +-identityˡ , +-identityʳ + +--------------------------------------------------------------- +-- Additive structures + +isEquivalence : IsEquivalence _≈_ +isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + ++-isMagma : IsMagma _≈_ _+_ ++-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = +-cong + } + ++-isSemigroup : IsSemigroup _≈_ _+_ ++-isSemigroup = record + { isMagma = +-isMagma + ; assoc = +-assoc + } + ++-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ ++-isCommutativeSemigroup = record + { isSemigroup = +-isSemigroup + ; comm = +-comm + } + ++-isMonoid : IsMonoid _≈_ _+_ [] ++-isMonoid = record + { isSemigroup = +-isSemigroup + ; identity = +-identity + } + ++-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ [] ++-isCommutativeMonoid = record + { isMonoid = +-isMonoid + ; comm = +-comm + } + +--------------------------------------------------------------- +-- Additive raw bundles ++-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ ++-rawMagma = record + { Carrier = Poly + ; _≈_ = _≈_ + ; _∙_ = _+_ + } + ++-rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ ++-rawSemiring = record + { Carrier = Poly + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = [] + ; 1# = 1# ∷ [] + } + +-- Additive bundles + ++-magma : Algebra.Bundles.Magma _ _ ++-magma = record + { isMagma = +-isMagma + } + ++-semigroup : Algebra.Bundles.Semigroup _ _ ++-semigroup = record + { isSemigroup = +-isSemigroup + } + ++-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ ++-commutativeSemigroup = record + { isCommutativeSemigroup = +-isCommutativeSemigroup + } + ++-monoid : Algebra.Bundles.Monoid _ _ ++-monoid = record + { isMonoid = +-isMonoid + } + ++-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ ++-commutativeMonoid = record + { isCommutativeMonoid = +-isCommutativeMonoid + } + +*-identity : Identity (1# ∷ []) _*_ +*-identity = *-identityˡ , *-identityʳ + +*-zeroˡ : LeftZero [] _*_ +*-zeroˡ p = zeroˡ p + +*-zeroʳ : RightZero [] _*_ +*-zeroʳ p = zeroʳ p + +*-zero : Zero [] _*_ +*-zero = *-zeroˡ , *-zeroʳ + +*-distrib-+ : _*_ DistributesOver _+_ +*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ + +------------------------------------------------------------------ +-- Multiplicative structure + +*-isMagma : IsMagma _≈_ _*_ +*-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = *-cong + } + +*-isSemigroup : IsSemigroup _≈_ _*_ +*-isSemigroup = record + { isMagma = *-isMagma + ; assoc = *-assoc + } + +*-isMonoid : IsMonoid _≈_ _*_ (1# ∷ []) +*-isMonoid = record + { isSemigroup = *-isSemigroup + ; identity = *-identity + } + ++-*-isSemiring : IsSemiring _≈_ _+_ _*_ [] (1# ∷ []) ++-*-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = +-isCommutativeMonoid + ; *-cong = *-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + ; zero = *-zero + } + +--------------------------------------------------------------- +-- Multiplicative bundles + +*-magma : Algebra.Bundles.Magma _ _ +*-magma = record + { isMagma = *-isMagma + } + +*-semigroup : Algebra.Bundles.Semigroup _ _ +*-semigroup = record + { isSemigroup = *-isSemigroup + } + +*-monoid : Algebra.Bundles.Monoid _ _ +*-monoid = record + { isMonoid = *-isMonoid + } + ++-*-semiring : Semiring _ _ ++-*-semiring = record + { isSemiring = +-*-isSemiring + } + +------------------------------------------------------ +-- Degree function and polynomial normalization + +module _ (_≟0 : ∀ a → Dec (a ≈A 0#)) where + +-- true degree function of a polynomial + deg : Poly → Maybe ℕ + deg [] = nothing + deg (a ∷ p) with deg p + ... | just n = just (suc n) + ... | nothing with a ≟0 + ... | yes _ = nothing + ... | no _ = just 0 + +-- normalization operation for a polynomial + norm : Poly → Poly + norm [] = [] + norm (a ∷ p) with norm p + ... | b ∷ q = a ∷ b ∷ q + ... | [] with a ≟0 + ... | yes _ = [] + ... | no _ = a ∷ [] + + just≢nothing : ∀ {n : ℕ} → just n ≢ nothing + just≢nothing () + + IsZero⇒deg≡nothing : ∀ {p} → IsZero p → deg p ≡ nothing + IsZero⇒deg≡nothing [] = Eq.refl + IsZero⇒deg≡nothing {a ∷ p} (a≈0 ∷ p≈0) + rewrite IsZero⇒deg≡nothing p≈0 with a ≟0 + ... | yes _ = Eq.refl + ... | no ¬a≈0 = ⊥-elim (¬a≈0 a≈0) + + deg≡nothing⇒IsZero : ∀ {p} → deg p ≡ nothing → IsZero p + deg≡nothing⇒IsZero {[]} eq = [] + deg≡nothing⇒IsZero {a ∷ p} eq with deg p in taildeg + ... | just n = ⊥-elim (just≢nothing eq) + ... | nothing with a ≟0 + ... | yes a≈0 = a≈0 ∷ deg≡nothing⇒IsZero {p} taildeg + ... | no _ = ⊥-elim (just≢nothing eq) + + deg-cong : ∀ {p q} → p ≈ q → deg p ≡ deg q + deg-cong ([]≈ q []≈q) = Eq.sym (IsZero⇒deg≡nothing []≈q) + deg-cong (≈[] p p≈[]) = IsZero⇒deg≡nothing p≈[] + deg-cong {a ∷ p} {b ∷ q} (cons a≈b p≈q) + rewrite deg-cong p≈q with deg q + ... | just n = Eq.refl + ... | nothing with a ≟0 | b ≟0 + ... | yes _ | yes _ = Eq.refl + ... | no _ | no _ = Eq.refl + ... | yes a≈0 | no ¬b≈0 = ⊥-elim (¬b≈0 (SR.trans (SR.sym a≈b) a≈0)) + ... | no ¬a≈0 | yes b≈0 = ⊥-elim (¬a≈0 (SR.trans a≈b b≈0)) + From 58ebf555ad304345b8dbe0a714427442ea8d98bb Mon Sep 17 00:00:00 2001 From: Sam Park Date: Fri, 28 Aug 2026 22:57:17 +0900 Subject: [PATCH 5/8] Replace polynomial modules with list-based implementation --- src/Algebra/Polynomial/Morphism/Morphism.agda | 500 +++++------ .../Polynomial/Morphism/Morphism2.agda | 331 ------- .../Polynomial/Poly/Base/CommutativeRing.agda | 147 +-- .../Poly/Base/CommutativeRing2.agda | 11 - src/Algebra/Polynomial/Poly/Base/Ring.agda | 148 +--- src/Algebra/Polynomial/Poly/Base/Ring2.agda | 18 - .../Polynomial/Poly/Base/Semiring.agda | 100 +-- .../Polynomial/Poly/Base/Semiring2.agda | 129 --- .../Poly/Properties/CommutativeRing.agda | 714 ++------------- .../Poly/Properties/CommutativeRing2.agda | 171 ---- .../Polynomial/Poly/Properties/Ring.agda | 675 ++------------ .../Polynomial/Poly/Properties/Ring2.agda | 136 --- .../Polynomial/Poly/Properties/Semiring.agda | 835 +++++++++++------- .../Polynomial/Poly/Properties/Semiring2.agda | 756 ---------------- 14 files changed, 936 insertions(+), 3735 deletions(-) delete mode 100644 src/Algebra/Polynomial/Morphism/Morphism2.agda delete mode 100644 src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda delete mode 100644 src/Algebra/Polynomial/Poly/Base/Ring2.agda delete mode 100644 src/Algebra/Polynomial/Poly/Base/Semiring2.agda delete mode 100644 src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda delete mode 100644 src/Algebra/Polynomial/Poly/Properties/Ring2.agda delete mode 100644 src/Algebra/Polynomial/Poly/Properties/Semiring2.agda diff --git a/src/Algebra/Polynomial/Morphism/Morphism.agda b/src/Algebra/Polynomial/Morphism/Morphism.agda index 76bfe19f87..67da6c2dbb 100644 --- a/src/Algebra/Polynomial/Morphism/Morphism.agda +++ b/src/Algebra/Polynomial/Morphism/Morphism.agda @@ -1,43 +1,45 @@ -- Polynomial Morphisms +-- open import Algebra.Bundles using (CommutativeRing) open import Algebra.Bundles - using (CommutativeRing ; CommutativeSemiring; Ring; - SemiringWithoutAnnihilatingZero; Semiring) - + renaming (CommutativeRing to CR) + module Algebra.Polynomial.Morphism.Morphism {ℓ₁ ℓ₂} - (R : CommutativeRing ℓ₁ ℓ₂) + (R : CR ℓ₁ ℓ₂) where -open import Algebra.Bundles.Raw using (RawRing) import Algebra.Definitions as Def open import Algebra.Morphism.Bundles - using (RingHomomorphism ; MagmaHomomorphism ; MonoidHomomorphism) + renaming (RingHomomorphism to RingHomo; MonoidHomomorphism to MonHomo) open import Algebra.Morphism.Structures - using (IsRingHomomorphism ; IsMagmaHomomorphism ; IsSemiringHomomorphism; - IsNearSemiringHomomorphism ; IsMonoidHomomorphism) -open import Algebra.Polynomial.Base.CommutativeRing R + renaming (IsRingHomomorphism to IsRingHomo; IsMagmaHomomorphism to IsMagmaHomo) open import Algebra.Polynomial.Poly.Base.CommutativeRing R - using (Poly; []≈ ; ≈[]; cons ; cast-lem ; consˡ ; consʳ) - renaming ( sym to P-sym ; _·_ to _·P_ + using (Poly; []≈ ; ≈[]; cons ; consˡ ; consʳ; IsZero⇒p≈[]; + p≈[]⇒IsZero; a·p≈a∷[]*p ; *-distrib-shift; shiftp≈x*p) + renaming ( refl to P-refl ; sym to P-sym ; _·_ to _·P_ ; _+_ to _+P_ ; _*_ to _*P_; _≈_ to _≈P_; -_ to -P_) -open import Algebra.Polynomial.Poly.Properties.CommutativeRing R - using (cast-p≈p; IsZero⇒≈0; ≈0⇒IsZero; a·p≈a∷[]*p ; *-distrib-shift; shift-is-x*) - renaming (+-identityˡ to +-P-identityˡ ; +-identityʳ to +-P-identityʳ - ; zeroˡ to P-zeroˡ; zeroʳ to P-zeroʳ ; *-comm to *-P-comm ) -open import Algebra.Polynomial.Properties.CommutativeRing R as P - using (+-identityˡ; +-identityʳ; +-*-commutativeRing; *-zeroˡ ; *-zeroʳ) - renaming (rawRing to PolyrawRing) +open import Algebra.Polynomial.Poly.Properties.CommutativeRing R as P + using (+-*-commutativeRing; *-zeroˡ ; *-zeroʳ) + renaming ( rawRing to PolyrawRing; *-comm to P*-comm + ; +-identityˡ to +-P-identityˡ ; +-identityʳ to +-P-identityʳ + ; zeroˡ to P-zeroˡ; zeroʳ to P-zeroʳ) open import Algebra.Properties.Group open import Algebra.Properties.Ring using (-‿distribʳ-*) open import Data.Product.Base using (proj₁ ; proj₂) -open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -open import Data.Vec.Base as Vec using (Vec; []; _∷_) -open import Data.Vec.Relation.Unary.All +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All import Level as L import Relation.Binary.Morphism.Structures as S - using (IsRelHomomorphism) + renaming (IsRelHomomorphism to IsRelHomo) -module A = CommutativeRing R +open RingHomo + renaming ( +-isMagmaHomomorphism to +-isMagmaHomo + ; +-monoidHomomorphism to +-monoidHom + ; isRelHomomorphism to isRelHomo + ; *-isMagmaHomomorphism to *-isMagmaHomo) + hiding (⟦_⟧) + +module A = CR R open A hiding (distrib) renaming @@ -51,21 +53,17 @@ open A private variable - m n k l : ℕ - a b c d : A - p : Poly m - q : Poly n - P : Polynomial - Q : Polynomial + a b : A + p : Poly + q : Poly module PolynomialRingMorphism {ℓ₃ ℓ₄} - (B : CommutativeRing ℓ₃ ℓ₄) - - (f : RingHomomorphism {ℓ₁} {ℓ₂} (CommutativeRing.rawRing R) (CommutativeRing.rawRing B)) + (B : CR ℓ₃ ℓ₄) + (f : RingHomo {ℓ₁} {ℓ₂} (CR.rawRing R) (CR.rawRing B)) where - module B = CommutativeRing B + module B = CR B open B using (distrib) renaming @@ -77,259 +75,185 @@ module PolynomialRingMorphism using (0#; 1#) open import Relation.Binary.Reasoning.Setoid B-Set - open RingHomomorphism f using (⟦_⟧) + open RingHomo f using (⟦_⟧) + open Def {A = B.Carrier} (_≈B_) - eval-poly : CommutativeRing.Carrier B → (Poly m) → CommutativeRing.Carrier B - eval-poly β [] = 0# - eval-poly β (a ∷ p) = ⟦ a ⟧ +B (β *B eval-poly β p) - - eval : CommutativeRing.Carrier B → Polynomial → CommutativeRing.Carrier B - eval β (ℕ.zero , []) = 0# - eval β (suc n , (a ∷ p)) = ⟦ a ⟧ +B (β *B (eval β (n , p))) +-- evaluate the polynomial given an element β ∈ B + eval : CR.Carrier B → Poly → CR.Carrier B + eval β [] = 0# + eval β (a ∷ p) = ⟦ a ⟧ +B (β *B eval β p) - -- prove that eval (0 ∷ 1 ∷ []) is β + eval-equiv : (β : CR.Carrier B) → (p : Poly) → eval β p ≈B (eval β p) + eval-equiv β [] = B.refl + eval-equiv β (a ∷ p) = B.+-congˡ (B.*-congˡ (eval-equiv β p)) - eval-equiv : (β : CommutativeRing.Carrier B) → (p : Poly m) → eval-poly β p ≈B (eval β (m , p)) - eval-equiv {ℕ.zero} β [] = B.refl - eval-equiv {suc m} β (a ∷ p) = B.+-congˡ (B.*-congˡ (eval-equiv β p)) - - eval-poly-cong : ∀ {p : Poly m} → ∀ {q : Poly n} → p ≈P q → - (β : CommutativeRing.Carrier B) → (eval-poly β p) ≈B (eval-poly β q) - eval-poly-cong {p = []} {[]} P≈Q β = B.refl - eval-poly-cong {p = []} {b ∷ q} p≈q β = begin - eval-poly β [] + eval-cong : ∀ {p : Poly} → ∀ {q : Poly} → (β : CR.Carrier B) + → p ≈P q → (eval β p) ≈B (eval β q) + eval-cong {p = []} {q = []} β p≈q = B.refl + eval-cong {p = []} {q = b ∷ q} β p≈q = begin + eval β [] ≈⟨ B.zeroʳ β ⟨ β *B 0# - ≈⟨ B.+-identityˡ (β *B eval-poly β []) ⟨ - 0# +B β *B eval-poly β [] - ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo - (RingHomomorphism.+-monoidHomomorphism f)) ⟨ - ⟦ A0# ⟧ +B β *B eval-poly β [] - ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-cong {p = []} {q = q} - (P-sym (IsZero⇒≈0 (tail (≈0⇒IsZero (P-sym p≈q))))) β)) ⟩ - ⟦ A0# ⟧ +B β *B eval-poly β q - ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong - (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero (P-sym p≈q)))) ⟨ - eval-poly β (b ∷ q) + ≈⟨ B.+-identityˡ (β *B eval β []) ⟨ + 0# +B β *B eval β [] + ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟨ + ⟦ A0# ⟧ +B β *B eval β [] + ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {p = []} {q = q} β + (P-sym (IsZero⇒p≈[] (tail (p≈[]⇒IsZero (P-sym p≈q))))))) ⟩ + ⟦ A0# ⟧ +B β *B eval β q + ≈⟨ B.+-congʳ (S.IsRelHomo.cong + (isRelHomo f) (head (p≈[]⇒IsZero (P-sym p≈q)))) ⟨ + eval β (b ∷ q) ∎ - eval-poly-cong {p = a ∷ p} {[]} p≈q β = begin - eval-poly β (a ∷ p) - ≈⟨ B.+-congʳ (S.IsRelHomomorphism.cong - (RingHomomorphism.isRelHomomorphism f) (head (≈0⇒IsZero p≈q))) ⟩ - ⟦ A0# ⟧ +B β *B eval-poly β p - ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-cong {p = p} {q = []} - (IsZero⇒≈0 (tail (≈0⇒IsZero p≈q))) β)) ⟩ - ⟦ A0# ⟧ +B β *B eval-poly β [] - ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo - (RingHomomorphism.+-monoidHomomorphism f)) ⟩ - 0# +B β *B eval-poly β [] + eval-cong {p = a ∷ p} {[]} β p≈q = begin + eval β (a ∷ p) + ≈⟨ B.+-congʳ (S.IsRelHomo.cong + (isRelHomo f) (head (p≈[]⇒IsZero p≈q))) ⟩ + ⟦ A0# ⟧ +B β *B eval β p + ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {p = p} {q = []} β + (IsZero⇒p≈[] (tail (p≈[]⇒IsZero p≈q))) )) ⟩ + ⟦ A0# ⟧ +B β *B eval β [] + ≈⟨ B.+-congʳ (MonHomo.ε-homo(+-monoidHom f)) ⟩ + 0# +B β *B eval β [] ≈⟨ B.+-congˡ (B.zeroʳ β) ⟩ 0# +B 0# ≈⟨ B.+-identityʳ 0# ⟩ - eval-poly β [] - ∎ - eval-poly-cong {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) β - = B.+-cong (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism f) a≈b) - (B.*-congˡ (eval-poly-cong p≈q β)) - - eval-cong : (β : CommutativeRing.Carrier B) → P ≈ Q → eval β P ≈B eval β Q - eval-cong {P = (m , p)} {Q = (n , q)} β P≈Q = begin - eval β (m , p) - ≈⟨ eval-equiv β p ⟨ - eval-poly β p - ≈⟨ eval-poly-cong P≈Q β ⟩ - eval-poly β q - ≈⟨ eval-equiv β q ⟩ - eval β (n , q) + eval β [] ∎ + eval-cong {p = a ∷ p} {b ∷ q} β (cons a≈b p≈q) + = B.+-cong (S.IsRelHomo.cong (isRelHomo f) a≈b) + (B.*-congˡ (eval-cong β p≈q )) - eval-poly-+-homomorphic : (β : CommutativeRing.Carrier B) → (p : Poly m) → (q : Poly n) → - eval-poly β (p +P q) ≈B eval-poly β p +B eval-poly β q - eval-poly-+-homomorphic β [] q = begin - eval-poly β ([] +P q) - ≈⟨ eval-poly-cong (+-P-identityˡ {m = 0} q) β ⟩ - eval-poly β q - ≈⟨ B.+-identityˡ (eval-poly β q) ⟨ - eval-poly β [] +B eval-poly β q + eval-+-homomorphic : (β : CR.Carrier B) → (p : Poly) → (q : Poly) → + eval β (p +P q) ≈B eval β p +B eval β q + eval-+-homomorphic β [] q = begin + eval β ([] +P q) + ≈⟨ eval-cong β (+-P-identityˡ q) ⟩ + eval β q + ≈⟨ B.+-identityˡ (eval β q) ⟨ + eval β [] +B eval β q ∎ - eval-poly-+-homomorphic β (a ∷ p) [] = B.sym (B.+-identityʳ (eval-poly β (a ∷ p))) - eval-poly-+-homomorphic β (a ∷ p) (b ∷ q) = begin - eval-poly β ((a ∷ p) +P (b ∷ q)) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-+-homomorphic β p q)) ⟩ - ⟦ a +A b ⟧ +B (β *B (eval-poly β p +B eval-poly β q)) - ≈⟨ B.+-congˡ (proj₁ distrib β (eval-poly β p) (eval-poly β q)) ⟩ - ⟦ a +A b ⟧ +B (β *B eval-poly β p +B β *B eval-poly β q) - ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.+-isMagmaHomomorphism f) a b) ⟩ - ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval-poly β p +B β *B eval-poly β q) - ≈⟨ B.+-assoc (⟦ a ⟧ +B ⟦ b ⟧) (β *B eval-poly β p) (β *B eval-poly β q) ⟨ - ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval-poly β p +B β *B eval-poly β q - ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval-poly β p)) ⟩ - ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval-poly β p) +B β *B eval-poly β q - ≈⟨ B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval-poly β p) (β *B eval-poly β q) ⟩ - ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval-poly β p +B (β *B eval-poly β q)) - ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval-poly β p) ⟦ b ⟧))) ⟨ - ⟦ a ⟧ +B ((β *B eval-poly β p) +B ⟦ b ⟧ +B (β *B eval-poly β q)) - ≈⟨ B.+-congˡ (B.+-assoc (β *B eval-poly β p) ⟦ b ⟧ (β *B eval-poly β q)) ⟩ - ⟦ a ⟧ +B (β *B eval-poly β p +B eval-poly β (b ∷ q)) - ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval-poly β p) (eval-poly β (b ∷ q)) ⟨ - ⟦ a ⟧ +B β *B eval-poly β p +B eval-poly β (b ∷ q) + eval-+-homomorphic β (a ∷ p) [] = B.sym (B.+-identityʳ (eval β (a ∷ p))) + eval-+-homomorphic β (a ∷ p) (b ∷ q) = begin + eval β ((a ∷ p) +P (b ∷ q)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-+-homomorphic β p q)) ⟩ + ⟦ a +A b ⟧ +B (β *B (eval β p +B eval β q)) + ≈⟨ B.+-congˡ (proj₁ distrib β (eval β p) (eval β q)) ⟩ + ⟦ a +A b ⟧ +B (β *B eval β p +B β *B eval β q) + ≈⟨ B.+-congʳ (IsMagmaHomo.homo (+-isMagmaHomo f) a b) ⟩ + ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval β p +B β *B eval β q) + ≈⟨ B.+-assoc (⟦ a ⟧ +B ⟦ b ⟧) (β *B eval β p) (β *B eval β q) ⟨ + ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval β p +B β *B eval β q + ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval β p)) ⟩ + ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval β p) +B β *B eval β q + ≈⟨ B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval β p) (β *B eval β q) ⟩ + ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval β p +B (β *B eval β q)) + ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval β p) ⟦ b ⟧))) ⟨ + ⟦ a ⟧ +B ((β *B eval β p) +B ⟦ b ⟧ +B (β *B eval β q)) + ≈⟨ B.+-congˡ (B.+-assoc (β *B eval β p) ⟦ b ⟧ (β *B eval β q)) ⟩ + ⟦ a ⟧ +B (β *B eval β p +B eval β (b ∷ q)) + ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval β p) (eval β (b ∷ q)) ⟨ + ⟦ a ⟧ +B β *B eval β p +B eval β (b ∷ q) ∎ - eval-+-homomorphic : (β : CommutativeRing.Carrier B) → (P : Polynomial) → (Q : Polynomial) → - eval β (P + Q) ≈B eval β P +B eval β Q - eval-+-homomorphic β (m , p) (n , q) = begin - eval β ((m , p) + (n , q)) - ≈⟨ eval-equiv β (p +P q) ⟨ - eval-poly β (p +P q) - ≈⟨ eval-poly-+-homomorphic β p q ⟩ - eval-poly β p +B eval-poly β q - ≈⟨ B.+-cong (eval-equiv β p) (eval-equiv β q) ⟩ - eval β (m , p) +B eval β (n , q) - ∎ - - eval-poly-1#-homomorphic : (β : CommutativeRing.Carrier B) → eval-poly β (A1# ∷ []) ≈B 1# - eval-poly-1#-homomorphic β = begin - eval-poly β (A1# ∷ []) - ≈⟨ B.+-cong (RingHomomorphism.1#-homo f) (B.zeroʳ β) ⟩ - 1# +B 0# - ≈⟨ B.+-identityʳ 1# ⟩ - 1# - ∎ - - eval-1#-homomorphic : (β : CommutativeRing.Carrier B) → eval β one ≈B 1# + eval-1#-homomorphic : (β : CR.Carrier B) → eval β (A1# ∷ []) ≈B 1# eval-1#-homomorphic β = begin - eval β (1 , (A1# ∷ [])) - ≈⟨ eval-equiv β (A1# ∷ []) ⟨ - eval-poly β (A1# ∷ []) - ≈⟨ eval-poly-1#-homomorphic β ⟩ - 1# - ∎ - - eval-poly-scale : (β : CommutativeRing.Carrier B) → (a : A) → (p : Poly m) → - eval-poly β (a ·P p) ≈B eval-poly β (a ∷ []) *B (eval-poly β p) - eval-poly-scale β a [] = begin - 0# - ≈⟨ B.zeroʳ (⟦ a ⟧ +B β *B 0#) ⟨ - (⟦ a ⟧ +B β *B 0#) *B 0# - ∎ - eval-poly-scale β a (b ∷ p) = begin - ⟦ a *A b ⟧ +B β *B eval-poly β (a ·P p) - ≈⟨ B.+-congʳ (IsMagmaHomomorphism.homo (RingHomomorphism.*-isMagmaHomomorphism f) a b) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B eval-poly β (a ·P p) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-scale β a p)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B (eval-poly β (a ∷ []) *B (eval-poly β p)) + eval β (A1# ∷ []) ≈⟨ B.+-cong (RingHomo.1#-homo f) (B.zeroʳ β) ⟩ + 1# +B 0# ≈⟨ B.+-identityʳ 1# ⟩ + 1# ∎ + + eval-scale : (β : CR.Carrier B) → (a : A) → (p : Poly) → + eval β (a ·P p) ≈B eval β (a ∷ []) *B (eval β p) + eval-scale β a [] = begin + 0# ≈⟨ B.zeroʳ (⟦ a ⟧ +B β *B 0#) ⟨ + (⟦ a ⟧ +B β *B 0#) *B 0# ∎ + eval-scale β a (b ∷ p) = begin + ⟦ a *A b ⟧ +B β *B eval β (a ·P p) + ≈⟨ B.+-congʳ (IsMagmaHomo.homo (*-isMagmaHomo f) a b) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B eval β (a ·P p) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-scale β a p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B (eval β (a ∷ []) *B (eval β p)) ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-congˡ (B.zeroʳ β)))) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B ((⟦ a ⟧ +B 0#) *B (eval-poly β p)) + (⟦ a ⟧ *B ⟦ b ⟧) +B β *B ((⟦ a ⟧ +B 0#) *B (eval β p)) ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧))) ⟩ - ⟦ a ⟧ *B ⟦ b ⟧ +B β *B ((⟦ a ⟧ *B eval-poly β p)) - ≈⟨ B.+-congˡ (B.*-assoc β ⟦ a ⟧ (eval-poly β p)) ⟨ - ⟦ a ⟧ *B ⟦ b ⟧ +B (β *B (⟦ a ⟧) *B (eval-poly β p)) + ⟦ a ⟧ *B ⟦ b ⟧ +B β *B ((⟦ a ⟧ *B eval β p)) + ≈⟨ B.+-congˡ (B.*-assoc β ⟦ a ⟧ (eval β p)) ⟨ + ⟦ a ⟧ *B ⟦ b ⟧ +B (β *B (⟦ a ⟧) *B (eval β p)) ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm β ⟦ a ⟧)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B (⟦ a ⟧ *B β) *B eval-poly β p - ≈⟨ B.+-congˡ (B.*-assoc ⟦ a ⟧ β (eval-poly β p)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B ⟦ a ⟧ *B (β *B eval-poly β p) - ≈⟨ proj₁ distrib ⟦ a ⟧ ⟦ b ⟧ ( β *B eval-poly β p) ⟨ - (⟦ a ⟧) *B (⟦ b ⟧ +B β *B eval-poly β p) + (⟦ a ⟧ *B ⟦ b ⟧) +B (⟦ a ⟧ *B β) *B eval β p + ≈⟨ B.+-congˡ (B.*-assoc ⟦ a ⟧ β (eval β p)) ⟩ + (⟦ a ⟧ *B ⟦ b ⟧) +B ⟦ a ⟧ *B (β *B eval β p) + ≈⟨ proj₁ distrib ⟦ a ⟧ ⟦ b ⟧ ( β *B eval β p) ⟨ + (⟦ a ⟧) *B (⟦ b ⟧ +B β *B eval β p) ≈⟨ B.*-congʳ (B.+-identityʳ ⟦ a ⟧) ⟨ - (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-poly β p) + (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval β p) ≈⟨ B.*-congʳ (B.+-congˡ (B.zeroʳ β)) ⟨ - (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval-poly β p) - ∎ - - eval-poly-shift : (β : CommutativeRing.Carrier B) → (p : Poly m) → eval-poly β (A0# ∷ p) ≈B β *B eval-poly β p - eval-poly-shift β p = begin - ⟦ A0# ⟧ +B β *B eval-poly β p - ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo - (RingHomomorphism.+-monoidHomomorphism f)) ⟩ - 0# +B β *B eval-poly β p - ≈⟨ B.+-identityˡ (β *B eval-poly β p) ⟩ - β *B eval-poly β p + (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval β p) ∎ - eval-poly-*-homomorphic : (β : CommutativeRing.Carrier B) → (p : Poly m) → - (q : Poly n) → eval-poly β (p *P q) ≈B eval-poly β p *B eval-poly β q - eval-poly-*-homomorphic β [] q = begin - eval-poly β ([] *P q) - ≈⟨ eval-poly-cong (P-zeroˡ q) β ⟩ - eval-poly β [] - ≈⟨ B.zeroˡ (eval-poly β q) ⟨ - eval-poly β [] *B eval-poly β q - ∎ - eval-poly-*-homomorphic β (a ∷ p) [] = begin - eval-poly β ((a ∷ p) *P []) - ≈⟨ eval-poly-cong (P-zeroʳ (a ∷ p)) β ⟩ - eval-poly β [] - ≈⟨ B.zeroʳ (eval-poly β (a ∷ p)) ⟨ - eval-poly β (a ∷ p) *B eval-poly β [] - ∎ - eval-poly-*-homomorphic {suc m} {suc n} β (a ∷ p) (b ∷ q) = begin - eval-poly β ((a ∷ p) *P (b ∷ q)) - ≈⟨ eval-poly-cong (cast-p≈p (cast-lem (suc n) (m))) β ⟩ - eval-poly β (a ·P (b ∷ q) +P p *P (A0# ∷ b ∷ q)) - ≈⟨ eval-poly-+-homomorphic β (a ·P (b ∷ q)) (p *P (A0# ∷ b ∷ q)) ⟩ - eval-poly β (a ·P (b ∷ q)) +B eval-poly β (p *P (A0# ∷ b ∷ q)) - ≈⟨ B.+-congʳ (eval-poly-scale β a (b ∷ q)) ⟩ - (eval-poly β (a ∷ []) *B eval-poly β (b ∷ q)) +B eval-poly β (p *P (A0# ∷ b ∷ q)) - ≈⟨ B.+-congˡ (eval-poly-*-homomorphic β p (A0# ∷ b ∷ q)) ⟩ - (eval-poly β (a ∷ []) *B eval-poly β (b ∷ q)) +B (eval-poly β p) *B eval-poly β (A0# ∷ b ∷ q) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-shift β (b ∷ q))) ⟩ - (eval-poly β (a ∷ []) *B eval-poly β (b ∷ q)) +B (eval-poly β p) *B (β *B eval-poly β (b ∷ q)) - ≈⟨ B.+-congʳ (B.*-congʳ (B.+-congˡ (B.zeroʳ β))) ⟩ - (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval-poly β q) +B eval-poly β p *B (β *B (⟦ b ⟧ +B β *B eval-poly β q)) - ≈⟨ B.+-congʳ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧)) ⟩ - (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-poly β q) +B eval-poly β p *B (β *B (⟦ b ⟧ +B β *B eval-poly β q))) - ≈⟨ B.+-congˡ (B.*-assoc (eval-poly β p) β (⟦ b ⟧ +B β *B eval-poly β q)) ⟨ - (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-poly β q) +B (eval-poly β p *B β) *B (⟦ b ⟧ +B β *B eval-poly β q)) - ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm (eval-poly β p) β)) ⟩ - (⟦ a ⟧ *B (⟦ b ⟧ +B β *B eval-poly β q) +B (β *B eval-poly β p) *B (⟦ b ⟧ +B β *B eval-poly β q)) - ≈⟨ proj₂ distrib (⟦ b ⟧ +B β *B eval-poly β q) ⟦ a ⟧ (β *B eval-poly β p) ⟨ - (⟦ a ⟧ +B β *B eval-poly β p) *B (⟦ b ⟧ +B β *B eval-poly β q) + eval-shift : (β : CR.Carrier B) → (p : Poly) → eval β (A0# ∷ p) ≈B β *B eval β p + eval-shift β p = begin + ⟦ A0# ⟧ +B β *B eval β p + ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟩ + 0# +B β *B eval β p + ≈⟨ B.+-identityˡ (β *B eval β p) ⟩ + β *B eval β p ∎ - eval-*-homomorphic : (β : CommutativeRing.Carrier B) → (P : Polynomial) → (Q : Polynomial) → - eval β (P * Q) ≈B eval β P *B eval β Q - eval-*-homomorphic β (m , p) (n , q) = begin - eval β ((m , p) * (n , q)) - ≈⟨ eval-equiv β ((p *P q)) ⟨ - eval-poly β (p *P q) - ≈⟨ eval-poly-*-homomorphic β p q ⟩ - (eval-poly β p *B eval-poly β q) - ≈⟨ B.*-cong (eval-equiv β p) (eval-equiv β q) ⟩ - eval β (m , p) *B eval β (n , q) + eval-*-homomorphic : (β : CR.Carrier B) → (p q : Poly) + → eval β (p *P q) ≈B eval β p *B eval β q + eval-*-homomorphic β [] q = begin + eval β ([] *P q) ≈⟨ eval-cong β (P-zeroˡ q) ⟩ + eval β [] ≈⟨ B.zeroˡ (eval β q) ⟨ + eval β [] *B eval β q ∎ + eval-*-homomorphic β (a ∷ p) q = begin + eval β ((a ∷ p) *P q) + ≈⟨ eval-cong {p = (a ∷ p) *P q} β P-refl ⟩ + eval β (a ·P q +P p *P (A0# ∷ q)) + ≈⟨ eval-+-homomorphic β (a ·P q) (p *P (A0# ∷ q)) ⟩ + eval β (a ·P q) +B eval β (p *P (A0# ∷ q)) + ≈⟨ B.+-cong (eval-scale β a q) (eval-*-homomorphic β p (A0# ∷ q)) ⟩ + ((eval β (a ∷ []) *B eval β q) +B (eval β p *B eval β (A0# ∷ q))) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-shift β q)) ⟩ + (eval β (a ∷ []) *B eval β q) +B (eval β p *B (β *B eval β q)) + ≈⟨ B.+-congˡ step ⟩ + (eval β (a ∷ []) *B eval β q) +B ((β *B eval β p) *B eval β q) + ≈⟨ proj₂ distrib (eval β q) (eval β (a ∷ [])) (β *B eval β p) ⟨ + ((eval β (a ∷ []) +B β *B eval β p) *B eval β q) + ≈⟨ B.*-congʳ ((B.+-congʳ (B.trans (B.+-congˡ + (B.zeroʳ β)) (B.+-identityʳ ⟦ a ⟧)))) ⟩ + (eval β (a ∷ p) *B eval β q) ∎ - - eval-poly-inverse-homomorphic : (β : CommutativeRing.Carrier B) → (p : Poly m) → - eval-poly β (-P p) ≈B -B (eval-poly β p) - eval-poly-inverse-homomorphic β [] = B.sym (ε⁻¹≈ε B.+-group) - eval-poly-inverse-homomorphic β (a ∷ p) = begin - eval-poly β (-P (a ∷ p)) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-poly-inverse-homomorphic β p)) ⟩ - ⟦ -A a ⟧ +B β *B (-B (eval-poly β p)) - ≈⟨ B.+-congˡ (-‿distribʳ-* (CommutativeRing.ring B) β (eval-poly β p)) ⟨ - ⟦ -A a ⟧ +B -B (β *B eval-poly β p) - ≈⟨ B.+-congʳ (RingHomomorphism.-‿homo f a) ⟩ - -B ⟦ a ⟧ +B -B (β *B eval-poly β p) - ≈⟨ B.+-comm (-B (β *B eval-poly β p)) (-B ⟦ a ⟧) ⟨ - -B (β *B eval-poly β p) +B -B ⟦ a ⟧ - ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval-poly β p) ⟨ - -B eval-poly β (a ∷ p) + where + step : eval β p *B (β *B eval β q) ≈B (β *B eval β p) *B eval β q + step = begin + eval β p *B (β *B eval β q) + ≈⟨ B.*-assoc (eval β p) β (eval β q) ⟨ + (eval β p *B β) *B eval β q + ≈⟨ B.*-congʳ (B.*-comm (eval β p) β) ⟩ + (β *B eval β p) *B eval β q + ∎ + + eval-inverse-homomorphic : (β : CR.Carrier B) → (p : Poly) → + eval β (-P p) ≈B -B (eval β p) + eval-inverse-homomorphic β [] = B.sym (ε⁻¹≈ε B.+-group) + eval-inverse-homomorphic β (a ∷ p) = begin + eval β (-P (a ∷ p)) + ≈⟨ B.+-congˡ (B.*-congˡ (eval-inverse-homomorphic β p)) ⟩ + ⟦ -A a ⟧ +B β *B (-B (eval β p)) + ≈⟨ B.+-congˡ (-‿distribʳ-* (CR.ring B) β (eval β p)) ⟨ + ⟦ -A a ⟧ +B -B (β *B eval β p) + ≈⟨ B.+-congʳ (RingHomo.-‿homo f a) ⟩ + -B ⟦ a ⟧ +B -B (β *B eval β p) + ≈⟨ B.+-comm (-B (β *B eval β p)) (-B ⟦ a ⟧) ⟨ + -B (β *B eval β p) +B -B ⟦ a ⟧ + ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval β p) ⟨ + -B eval β (a ∷ p) ∎ - eval-inverse-homomorphic : (β : CommutativeRing.Carrier B) → (P : Polynomial) → - eval β (- P) ≈B -B (eval β P) - eval-inverse-homomorphic β (m , p) = begin - eval β (- (m , p)) - ≈⟨ eval-equiv β (-P p) ⟨ - eval-poly β (-P p) - ≈⟨ eval-poly-inverse-homomorphic β p ⟩ - -B eval-poly β p - ≈⟨ B.-‿cong (eval-equiv β p) ⟩ - -B eval β (m , p) - ∎ - - eval-isRingHomomorphism : (β : CommutativeRing.Carrier B) → IsRingHomomorphism - (CommutativeRing.rawRing +-*-commutativeRing) (CommutativeRing.rawRing B) (eval β) + eval-isRingHomomorphism : (β : CR.Carrier B) → IsRingHomo + (CR.rawRing +-*-commutativeRing) (CR.rawRing B) (eval β) eval-isRingHomomorphism β = record { isSemiringHomomorphism = record { isNearSemiringHomomorphism = record @@ -350,14 +274,14 @@ module PolynomialRingMorphism ---------------- Universal Property of Polynomial Rings ---------------- - x-mapsto-β : (β : CommutativeRing.Carrier B) → eval β (2 , (A0# ∷ A1# ∷ [])) ≈B β + x-mapsto-β : (β : CR.Carrier B) → eval β (A0# ∷ A1# ∷ []) ≈B β x-mapsto-β β = begin ⟦ A0# ⟧ +B β *B (⟦ A1# ⟧ +B β *B 0#) - ≈⟨ B.+-congʳ (MonoidHomomorphism.ε-homo (RingHomomorphism.+-monoidHomomorphism f)) ⟩ + ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟩ 0# +B (β *B (⟦ A1# ⟧ +B β *B 0#)) ≈⟨ B.+-identityˡ (β *B (⟦ A1# ⟧ +B β *B 0#))⟩ β *B (⟦ A1# ⟧ +B β *B 0#) - ≈⟨ B.*-congˡ (B.+-cong (RingHomomorphism.1#-homo f) (B.zeroʳ β)) ⟩ + ≈⟨ B.*-congˡ (B.+-cong (RingHomo.1#-homo f) (B.zeroʳ β)) ⟩ β *B (1# +B 0#) ≈⟨ B.*-congˡ (B.+-identityʳ 1#) ⟩ β *B 1# @@ -366,40 +290,42 @@ module PolynomialRingMorphism ∎ -- define a canonical inclusion homomorphism from R to R[x]) - i : A.Carrier → Polynomial - i r = (1 , (r ∷ [])) + ı : A.Carrier → Poly + ı r = r ∷ [] - eval-comm : (β : CommutativeRing.Carrier B) → ∀ (r : A.Carrier) → ⟦ r ⟧ ≈B eval β (i r) + eval-comm : (β : CR.Carrier B) → ∀ (r : A.Carrier) → ⟦ r ⟧ ≈B eval β (ı r) eval-comm β r = begin ⟦ r ⟧ ≈⟨ B.+-identityʳ ⟦ r ⟧ ⟨ ⟦ r ⟧ +B 0# ≈⟨ B.+-congˡ (B.zeroʳ β) ⟨ - eval β (1 , (r ∷ [])) + eval β (r ∷ []) ∎ - eval-unique : (β : CommutativeRing.Carrier B) → - ∀ (ϕ : RingHomomorphism {ℓ₁} {ℓ₁ L.⊔ ℓ₂} (PolyrawRing) (CommutativeRing.rawRing B)) → - (∀ (r : A.Carrier) → RingHomomorphism.⟦ ϕ ⟧ (i r) ≈B (⟦ r ⟧)) → - RingHomomorphism.⟦ ϕ ⟧ (2 , (A0# ∷ A1# ∷ [])) ≈B β → - ∀ (p : Polynomial) → RingHomomorphism.⟦ ϕ ⟧ p ≈B eval β p - eval-unique β ϕ _ _ (ℕ.zero , []) = MonoidHomomorphism.ε-homo (RingHomomorphism.+-monoidHomomorphism ϕ) - eval-unique β ϕ ϕ-comm x-mapsto-β (suc n , (a ∷ p)) = begin - RingHomomorphism.⟦ ϕ ⟧ (suc n , (a ∷ p)) - ≈⟨ S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism ϕ) - (cons ((A.+-identityʳ a)) (P.+-identityˡ (n , p))) ⟨ - RingHomomorphism.⟦ ϕ ⟧ ((1 , (a ∷ [])) + (suc n , (A0# ∷ p))) - ≈⟨ IsMagmaHomomorphism.homo (RingHomomorphism.+-isMagmaHomomorphism ϕ) - (1 , (a ∷ [])) (suc n , (A0# ∷ p)) ⟩ - RingHomomorphism.⟦ ϕ ⟧ (1 , (a ∷ [])) +B RingHomomorphism.⟦ ϕ ⟧ (suc n , (A0# ∷ p)) - ≈⟨ B.+-congˡ (S.IsRelHomomorphism.cong (RingHomomorphism.isRelHomomorphism ϕ) (shift-is-x* (p))) ⟩ - RingHomomorphism.⟦ ϕ ⟧ (1 , (a ∷ [])) +B RingHomomorphism.⟦ ϕ ⟧ ((2 , (A0# ∷ A1# ∷ [])) * (n , p)) - ≈⟨ B.+-congˡ (IsMagmaHomomorphism.homo (RingHomomorphism.*-isMagmaHomomorphism ϕ) - (2 , (A0# ∷ A1# ∷ [])) (n , p)) ⟩ - RingHomomorphism.⟦ ϕ ⟧ (1 , (a ∷ [])) +B RingHomomorphism.⟦ ϕ ⟧ (2 , (A0# ∷ A1# ∷ [])) *B (RingHomomorphism.⟦ ϕ ⟧ (n , p)) - ≈⟨ B.+-congˡ (B.*-cong x-mapsto-β (eval-unique β ϕ ϕ-comm x-mapsto-β (n , p))) ⟩ - RingHomomorphism.⟦ ϕ ⟧ (i a) +B β *B eval β (n , p) + eval-unique : (β : CR.Carrier B) → + ∀ (ϕ : RingHomo {ℓ₁} {ℓ₁ L.⊔ ℓ₂} (PolyrawRing) (CR.rawRing B)) → + (∀ (r : A.Carrier) → RingHomo.⟦ ϕ ⟧ (ı r) ≈B (⟦ r ⟧)) → + RingHomo.⟦ ϕ ⟧ (A0# ∷ A1# ∷ []) ≈B β → + ∀ (p : Poly) → RingHomo.⟦ ϕ ⟧ p ≈B eval β p + eval-unique β ϕ _ _ [] = MonHomo.ε-homo (+-monoidHom ϕ) + eval-unique β ϕ ϕ-comm x-mapsto-β (a ∷ p) = begin + RingHomo.⟦ ϕ ⟧ (a ∷ p) + ≈⟨ S.IsRelHomo.cong (isRelHomo ϕ) + (cons ((A.+-identityʳ a)) (P.+-identityˡ p)) ⟨ + RingHomo.⟦ ϕ ⟧ ((a ∷ []) +P (A0# ∷ p)) + ≈⟨ IsMagmaHomo.homo (+-isMagmaHomo ϕ) + (a ∷ []) (A0# ∷ p) ⟩ + RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ (A0# ∷ p) + ≈⟨ B.+-congˡ (S.IsRelHomo.cong (isRelHomo ϕ) (shiftp≈x*p p)) ⟩ + RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ ((A0# ∷ A1# ∷ []) *P p) + ≈⟨ B.+-congˡ (IsMagmaHomo.homo (*-isMagmaHomo ϕ) + (A0# ∷ A1# ∷ []) p) ⟩ + RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ + (A0# ∷ A1# ∷ []) *B (RingHomo.⟦ ϕ ⟧ p) + ≈⟨ B.+-congˡ (B.*-cong x-mapsto-β + (eval-unique β ϕ ϕ-comm x-mapsto-β p)) ⟩ + RingHomo.⟦ ϕ ⟧ (ı a) +B β *B eval β p ≈⟨ B.+-congʳ (ϕ-comm a) ⟩ - eval β (suc n , (a ∷ p)) + eval β (a ∷ p) ∎ diff --git a/src/Algebra/Polynomial/Morphism/Morphism2.agda b/src/Algebra/Polynomial/Morphism/Morphism2.agda deleted file mode 100644 index ef404a8fb3..0000000000 --- a/src/Algebra/Polynomial/Morphism/Morphism2.agda +++ /dev/null @@ -1,331 +0,0 @@ --- Polynomial Morphisms --- open import Algebra.Bundles using (CommutativeRing) -open import Algebra.Bundles - renaming (CommutativeRing to CR) - -module Algebra.Polynomial.Morphism.Morphism2 - {ℓ₁ ℓ₂} - (R : CR ℓ₁ ℓ₂) - where - -import Algebra.Definitions as Def -open import Algebra.Morphism.Bundles - renaming (RingHomomorphism to RingHomo; MonoidHomomorphism to MonHomo) -open import Algebra.Morphism.Structures - renaming (IsRingHomomorphism to IsRingHomo; IsMagmaHomomorphism to IsMagmaHomo) -open import Algebra.Polynomial.Poly.Base.CommutativeRing2 R - using (Poly; []≈ ; ≈[]; cons ; consˡ ; consʳ; IsZero⇒p≈[]; - p≈[]⇒IsZero; a·p≈a∷[]*p ; *-distrib-shift; shiftp≈x*p) - renaming ( refl to P-refl ; sym to P-sym ; _·_ to _·P_ - ; _+_ to _+P_ ; _*_ to _*P_; _≈_ to _≈P_; -_ to -P_) -open import Algebra.Polynomial.Poly.Properties.CommutativeRing2 R as P - using (+-*-commutativeRing; *-zeroˡ ; *-zeroʳ) - renaming ( rawRing to PolyrawRing; *-comm to P*-comm - ; +-identityˡ to +-P-identityˡ ; +-identityʳ to +-P-identityʳ - ; zeroˡ to P-zeroˡ; zeroʳ to P-zeroʳ) -open import Algebra.Properties.Group -open import Algebra.Properties.Ring using (-‿distribʳ-*) -open import Data.Product.Base using (proj₁ ; proj₂) -open import Data.List.Base as List using (List; []; _∷_) -open import Data.List.Relation.Unary.All -import Level as L -import Relation.Binary.Morphism.Structures as S - renaming (IsRelHomomorphism to IsRelHomo) - -open RingHomo - renaming ( +-isMagmaHomomorphism to +-isMagmaHomo - ; +-monoidHomomorphism to +-monoidHom - ; isRelHomomorphism to isRelHomo - ; *-isMagmaHomomorphism to *-isMagmaHomo) - hiding (⟦_⟧) - -module A = CR R -open A - hiding (distrib) - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ; -_ to -A_ - ; 0# to A0# - ; 1# to A1#) - -private - variable - a b : A - p : Poly - q : Poly - -module PolynomialRingMorphism - {ℓ₃ ℓ₄} - (B : CR ℓ₃ ℓ₄) - (f : RingHomo {ℓ₁} {ℓ₂} (CR.rawRing R) (CR.rawRing B)) - where - - module B = CR B - open B - using (distrib) - renaming - (_≈_ to _≈B_ - ; _+_ to _+B_ - ; _*_ to _*B_ - ; -_ to -B_ - ; setoid to B-Set) - using (0#; 1#) - - open import Relation.Binary.Reasoning.Setoid B-Set - open RingHomo f using (⟦_⟧) - - open Def {A = B.Carrier} (_≈B_) - --- evaluate the polynomial given an element β ∈ B - eval : CR.Carrier B → Poly → CR.Carrier B - eval β [] = 0# - eval β (a ∷ p) = ⟦ a ⟧ +B (β *B eval β p) - - eval-equiv : (β : CR.Carrier B) → (p : Poly) → eval β p ≈B (eval β p) - eval-equiv β [] = B.refl - eval-equiv β (a ∷ p) = B.+-congˡ (B.*-congˡ (eval-equiv β p)) - - eval-cong : ∀ {p : Poly} → ∀ {q : Poly} → (β : CR.Carrier B) - → p ≈P q → (eval β p) ≈B (eval β q) - eval-cong {p = []} {q = []} β p≈q = B.refl - eval-cong {p = []} {q = b ∷ q} β p≈q = begin - eval β [] - ≈⟨ B.zeroʳ β ⟨ - β *B 0# - ≈⟨ B.+-identityˡ (β *B eval β []) ⟨ - 0# +B β *B eval β [] - ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟨ - ⟦ A0# ⟧ +B β *B eval β [] - ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {p = []} {q = q} β - (P-sym (IsZero⇒p≈[] (tail (p≈[]⇒IsZero (P-sym p≈q))))))) ⟩ - ⟦ A0# ⟧ +B β *B eval β q - ≈⟨ B.+-congʳ (S.IsRelHomo.cong - (isRelHomo f) (head (p≈[]⇒IsZero (P-sym p≈q)))) ⟨ - eval β (b ∷ q) - ∎ - eval-cong {p = a ∷ p} {[]} β p≈q = begin - eval β (a ∷ p) - ≈⟨ B.+-congʳ (S.IsRelHomo.cong - (isRelHomo f) (head (p≈[]⇒IsZero p≈q))) ⟩ - ⟦ A0# ⟧ +B β *B eval β p - ≈⟨ B.+-congˡ (B.*-congˡ (eval-cong {p = p} {q = []} β - (IsZero⇒p≈[] (tail (p≈[]⇒IsZero p≈q))) )) ⟩ - ⟦ A0# ⟧ +B β *B eval β [] - ≈⟨ B.+-congʳ (MonHomo.ε-homo(+-monoidHom f)) ⟩ - 0# +B β *B eval β [] - ≈⟨ B.+-congˡ (B.zeroʳ β) ⟩ - 0# +B 0# - ≈⟨ B.+-identityʳ 0# ⟩ - eval β [] - ∎ - eval-cong {p = a ∷ p} {b ∷ q} β (cons a≈b p≈q) - = B.+-cong (S.IsRelHomo.cong (isRelHomo f) a≈b) - (B.*-congˡ (eval-cong β p≈q )) - - eval-+-homomorphic : (β : CR.Carrier B) → (p : Poly) → (q : Poly) → - eval β (p +P q) ≈B eval β p +B eval β q - eval-+-homomorphic β [] q = begin - eval β ([] +P q) - ≈⟨ eval-cong β (+-P-identityˡ q) ⟩ - eval β q - ≈⟨ B.+-identityˡ (eval β q) ⟨ - eval β [] +B eval β q - ∎ - eval-+-homomorphic β (a ∷ p) [] = B.sym (B.+-identityʳ (eval β (a ∷ p))) - eval-+-homomorphic β (a ∷ p) (b ∷ q) = begin - eval β ((a ∷ p) +P (b ∷ q)) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-+-homomorphic β p q)) ⟩ - ⟦ a +A b ⟧ +B (β *B (eval β p +B eval β q)) - ≈⟨ B.+-congˡ (proj₁ distrib β (eval β p) (eval β q)) ⟩ - ⟦ a +A b ⟧ +B (β *B eval β p +B β *B eval β q) - ≈⟨ B.+-congʳ (IsMagmaHomo.homo (+-isMagmaHomo f) a b) ⟩ - ⟦ a ⟧ +B ⟦ b ⟧ +B (β *B eval β p +B β *B eval β q) - ≈⟨ B.+-assoc (⟦ a ⟧ +B ⟦ b ⟧) (β *B eval β p) (β *B eval β q) ⟨ - ⟦ a ⟧ +B ⟦ b ⟧ +B β *B eval β p +B β *B eval β q - ≈⟨ B.+-congʳ (B.+-assoc ⟦ a ⟧ ⟦ b ⟧ (β *B eval β p)) ⟩ - ⟦ a ⟧ +B (⟦ b ⟧ +B β *B eval β p) +B β *B eval β q - ≈⟨ B.+-assoc (⟦ a ⟧) (⟦ b ⟧ +B β *B eval β p) (β *B eval β q) ⟩ - ⟦ a ⟧ +B ( ⟦ b ⟧ +B β *B eval β p +B (β *B eval β q)) - ≈⟨ B.+-congˡ (B.+-congʳ ((B.+-comm (β *B eval β p) ⟦ b ⟧))) ⟨ - ⟦ a ⟧ +B ((β *B eval β p) +B ⟦ b ⟧ +B (β *B eval β q)) - ≈⟨ B.+-congˡ (B.+-assoc (β *B eval β p) ⟦ b ⟧ (β *B eval β q)) ⟩ - ⟦ a ⟧ +B (β *B eval β p +B eval β (b ∷ q)) - ≈⟨ B.+-assoc ⟦ a ⟧ (β *B eval β p) (eval β (b ∷ q)) ⟨ - ⟦ a ⟧ +B β *B eval β p +B eval β (b ∷ q) - ∎ - - eval-1#-homomorphic : (β : CR.Carrier B) → eval β (A1# ∷ []) ≈B 1# - eval-1#-homomorphic β = begin - eval β (A1# ∷ []) ≈⟨ B.+-cong (RingHomo.1#-homo f) (B.zeroʳ β) ⟩ - 1# +B 0# ≈⟨ B.+-identityʳ 1# ⟩ - 1# ∎ - - eval-scale : (β : CR.Carrier B) → (a : A) → (p : Poly) → - eval β (a ·P p) ≈B eval β (a ∷ []) *B (eval β p) - eval-scale β a [] = begin - 0# ≈⟨ B.zeroʳ (⟦ a ⟧ +B β *B 0#) ⟨ - (⟦ a ⟧ +B β *B 0#) *B 0# ∎ - eval-scale β a (b ∷ p) = begin - ⟦ a *A b ⟧ +B β *B eval β (a ·P p) - ≈⟨ B.+-congʳ (IsMagmaHomo.homo (*-isMagmaHomo f) a b) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B eval β (a ·P p) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-scale β a p)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B (eval β (a ∷ []) *B (eval β p)) - ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-congˡ (B.zeroʳ β)))) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B β *B ((⟦ a ⟧ +B 0#) *B (eval β p)) - ≈⟨ B.+-congˡ (B.*-congˡ (B.*-congʳ (B.+-identityʳ ⟦ a ⟧))) ⟩ - ⟦ a ⟧ *B ⟦ b ⟧ +B β *B ((⟦ a ⟧ *B eval β p)) - ≈⟨ B.+-congˡ (B.*-assoc β ⟦ a ⟧ (eval β p)) ⟨ - ⟦ a ⟧ *B ⟦ b ⟧ +B (β *B (⟦ a ⟧) *B (eval β p)) - ≈⟨ B.+-congˡ (B.*-congʳ (B.*-comm β ⟦ a ⟧)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B (⟦ a ⟧ *B β) *B eval β p - ≈⟨ B.+-congˡ (B.*-assoc ⟦ a ⟧ β (eval β p)) ⟩ - (⟦ a ⟧ *B ⟦ b ⟧) +B ⟦ a ⟧ *B (β *B eval β p) - ≈⟨ proj₁ distrib ⟦ a ⟧ ⟦ b ⟧ ( β *B eval β p) ⟨ - (⟦ a ⟧) *B (⟦ b ⟧ +B β *B eval β p) - ≈⟨ B.*-congʳ (B.+-identityʳ ⟦ a ⟧) ⟨ - (⟦ a ⟧ +B 0#) *B (⟦ b ⟧ +B β *B eval β p) - ≈⟨ B.*-congʳ (B.+-congˡ (B.zeroʳ β)) ⟨ - (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval β p) - ∎ - - eval-shift : (β : CR.Carrier B) → (p : Poly) → eval β (A0# ∷ p) ≈B β *B eval β p - eval-shift β p = begin - ⟦ A0# ⟧ +B β *B eval β p - ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟩ - 0# +B β *B eval β p - ≈⟨ B.+-identityˡ (β *B eval β p) ⟩ - β *B eval β p - ∎ - - eval-*-homomorphic : (β : CR.Carrier B) → (p q : Poly) - → eval β (p *P q) ≈B eval β p *B eval β q - eval-*-homomorphic β [] q = begin - eval β ([] *P q) ≈⟨ eval-cong β (P-zeroˡ q) ⟩ - eval β [] ≈⟨ B.zeroˡ (eval β q) ⟨ - eval β [] *B eval β q ∎ - eval-*-homomorphic β (a ∷ p) q = begin - eval β ((a ∷ p) *P q) - ≈⟨ eval-cong {p = (a ∷ p) *P q} β P-refl ⟩ - eval β (a ·P q +P p *P (A0# ∷ q)) - ≈⟨ eval-+-homomorphic β (a ·P q) (p *P (A0# ∷ q)) ⟩ - eval β (a ·P q) +B eval β (p *P (A0# ∷ q)) - ≈⟨ B.+-cong (eval-scale β a q) (eval-*-homomorphic β p (A0# ∷ q)) ⟩ - ((eval β (a ∷ []) *B eval β q) +B (eval β p *B eval β (A0# ∷ q))) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-shift β q)) ⟩ - (eval β (a ∷ []) *B eval β q) +B (eval β p *B (β *B eval β q)) - ≈⟨ B.+-congˡ step ⟩ - (eval β (a ∷ []) *B eval β q) +B ((β *B eval β p) *B eval β q) - ≈⟨ proj₂ distrib (eval β q) (eval β (a ∷ [])) (β *B eval β p) ⟨ - ((eval β (a ∷ []) +B β *B eval β p) *B eval β q) - ≈⟨ B.*-congʳ ((B.+-congʳ (B.trans (B.+-congˡ - (B.zeroʳ β)) (B.+-identityʳ ⟦ a ⟧)))) ⟩ - (eval β (a ∷ p) *B eval β q) - ∎ - where - step : eval β p *B (β *B eval β q) ≈B (β *B eval β p) *B eval β q - step = begin - eval β p *B (β *B eval β q) - ≈⟨ B.*-assoc (eval β p) β (eval β q) ⟨ - (eval β p *B β) *B eval β q - ≈⟨ B.*-congʳ (B.*-comm (eval β p) β) ⟩ - (β *B eval β p) *B eval β q - ∎ - - eval-inverse-homomorphic : (β : CR.Carrier B) → (p : Poly) → - eval β (-P p) ≈B -B (eval β p) - eval-inverse-homomorphic β [] = B.sym (ε⁻¹≈ε B.+-group) - eval-inverse-homomorphic β (a ∷ p) = begin - eval β (-P (a ∷ p)) - ≈⟨ B.+-congˡ (B.*-congˡ (eval-inverse-homomorphic β p)) ⟩ - ⟦ -A a ⟧ +B β *B (-B (eval β p)) - ≈⟨ B.+-congˡ (-‿distribʳ-* (CR.ring B) β (eval β p)) ⟨ - ⟦ -A a ⟧ +B -B (β *B eval β p) - ≈⟨ B.+-congʳ (RingHomo.-‿homo f a) ⟩ - -B ⟦ a ⟧ +B -B (β *B eval β p) - ≈⟨ B.+-comm (-B (β *B eval β p)) (-B ⟦ a ⟧) ⟨ - -B (β *B eval β p) +B -B ⟦ a ⟧ - ≈⟨ ⁻¹-anti-homo-∙ B.+-group ⟦ a ⟧ (β *B eval β p) ⟨ - -B eval β (a ∷ p) - ∎ - - eval-isRingHomomorphism : (β : CR.Carrier B) → IsRingHomo - (CR.rawRing +-*-commutativeRing) (CR.rawRing B) (eval β) - eval-isRingHomomorphism β = record - { isSemiringHomomorphism = record - { isNearSemiringHomomorphism = record - { +-isMonoidHomomorphism = record - { isMagmaHomomorphism = record - { isRelHomomorphism = record - { cong = eval-cong β } - ; homo = eval-+-homomorphic β - } - ; ε-homo = B.refl - } - ; *-homo = eval-*-homomorphic β - } - ; 1#-homo = eval-1#-homomorphic β - } - ; -‿homo = eval-inverse-homomorphic β - } - ----------------- Universal Property of Polynomial Rings ---------------- - - x-mapsto-β : (β : CR.Carrier B) → eval β (A0# ∷ A1# ∷ []) ≈B β - x-mapsto-β β = begin - ⟦ A0# ⟧ +B β *B (⟦ A1# ⟧ +B β *B 0#) - ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟩ - 0# +B (β *B (⟦ A1# ⟧ +B β *B 0#)) - ≈⟨ B.+-identityˡ (β *B (⟦ A1# ⟧ +B β *B 0#))⟩ - β *B (⟦ A1# ⟧ +B β *B 0#) - ≈⟨ B.*-congˡ (B.+-cong (RingHomo.1#-homo f) (B.zeroʳ β)) ⟩ - β *B (1# +B 0#) - ≈⟨ B.*-congˡ (B.+-identityʳ 1#) ⟩ - β *B 1# - ≈⟨ B.*-identityʳ β ⟩ - β - ∎ - --- define a canonical inclusion homomorphism from R to R[x]) - ı : A.Carrier → Poly - ı r = r ∷ [] - - eval-comm : (β : CR.Carrier B) → ∀ (r : A.Carrier) → ⟦ r ⟧ ≈B eval β (ı r) - eval-comm β r = begin - ⟦ r ⟧ - ≈⟨ B.+-identityʳ ⟦ r ⟧ ⟨ - ⟦ r ⟧ +B 0# - ≈⟨ B.+-congˡ (B.zeroʳ β) ⟨ - eval β (r ∷ []) - ∎ - - eval-unique : (β : CR.Carrier B) → - ∀ (ϕ : RingHomo {ℓ₁} {ℓ₁ L.⊔ ℓ₂} (PolyrawRing) (CR.rawRing B)) → - (∀ (r : A.Carrier) → RingHomo.⟦ ϕ ⟧ (ı r) ≈B (⟦ r ⟧)) → - RingHomo.⟦ ϕ ⟧ (A0# ∷ A1# ∷ []) ≈B β → - ∀ (p : Poly) → RingHomo.⟦ ϕ ⟧ p ≈B eval β p - eval-unique β ϕ _ _ [] = MonHomo.ε-homo (+-monoidHom ϕ) - eval-unique β ϕ ϕ-comm x-mapsto-β (a ∷ p) = begin - RingHomo.⟦ ϕ ⟧ (a ∷ p) - ≈⟨ S.IsRelHomo.cong (isRelHomo ϕ) - (cons ((A.+-identityʳ a)) (P.+-identityˡ p)) ⟨ - RingHomo.⟦ ϕ ⟧ ((a ∷ []) +P (A0# ∷ p)) - ≈⟨ IsMagmaHomo.homo (+-isMagmaHomo ϕ) - (a ∷ []) (A0# ∷ p) ⟩ - RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ (A0# ∷ p) - ≈⟨ B.+-congˡ (S.IsRelHomo.cong (isRelHomo ϕ) (shiftp≈x*p p)) ⟩ - RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ ((A0# ∷ A1# ∷ []) *P p) - ≈⟨ B.+-congˡ (IsMagmaHomo.homo (*-isMagmaHomo ϕ) - (A0# ∷ A1# ∷ []) p) ⟩ - RingHomo.⟦ ϕ ⟧ (a ∷ []) +B RingHomo.⟦ ϕ ⟧ - (A0# ∷ A1# ∷ []) *B (RingHomo.⟦ ϕ ⟧ p) - ≈⟨ B.+-congˡ (B.*-cong x-mapsto-β - (eval-unique β ϕ ϕ-comm x-mapsto-β p)) ⟩ - RingHomo.⟦ ϕ ⟧ (ı a) +B β *B eval β p - ≈⟨ B.+-congʳ (ϕ-comm a) ⟩ - eval β (a ∷ p) - ∎ - diff --git a/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda b/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda index b5670936c3..3f6d16b3fa 100644 --- a/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda +++ b/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda @@ -3,152 +3,9 @@ open import Algebra.Bundles using (CommutativeRing) module Algebra.Polynomial.Poly.Base.CommutativeRing {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) where - -open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -import Data.Nat.Properties as ℕ -open import Data.Vec.Base as Vec using (Vec; []; _∷_) -open import Data.Vec.Relation.Unary.All using (All ; []; _∷_) -import Level as L -open import Relation.Binary.PropositionalEquality.Core using (cong) -open import Relation.Binary.PropositionalEquality - using (_≡_; cong; module ≡-Reasoning) - -infix 8 -_ -infixl 7 _*_ -infix 7 _·_ -infixl 6 _+_ -infix 4 _≈_ - + +open import Algebra.Polynomial.Poly.Properties.Ring (CommutativeRing.ring R) public module CR = CommutativeRing R -open CR - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ; -_ to -A_) - using (0#; 1#) - -private - variable - m n k l : ℕ - a b c d : A - --- Polynomial of degree most n is represented as a vector of length n + 1 --- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∷ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ - -Poly : ℕ → Set ℓ₁ -Poly n = Vec A n - -private - variable - p : Poly m - q : Poly n - r : Poly k - s : Poly l - -zeros : (n : ℕ) → Poly n -zeros n = Vec.replicate n (0#) - --- Scaling a polynomial by a -_·_ : A → Poly n → Poly n -a · p = Vec.map (a *A_) p - --- Multiply a polynomial by x -shift : Poly n → Poly (suc n) -shift p = 0# ∷ p - --- Multiply a polynomial by xⁿ -shift-by-n : (n : ℕ) → Poly m → Poly (n ℕ.+ m) -shift-by-n 0 p = p -shift-by-n (suc n) p = 0# ∷ shift-by-n n p - -IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) -IsZero = All (_≈A 0#) - --- The additive inverse --_ : Poly n → Poly n -- p = Vec.map -A_ p - ------------------------------------------------------------------- --- The representation of a polynomial is not unique --- because we allow coefficients to be zero --- We define an equivalence relation which takes this into account - -data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where - []≈ : (q : Poly n) → IsZero q → [] ≈ q - ≈[] : (p : Poly m) → IsZero p → p ≈ [] - cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) - ------------------------------------------------------------------- --- Properties of Polynomial Equality - -zeros-unique : IsZero p → IsZero q → p ≈ q -zeros-unique [] [] = []≈ [] [] -zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) -zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) -zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = cons (CR.trans a≈0 (CR.sym b≈0)) (zeros-unique p≈0 q≈0) - -IsZero-cong : IsZero p → p ≈ q → IsZero q -IsZero-cong [] ([]≈ q q≈0) = q≈0 -IsZero-cong [] (≈[] p p≈0) = p≈0 -IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] -IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) - = (CR.trans (CR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q - ------------------------------------------------------------------- --- _≈_ is an equivalence relation - -refl : p ≈ p -refl {p = []} = []≈ [] [] -refl {p = a ∷ p} = cons CR.refl refl - -sym : p ≈ q → q ≈ p -sym ([]≈ q q≈0) = ≈[] q q≈0 -sym (≈[] p p≈0) = []≈ p p≈0 -sym (cons a≈b p≈q) = cons (CR.sym a≈b) (sym p≈q) - -trans : p ≈ q → q ≈ r → p ≈ r -trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) -trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) -trans (cons a≈b p≈q) (≈[] q q≈0) - = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) -trans (cons a≈b p≈q) (cons b≈c q≈r) - = cons (CR.trans a≈b b≈c) (trans p≈q q≈r) - -consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) -consˡ a≈b = cons a≈b refl - -consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) -consʳ = cons CR.refl - ----------------------------------------------------------------- --- Operations --- Addition -_+_ : Poly m → Poly n → Poly (m ⊔ n) -[] + [] = [] -[] + (a ∷ p) = a ∷ p -(a ∷ p) + [] = a ∷ p -(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) -private - pred[n+sucm]≡n+m : ∀ n → ∀ m → pred (n ℕ.+ suc m) ≡ n ℕ.+ m - pred[n+sucm]≡n+m n m = begin - pred (n ℕ.+ suc m) ≡⟨ cong pred (ℕ.+-comm n (suc m)) ⟩ - pred (suc m ℕ.+ n) ≡⟨ ℕ.+-comm m n ⟩ - n ℕ.+ m ∎ - where open ≡-Reasoning - -cast-lem : ∀ m → ∀ n → m ⊔ pred (n ℕ.+ suc m) ≡ (n ℕ.+ m) -cast-lem m n = begin - m ⊔ pred (n ℕ.+ suc m) ≡⟨ cong (m ⊔_) (pred[n+sucm]≡n+m n m) ⟩ - m ⊔ (n ℕ.+ m) ≡⟨ ℕ.m≤n⇒m⊔n≡n (ℕ.m≤n+m m n) ⟩ - n ℕ.+ m ∎ - where open ≡-Reasoning --- Multiplication -_*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) -_*_ {m = m} [] p = zeros (pred m) -_*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) diff --git a/src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda b/src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda deleted file mode 100644 index ecff4c578e..0000000000 --- a/src/Algebra/Polynomial/Poly/Base/CommutativeRing2.agda +++ /dev/null @@ -1,11 +0,0 @@ -open import Algebra.Bundles using (CommutativeRing) - -module Algebra.Polynomial.Poly.Base.CommutativeRing2 - {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) - where - -open import Algebra.Polynomial.Poly.Properties.Ring2 (CommutativeRing.ring R) public -module CR = CommutativeRing R - - - diff --git a/src/Algebra/Polynomial/Poly/Base/Ring.agda b/src/Algebra/Polynomial/Poly/Base/Ring.agda index 8d403764df..9cbc70c9a5 100644 --- a/src/Algebra/Polynomial/Poly/Base/Ring.agda +++ b/src/Algebra/Polynomial/Poly/Base/Ring.agda @@ -3,150 +3,16 @@ open import Algebra.Bundles using (Ring) module Algebra.Polynomial.Poly.Base.Ring {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) where - -open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -import Data.Nat.Properties as ℕ -open import Data.Vec.Base as Vec using (Vec; []; _∷_) -open import Data.Vec.Relation.Unary.All using (All ; []; _∷_) -import Level as L -open import Relation.Binary.PropositionalEquality.Core using (cong) -open import Relation.Binary.PropositionalEquality - using (_≡_; cong; module ≡-Reasoning) + +open import Algebra.Polynomial.Poly.Properties.Semiring (Ring.semiring R) public +open import Data.List.Base as List using (List; []; _∷_) module R = Ring R -open R - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ; -_ to -A_) - using (0#; 1#) - -infix 8 -_ -infixl 7 _*_ -infix 7 _·_ -infixl 6 _+_ -infix 4 _≈_ - -private - variable - m n k l : ℕ - a b c d : A - --- Polynomial of degree most n is represented as a vector of length n + 1 --- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∷ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ - -Poly : ℕ → Set ℓ₁ -Poly n = Vec A n private variable - p : Poly m - q : Poly n - r : Poly k - s : Poly l - -zeros : (n : ℕ) → Poly n -zeros n = Vec.replicate n (0#) - --- Scaling a polynomial by a -_·_ : A → Poly n → Poly n -a · p = Vec.map (a *A_) p - --- Multiply a polynomial by x -shift : Poly n → Poly (suc n) -shift p = 0# ∷ p - --- Multiply a polynomial by xⁿ -shift-by-n : (n : ℕ) → Poly m → Poly (n ℕ.+ m) -shift-by-n 0 p = p -shift-by-n (suc n) p = 0# ∷ shift-by-n n p - -IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) -IsZero = All (_≈A 0#) - --- The additive inverse --_ : Poly n → Poly n -- p = Vec.map -A_ p - --- The representation of a polynomial is not unique --- because we allow coefficients to be zero --- We define an equivalence relation which takes this into account - -data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where - []≈ : (q : Poly n) → IsZero q → [] ≈ q - ≈[] : (p : Poly m) → IsZero p → p ≈ [] - cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) - --- Properties of Polynomial Equality - -zeros-unique : IsZero p → IsZero q → p ≈ q -zeros-unique [] [] = []≈ [] [] -zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) -zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) -zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = cons (R.trans a≈0 (R.sym b≈0)) (zeros-unique p≈0 q≈0) - -IsZero-cong : IsZero p → p ≈ q → IsZero q -IsZero-cong [] ([]≈ q q≈0) = q≈0 -IsZero-cong [] (≈[] p p≈0) = p≈0 -IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] -IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) - = (R.trans (R.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q - --- _≈_ is an equivalence relation - -refl : p ≈ p -refl {p = []} = []≈ [] [] -refl {p = a ∷ p} = cons R.refl refl - -sym : p ≈ q → q ≈ p -sym ([]≈ q q≈0) = ≈[] q q≈0 -sym (≈[] p p≈0) = []≈ p p≈0 -sym (cons a≈b p≈q) = cons (R.sym a≈b) (sym p≈q) - -trans : p ≈ q → q ≈ r → p ≈ r -trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) -trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) -trans (cons a≈b p≈q) (≈[] q q≈0) - = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) -trans (cons a≈b p≈q) (cons b≈c q≈r) - = cons (R.trans a≈b b≈c) (trans p≈q q≈r) - -consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) -consˡ a≈b = cons a≈b refl - -consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) -consʳ = cons R.refl - ----------------------------------------------------------------- --- Operations - --- Addition -_+_ : Poly m → Poly n → Poly (m ⊔ n) -[] + [] = [] -[] + (a ∷ p) = a ∷ p -(a ∷ p) + [] = a ∷ p -(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) - -private - pred[n+sucm]≡n+m : ∀ n → ∀ m → pred (n ℕ.+ suc m) ≡ n ℕ.+ m - pred[n+sucm]≡n+m n m = begin - pred (n ℕ.+ suc m) ≡⟨ cong pred (ℕ.+-comm n (suc m)) ⟩ - pred (suc m ℕ.+ n) ≡⟨ ℕ.+-comm m n ⟩ - n ℕ.+ m ∎ - where open ≡-Reasoning - -cast-lem : ∀ m → ∀ n → m ⊔ pred (n ℕ.+ suc m) ≡ (n ℕ.+ m) -cast-lem m n = begin - m ⊔ pred (n ℕ.+ suc m) ≡⟨ cong (m ⊔_) (pred[n+sucm]≡n+m n m) ⟩ - m ⊔ (n ℕ.+ m) ≡⟨ ℕ.m≤n⇒m⊔n≡n (ℕ.m≤n+m m n) ⟩ - n ℕ.+ m ∎ - where open ≡-Reasoning - --- Multiplication -_*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) -_*_ {m = m} [] p = zeros (pred m) -_*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) + p : Poly +-- Polynomial subtraction +-_ : Poly → Poly +- p = List.map R.-_ p diff --git a/src/Algebra/Polynomial/Poly/Base/Ring2.agda b/src/Algebra/Polynomial/Poly/Base/Ring2.agda deleted file mode 100644 index 07939515b9..0000000000 --- a/src/Algebra/Polynomial/Poly/Base/Ring2.agda +++ /dev/null @@ -1,18 +0,0 @@ -open import Algebra.Bundles using (Ring) - -module Algebra.Polynomial.Poly.Base.Ring2 - {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) - where - -open import Algebra.Polynomial.Poly.Properties.Semiring2 (Ring.semiring R) public -open import Data.List.Base as List using (List; []; _∷_) - -module R = Ring R - -private - variable - p : Poly - --- Polynomial subtraction --_ : Poly → Poly -- p = List.map R.-_ p diff --git a/src/Algebra/Polynomial/Poly/Base/Semiring.agda b/src/Algebra/Polynomial/Poly/Base/Semiring.agda index 848af27bae..c4fcea3bb3 100644 --- a/src/Algebra/Polynomial/Poly/Base/Semiring.agda +++ b/src/Algebra/Polynomial/Poly/Base/Semiring.agda @@ -4,75 +4,70 @@ module Algebra.Polynomial.Poly.Base.Semiring {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where -open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -import Data.Nat.Properties as ℕ -open import Data.Vec.Base as Vec using (Vec; []; _∷_) -open import Data.Vec.Relation.Unary.All using (All ; []; _∷_) +open import Agda.Builtin.List using (List; []; _∷_) +open import Data.List.Base as List +open import Data.List.Relation.Unary.All using (All ; [] ; _∷_) +open import Data.Nat.Base as ℕ using (ℕ; suc) import Level as L -open import Relation.Binary.PropositionalEquality.Core using (cong) -open import Relation.Binary.PropositionalEquality - using (_≡_; cong; module ≡-Reasoning) module SR = Semiring SR open SR - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ) - using (0#; 1#) + renaming + ( Carrier to A + ; _≈_ to _≈A_ + ; _+_ to _+A_ + ; _*_ to _*A_ + ) + using (0#; 1#) infixl 7 _*_ infix 7 _·_ infixl 6 _+_ infix 4 _≈_ + private variable - m n k l : ℕ - a b c d : A + a b : A + --- Polynomial of degree most n is represented as a vector of length n + 1 --- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∷ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ +-- Polynomial is represented as a list +-- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∶ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ +-- [] represents the zero polynomial 0 -Poly : ℕ → Set ℓ₁ -Poly n = Vec A n +Poly : Set ℓ₁ +Poly = List A private variable - p : Poly m - q : Poly n - r : Poly k - s : Poly l - -zeros : (n : ℕ) → Poly n -zeros n = Vec.replicate n (0#) - + p : Poly + q : Poly + r : Poly + -- Scaling a polynomial by a -_·_ : A → Poly n → Poly n -a · p = Vec.map (a *A_) p +_·_ : A → Poly → Poly +a · p = List.map (a *A_) p --- Multiply a polynomial by x -shift : Poly n → Poly (suc n) +-- Multiply a polynomial by x +shift : Poly → Poly shift p = 0# ∷ p - + -- Multiply a polynomial by xⁿ -shift-by-n : (n : ℕ) → Poly m → Poly (n ℕ.+ m) +shift-by-n : (n : ℕ) → Poly → Poly shift-by-n 0 p = p shift-by-n (suc n) p = 0# ∷ shift-by-n n p -IsZero : Poly n → Set (ℓ₁ L.⊔ ℓ₂) +IsZero : Poly → Set (ℓ₁ L.⊔ ℓ₂) IsZero = All (_≈A 0#) -- The representation of a polynomial is not unique -- because we allow coefficients to be zero -- We define an equivalence relation which takes this into account -data _≈_ : (Poly m) → (Poly n) → Set (ℓ₁ L.⊔ ℓ₂) where - []≈ : (q : Poly n) → IsZero q → [] ≈ q - ≈[] : (p : Poly m) → IsZero p → p ≈ [] - cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) +data _≈_ : Poly → Poly → Set (ℓ₁ L.⊔ ℓ₂) where + []≈ : (q : Poly) → IsZero q → [] ≈ q + ≈[] : (p : Poly) → IsZero p → p ≈ [] + cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) -- Properties of Polynomial Equality @@ -114,34 +109,21 @@ consˡ a≈b = cons a≈b refl consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) consʳ = cons SR.refl - + ---------------------------------------------------------------- -- Operations -- Addition -_+_ : Poly m → Poly n → Poly (m ⊔ n) +_+_ : Poly → Poly → Poly [] + [] = [] [] + (a ∷ p) = a ∷ p (a ∷ p) + [] = a ∷ p (a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) -private - pred[n+sucm]≡n+m : ∀ n → ∀ m → pred (n ℕ.+ suc m) ≡ n ℕ.+ m - pred[n+sucm]≡n+m n m = begin - pred (n ℕ.+ suc m) ≡⟨ cong pred (ℕ.+-comm n (suc m)) ⟩ - pred (suc m ℕ.+ n) ≡⟨ ℕ.+-comm m n ⟩ - n ℕ.+ m ∎ - where open ≡-Reasoning - -cast-lem : ∀ m → ∀ n → m ⊔ pred (n ℕ.+ suc m) ≡ (n ℕ.+ m) -cast-lem m n = begin - m ⊔ pred (n ℕ.+ suc m) ≡⟨ cong (m ⊔_) (pred[n+sucm]≡n+m n m) ⟩ - m ⊔ (n ℕ.+ m) ≡⟨ ℕ.m≤n⇒m⊔n≡n (ℕ.m≤n+m m n) ⟩ - n ℕ.+ m ∎ - where open ≡-Reasoning - -- Multiplication -_*_ : Poly n → Poly m → Poly (pred (n ℕ.+ m)) -_*_ {m = m} [] p = zeros (pred m) -_*_ {suc n} {m} (a ∷ p) q = Vec.cast (cast-lem m n) ((a · q) + (p * (0# ∷ q))) +_*_ : Poly → Poly → Poly +_*_ [] p = [] +_*_ (a ∷ p) q = (a · q) + (p * (0# ∷ q)) + + diff --git a/src/Algebra/Polynomial/Poly/Base/Semiring2.agda b/src/Algebra/Polynomial/Poly/Base/Semiring2.agda deleted file mode 100644 index 8b673a8bd8..0000000000 --- a/src/Algebra/Polynomial/Poly/Base/Semiring2.agda +++ /dev/null @@ -1,129 +0,0 @@ -open import Algebra.Bundles using (Semiring) - -module Algebra.Polynomial.Poly.Base.Semiring2 - {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) - where - -open import Agda.Builtin.List using (List; []; _∷_) -open import Data.List.Base as List -open import Data.List.Relation.Unary.All using (All ; [] ; _∷_) -open import Data.Nat.Base as ℕ using (ℕ; suc) -import Level as L - -module SR = Semiring SR -open SR - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ) - using (0#; 1#) - -infixl 7 _*_ -infix 7 _·_ -infixl 6 _+_ -infix 4 _≈_ - - -private - variable - a b : A - - --- Polynomial is represented as a list --- a₀ ∷ a₁ ∷ ⋯ ∷ aₙ ∶ [] represents the polynomial a₀ + a₁x + ⋯ + aₙxⁿ --- [] represents the zero polynomial 0 - -Poly : Set ℓ₁ -Poly = List A - -private - variable - p : Poly - q : Poly - r : Poly - --- Scaling a polynomial by a -_·_ : A → Poly → Poly -a · p = List.map (a *A_) p - --- Multiply a polynomial by x -shift : Poly → Poly -shift p = 0# ∷ p - --- Multiply a polynomial by xⁿ -shift-by-n : (n : ℕ) → Poly → Poly -shift-by-n 0 p = p -shift-by-n (suc n) p = 0# ∷ shift-by-n n p - -IsZero : Poly → Set (ℓ₁ L.⊔ ℓ₂) -IsZero = All (_≈A 0#) - --- The representation of a polynomial is not unique --- because we allow coefficients to be zero --- We define an equivalence relation which takes this into account - -data _≈_ : Poly → Poly → Set (ℓ₁ L.⊔ ℓ₂) where - []≈ : (q : Poly) → IsZero q → [] ≈ q - ≈[] : (p : Poly) → IsZero p → p ≈ [] - cons : (a ≈A b) → (p ≈ q) → (a ∷ p) ≈ (b ∷ q) - --- Properties of Polynomial Equality - -zeros-unique : IsZero p → IsZero q → p ≈ q -zeros-unique [] [] = []≈ [] [] -zeros-unique [] (a≈0 ∷ p≈0) = []≈ (_ ∷ _) (a≈0 ∷ p≈0) -zeros-unique (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) -zeros-unique (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = cons (SR.trans a≈0 (SR.sym b≈0)) (zeros-unique p≈0 q≈0) - -IsZero-cong : IsZero p → p ≈ q → IsZero q -IsZero-cong [] ([]≈ q q≈0) = q≈0 -IsZero-cong [] (≈[] p p≈0) = p≈0 -IsZero-cong (a≈0 ∷ p≈0) (≈[] a∷p a∷p≈0) = [] -IsZero-cong (a≈0 ∷ p≈0) (cons a≈b p≈q) - = (SR.trans (SR.sym a≈b) a≈0) ∷ IsZero-cong p≈0 p≈q - --- _≈_ is an equivalence relation - -refl : p ≈ p -refl {p = []} = []≈ [] [] -refl {p = a ∷ p} = cons SR.refl refl - -sym : p ≈ q → q ≈ p -sym ([]≈ q q≈0) = ≈[] q q≈0 -sym (≈[] p p≈0) = []≈ p p≈0 -sym (cons a≈b p≈q) = cons (SR.sym a≈b) (sym p≈q) - -trans : p ≈ q → q ≈ r → p ≈ r -trans {r = r} ([]≈ q q≈0) q≈r = []≈ r (IsZero-cong q≈0 q≈r) -trans (≈[] p p≈0) q≈r = zeros-unique p≈0 (IsZero-cong [] q≈r) -trans (cons a≈b p≈q) (≈[] q q≈0) - = ≈[] _ (IsZero-cong q≈0 (sym (cons a≈b p≈q))) -trans (cons a≈b p≈q) (cons b≈c q≈r) - = cons (SR.trans a≈b b≈c) (trans p≈q q≈r) - -consˡ : (a ≈A b) → (a ∷ p) ≈ (b ∷ p) -consˡ a≈b = cons a≈b refl - -consʳ : p ≈ q → (a ∷ p) ≈ (a ∷ q) -consʳ = cons SR.refl - ----------------------------------------------------------------- --- Operations - --- Addition -_+_ : Poly → Poly → Poly -[] + [] = [] -[] + (a ∷ p) = a ∷ p -(a ∷ p) + [] = a ∷ p -(a ∷ p) + (b ∷ q) = (a +A b) ∷ (p + q) - --- Multiplication -_*_ : Poly → Poly → Poly -_*_ [] p = [] -_*_ (a ∷ p) q = (a · q) + (p * (0# ∷ q)) - - - diff --git a/src/Algebra/Polynomial/Poly/Properties/CommutativeRing.agda b/src/Algebra/Polynomial/Poly/Properties/CommutativeRing.agda index af17b46aec..6ba508e082 100644 --- a/src/Algebra/Polynomial/Poly/Properties/CommutativeRing.agda +++ b/src/Algebra/Polynomial/Poly/Properties/CommutativeRing.agda @@ -3,22 +3,24 @@ open import Algebra.Bundles using (CommutativeRing) module Algebra.Polynomial.Poly.Properties.CommutativeRing {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) where - -open import Algebra.Polynomial.Poly.Base.CommutativeRing R as P - using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) + +import Algebra.Definitions as Def +open import Algebra.Polynomial.Poly.Base.CommutativeRing R as P public + using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; module CR) +open import Algebra.Polynomial.Poly.Properties.Ring (CommutativeRing.ring R) public hiding ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ) open import Algebra.Properties.Ring -open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -import Data.Nat.Properties as ℕ -open import Data.Vec.Base as Vec using (Vec; []; _∷_) -open import Data.Vec.Relation.Unary.All using (All ; []; _∷_; head; tail) -import Level as L -open import Relation.Binary -open import Relation.Binary.PropositionalEquality as Eq - using (_≡_; module ≡-Reasoning) -open import Relation.Binary.PropositionalEquality.Core using (cong) +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsGroup; IsAbelianGroup; IsCommutativeMonoid; IsSemiring + ; IsRing; IsCommutativeSemiring; IsCommutativeRing ) +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All using (All ; []; _∷_) +open import Data.Product.Base using (_,_) + +open ≈-Reasoning -module CR = CommutativeRing R open CR renaming ( Carrier to A @@ -28,440 +30,68 @@ open CR ; -_ to -A_) using (0#; 1#) -private - variable - m n k l : ℕ - a b c d : A - p : Poly m - q : Poly n - r : Poly k - s : Poly l - ---------------------------------------------------------------------- --- Equational reasoning for Poly n and Poly m --- where m is not necesarily the same as n -private - - infix 4 _IsRelatedTo_ - - data _IsRelatedTo_ (p : Poly m) (q : Poly n) : Set (ℓ₁ L.⊔ ℓ₂) where - relTo : (p≈q : p ≈ q) → p IsRelatedTo q - - start : _IsRelatedTo_ {m} {n} ⇒ _≈_ - start (relTo p≈q) = p≈q - - ∼-go : Trans (_≈_) (_IsRelatedTo_ {n} {k}) (_IsRelatedTo_ {m} {k}) - ∼-go p≈q (relTo q≈r) = relTo (trans p≈q q≈r) - - stop : Reflexive (_IsRelatedTo_ {m} {m}) - stop = relTo refl - - forward : (p : Poly m) → q IsRelatedTo r → p ≈ q → p IsRelatedTo r - forward p qRr p≈q = ∼-go p≈q qRr - - backward : (p : Poly m) → q IsRelatedTo r → q ≈ p → p IsRelatedTo r - backward p qRr q≈p = ∼-go (sym q≈p) qRr - - infix 1 begin_ - begin_ : p IsRelatedTo q → p ≈ q - begin_ = start - - infixr 2 step-∼-⟩ - step-∼-⟩ = forward - syntax step-∼-⟩ p qRr p≈q = p ≈⟨ p≈q ⟩ qRr - - infixr 2 step-∼-⟨ - step-∼-⟨ = backward - syntax step-∼-⟨ p qRr q≈p = p ≈⟨ q≈p ⟨ qRr - - infix 3 _∎ - _∎ : (p : Poly m) → p IsRelatedTo p - p ∎ = stop - ------------------------------------------------------------------ --- Properties of zero polynomial - -zerosIsZero : (n : ℕ) → IsZero (zeros n) -zerosIsZero 0 = [] -zerosIsZero (suc n) = CR.refl ∷ (zerosIsZero n) - -zerosm≈zerosn : zeros m ≈ zeros n -zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) - -≈0⇒IsZero : p ≈ zeros m → IsZero p -≈0⇒IsZero ([]≈ zeros zeros≈0) = [] -≈0⇒IsZero (≈[] p p≈0) = p≈0 -≈0⇒IsZero (cons a≈0 p≈0) = a≈0 ∷ ≈0⇒IsZero p≈0 - -IsZero⇒≈0 : IsZero p → p ≈ zeros m -IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) - -All[p≈0∧q≈0]⇒p+q≈0 : All (_≈A 0#) p → All (_≈A 0#) q → All (_≈A 0#) (p + q) -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] [] = [] -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 -All[p≈0∧q≈0]⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = CR.trans (CR.+-cong a≈0 b≈0) (CR.+-identityˡ 0#) ∷ All[p≈0∧q≈0]⇒p+q≈0 p≈0 q≈0 - ------------------------------------------------------- --- Additive inverse - -[-p]+pIsZero : {p : Poly m} → IsZero ((- p) + p) -[-p]+pIsZero {p = []} = [] -[-p]+pIsZero {p = a ∷ p} = CR.-‿inverseˡ a ∷ [-p]+pIsZero - -p+[-p]IsZero : {p : Poly m} → IsZero (p + (- p)) -p+[-p]IsZero {p = []} = [] -p+[-p]IsZero {p = a ∷ p} = CR.-‿inverseʳ a ∷ p+[-p]IsZero - -+-inverseˡ : (p : Poly m) → (- p) + p ≈ [] -+-inverseˡ [] = refl -+-inverseˡ (a ∷ p) - = ≈[] ((- (a ∷ p)) + (a ∷ p)) (CR.-‿inverseˡ a ∷ [-p]+pIsZero) - -+-inverseʳ : (p : Poly m) → p + (- p) ≈ [] -+-inverseʳ [] = refl -+-inverseʳ (a ∷ p) - = ≈[] ((a ∷ p) + (- (a ∷ p))) ((CR.-‿inverseʳ a) ∷ p+[-p]IsZero) - -------------------------------------------------------- --- Negation is congruent - --⁺ : IsZero p → IsZero (- p) --⁺ [] = [] --⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε CR.ring a≈0 ∷ (-⁺ p≈0) - --⁻ : IsZero (- p) → IsZero p --⁻ {p = []} -p≈0 = -p≈0 --⁻ {p = a ∷ p} (-a≈0 ∷ -p≈0) = x⁻¹≈ε⇒x≈ε CR.ring -a≈0 ∷ (-⁻ -p≈0) - --‿cong : p ≈ q → - p ≈ - q --‿cong ([]≈ q q≈0) = []≈ (- q) (-⁺ q≈0) --‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) --‿cong (cons a≈b p≈q) = cons (CR.-‿cong a≈b) (-‿cong p≈q) - ------------------------------------------------------ --- Properties of polynomial addition - -+-comm : (p : Poly m) → (q : Poly n) → p + q ≈ q + p -+-comm [] [] = refl -+-comm [] (a ∷ p) = refl -+-comm (a ∷ p) [] = refl -+-comm (a ∷ p) (b ∷ q) = cons (CR.+-comm a b) (+-comm p q) - -+-idʳ : (p : Poly n) → (q : Poly m) → IsZero q → p + q ≈ p -+-idʳ [] q [] = refl -+-idʳ (a ∷ p) q [] = refl -+-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) -+-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) - = cons (CR.trans (CR.+-congˡ b≈0) (CR.+-identityʳ a)) (+-idʳ p q q≈0) - -+-idˡ : (p : Poly n) → (q : Poly m) → IsZero p → p + q ≈ q -+-idˡ p q p≈0 = begin - p + q ≈⟨ +-comm p q ⟩ - q + p ≈⟨ +-idʳ q p p≈0 ⟩ - q ∎ - -+-identityʳ : (p : Poly n) → p + (zeros m) ≈ p -+-identityʳ {m = m} p = +-idʳ p (zeros m) (zerosIsZero m) - -+-identityˡ : (p : Poly n) → (zeros m) + p ≈ p -+-identityˡ {m = m} p = +-idˡ (zeros m) p (zerosIsZero m) - -+-cong : p ≈ q → r ≈ s → p + r ≈ q + s -+-cong {p = _} {q = _} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin - [] + r ≈⟨ +-identityˡ r ⟩ - r ≈⟨ r≈s ⟩ - s ≈⟨ +-idˡ q s q≈0 ⟨ - q + s ∎ -+-cong {p = _} {q = _} {r = r} {s = s} (≈[] p p≈0) r≈s = begin - p + r ≈⟨ +-idˡ p r p≈0 ⟩ - r ≈⟨ r≈s ⟩ - s ≈⟨ +-identityˡ s ⟨ - [] + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} {r = _} {s = s} (cons a≈b p≈q) ([]≈ s s≈0) = begin - a ∷ p ≈⟨ cons a≈b p≈q ⟩ - b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ - (b ∷ q) + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} {r = r} {s = _} (cons a≈b p≈q) (≈[] r r≈0) = begin - (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ - a ∷ p ≈⟨ cons a≈b p≈q ⟩ - b ∷ q ∎ -+-cong (cons a≈b p≈q) (cons c≈d r≈s) - = cons (CR.+-cong a≈b c≈d) (+-cong p≈q r≈s) - -+-congˡ : p ≈ q → p + r ≈ q + r -+-congˡ p≈q = +-cong p≈q refl - -+-congʳ : q ≈ r → p + q ≈ p + r -+-congʳ q≈r = +-cong refl q≈r - -+-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → - (p + q) + r ≈ p + (q + r) -+-assoc [] q r = begin - ([] + q) + r ≈⟨ +-congˡ (+-identityˡ q) ⟩ - q + r ≈⟨ +-identityˡ (q + r) ⟨ - [] + (q + r) ∎ -+-assoc (a ∷ p) [] r = +-congʳ (sym (+-identityˡ r)) -+-assoc (a ∷ p) (b ∷ q) [] = refl -+-assoc (a ∷ p) (b ∷ q) (c ∷ r) - = cons (CR.+-assoc a b c) (+-assoc p q r) - -middleFour : (p : Poly m) → (q : Poly n) → (r : Poly k) → (w : Poly l) → - (p + q) + (r + w) ≈ (p + r) + (q + w) -middleFour p q r w = begin - (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ - (p + q + r) + w ≈⟨ +-congˡ (+-assoc p q r) ⟩ - (p + (q + r)) + w ≈⟨ +-congˡ (+-congʳ (+-comm q r)) ⟩ - (p + (r + q)) + w ≈⟨ +-congˡ (+-assoc p r q) ⟨ - (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ - (p + r) + (q + w) ∎ - ------------------------------------------------------------------- --- Vector casting lemmas +open Def _≈_ private - n+1≡sucn+0 : (n ℕ.+ 1) ≡ suc (n ℕ.+ 0) - n+1≡sucn+0 {0} = Eq.refl - n+1≡sucn+0 {suc n} = cong suc n+1≡sucn+0 - - cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → - All (_≈A 0#) (Vec.cast m≡n p) - cast-p≈0⇒p≈0 {n = 0} {[]} m≡n [] = [] - cast-p≈0⇒p≈0 {n = suc n} {a ∷ p} m≡n (a≈0 ∷ p≈0) - = a≈0 ∷ cast-p≈0⇒p≈0 (cong pred m≡n) p≈0 - -cast-p≈p : (m≡n : m ≡ n) → Vec.cast m≡n p ≈ p -cast-p≈p {n = 0} {[]} Eq.refl = refl -cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) - ------------------------------------------------------------------- --- Properties of polynomial shifting - -*-distrib-shift : (p : Poly m) → (q : Poly n) → - p * (shift q) ≈ shift (p * q) -*-distrib-shift {_} {_} [] qs = zerosm≈zerosn -*-distrib-shift {suc m} {n} (a ∷ p) q = begin - (a ∷ p) * (0# ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ - a · (0# ∷ q) + p * (0# ∷ 0# ∷ q) - ≈⟨ +-congˡ (consˡ (CR.zeroʳ a)) ⟩ - (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) - ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ - (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ consˡ (CR.+-identityˡ 0#) ⟩ - 0# ∷ (a · q + p * (0# ∷ q)) - ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟨ - 0# ∷ ((a ∷ p) * q) - ∎ - -·-distrib-shift : (a : A) → (p : Poly m) → a · (shift p) ≈ shift (a · p) -·-distrib-shift a [] = cons (CR.zeroʳ a) (refl) -·-distrib-shift a (b ∷ p) = consˡ (CR.zeroʳ a) - ----------------------------------------------------------------- --- Properties of polynomial scaling - -a·p≈a∷[]*p : (a : A) → (p : Poly n) → a · p ≈ (a ∷ []) * p -a·p≈a∷[]*p {_} a [] = refl -a·p≈a∷[]*p {suc n} a (b ∷ p) = begin - a · (b ∷ p) - ≈⟨ cons (CR.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ - a *A b +A 0# ∷ (a · p + zeros n) - ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟨ - (a ∷ []) * (b ∷ p) ∎ - -pIsZero⇒a·pIsZero : (a : A) → (p : Poly n) → IsZero p → IsZero (a · p) -pIsZero⇒a·pIsZero a p [] = [] -pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) - = (CR.trans (CR.*-congˡ b≈0) (CR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 - -a≈0⇒a·pIsZero : (a : A) → (p : Poly n) → a ≈A 0# → IsZero (a · p) -a≈0⇒a·pIsZero a [] a≈0 = [] -a≈0⇒a·pIsZero a (b ∷ p) a≈0 - = CR.trans (CR.*-congʳ a≈0) (CR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) - -1·p≈p : (p : Poly n) → 1# · p ≈ p -1·p≈p [] = []≈ [] [] -1·p≈p (a ∷ p) = cons (CR.*-identityˡ a) (1·p≈p p) - -·-cong : a ≈A b → p ≈ q → a · p ≈ b · q -·-cong {a = _} {b = b} _ ([]≈ q q≈0) - = sym (IsZero⇒≈0 (pIsZero⇒a·pIsZero b q q≈0)) -·-cong {a = a} {b = _} _ (≈[] p p≈0) - = IsZero⇒≈0 (pIsZero⇒a·pIsZero a p p≈0) -·-cong {a = _} {b = _} c≈d (cons a≈b p≈q) - = cons (CR.*-cong c≈d a≈b) (·-cong c≈d p≈q) - -·-congˡ : a ≈A b → a · p ≈ b · p -·-congˡ a≈b = ·-cong a≈b refl - -·-congʳ : p ≈ q → a · p ≈ a · q -·-congʳ = ·-cong CR.refl - -·-dist : a · (p + q) ≈ (a · p) + (a · q) -·-dist {a = _} {p = []} {q = []} = refl -·-dist {a = _} {p = []} {q = b ∷ q} = refl -·-dist {a = _} {p = b ∷ p} {q = []} = refl -·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (CR.distribˡ a b c) ·-dist - -·-assoc : a · (b · p) ≈ (a *A b) · p -·-assoc {_} {_} {p = []} = refl -·-assoc {a} {b} {p = c ∷ p} = cons (CR.sym (CR.*-assoc a b c)) ·-assoc - -a·-cong : p ≈ q → a · p ≈ a · q -a·-cong = ·-cong CR.refl - ------------------------------------------------------------------ --- Properties of polynomial multiplication - -zeroˡ : (p : Poly m) → [] * p ≈ [] -zeroˡ p = zerosm≈zerosn - -zeroʳ : (p : Poly m) → p * [] ≈ [] -zeroʳ {_} [] = refl -zeroʳ {m} (a ∷ p) = begin - (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ - (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ - p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ - 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ - 0# ∷ [] ≈⟨ zerosm≈zerosn ⟩ - [] ∎ - -pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) -pIsZero⇒p*qIsZero {n} {_} {p = []} q [] = zerosIsZero (pred n) -pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) - = cast-p≈0⇒p≈0 (cast-lem n m) - (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) - -p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] -p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) - -*-cong : {p : Poly m} → {q : Poly n} → {r : Poly k} → {s : Poly l} → - p ≈ q → r ≈ s → p * r ≈ q * s -*-cong {k = k} {q = q} {r} {s} ([]≈ q q≈0) r≈s = begin - [] * r ≈⟨ p≈[]⇒p*q≈[] r refl ⟩ - [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒≈0 q≈0) ⟨ - q * s ∎ -*-cong {k = k} {q = q} {r} {s} (≈[] p p≈0) r≈s = begin - p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 p≈0) ⟩ - [] ≈⟨ zerosm≈zerosn ⟩ - [] * s ∎ -*-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin + variable + + a b : A + p : Poly + q : Poly + +---------------------------------------------------------------------------------- +-- Multiplication of polynomials is commutative + +*-comm : (p : Poly) → (q : Poly) → p * q ≈ q * p +*-comm [] q = begin + [] * (q) + ≈⟨ p≈[]⇒p*q≈[] q refl ⟩ + [] + ≈⟨ p≈[]⇒q*p≈[] q refl ⟨ + q * [] ∎ +*-comm (a ∷ p) [] = begin (a ∷ p) * [] - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ - [] + p * (0# ∷ []) - ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ - [] + q * (0# ∷ s) - ≈⟨ +-congˡ (zerosm≈zerosn) ⟩ - zeros l + q * (0# ∷ s) - ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero b s s≈0)) ⟨ - (b · s) + q * (0# ∷ s) - ≈⟨ cast-p≈p (cast-lem l n) ⟨ - (b ∷ q) * s - ∎ -*-cong {suc m} {k = k} {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) (≈[] r s≈0) = begin - (a ∷ p) * r - ≈⟨ cast-p≈p (cast-lem k m) ⟩ - (a · r) + p * (0# ∷ r) - ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ ([]≈ r s≈0))) ⟨ - (a · r) + q * (0# ∷ []) - ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero a r s≈0)) ⟩ - zeros k + q * (0# ∷ []) - ≈⟨ +-congˡ zerosm≈zerosn ⟩ - (b · []) + q * (0# ∷ []) - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ - (b ∷ q) * [] - ∎ -*-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin - (a ∷ p) * (c ∷ r) - ≈⟨ cast-p≈p (cast-lem (suc k) m)⟩ - (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consˡ (CR.*-cong (CR.sym a≈b) (CR.sym c≈d))) ⟨ - (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consʳ ((·-cong (CR.sym a≈b) (sym r≈s)))) ⟨ - (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) - ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ - (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) - ≈⟨ cast-p≈p (cast-lem (suc l) n) ⟨ - (b ∷ q) * (d ∷ s) - ∎ - -*-congʳ : q ≈ r → p * q ≈ p * r -*-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r - -*-congˡ : p ≈ q → p * r ≈ q * r -*-congˡ p≈q = *-cong p≈q refl - -qIsZero⇒p*qIsZero : (p : Poly m) → IsZero q → IsZero (p * q) -qIsZero⇒p*qIsZero {m} {_} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) -qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) - = ≈0⇒IsZero ( - begin - p * (b ∷ q) ≈⟨ *-congʳ {p = p} (consˡ b≈0) ⟩ - p * (0# ∷ q) ≈⟨ *-distrib-shift p q ⟩ - 0# ∷ (p * q) ≈⟨ consʳ (IsZero⇒≈0 (qIsZero⇒p*qIsZero p q≈0)) ⟩ - 0# ∷ (zeros m) ≈⟨ zerosm≈zerosn ⟩ - zeros m ∎ - ) - -q≈[]→p*q≈[] : (p : Poly n) → q ≈ [] → p * q ≈ [] -q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero q≈0)) - -*-comm : (p : Poly m) → (q : Poly n) → p * q ≈ q * p -*-comm {_} {_} [] [] = refl -*-comm {_} {suc n} [] (b ∷ q) = sym ( begin - (b ∷ q) * [] - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟩ - [] + (q * (0# ∷ [])) - ≈⟨ +-congʳ (q≈[]→p*q≈[] q zerosm≈zerosn) ⟩ - [] + [] - ≈⟨ zerosm≈zerosn ⟩ - zeros (pred (0 ℕ.+ suc n)) - ∎) -*-comm {suc m} {_} (a ∷ p) [] = begin - (a ∷ p) * [] - ≈⟨(cast-p≈p (cong pred n+1≡sucn+0))⟩ - [] + p * (0# ∷ []) - ≈⟨ +-congʳ (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ - [] + [] - ≈⟨ zerosm≈zerosn ⟩ - zeros (pred (0 ℕ.+ suc m)) - ∎ -*-comm {suc m} {suc n} (a ∷ p) (b ∷ q) = begin + ≈⟨ p≈[]⇒q*p≈[] (a ∷ p) refl ⟩ + [] + ≈⟨ p≈[]⇒p*q≈[] (a ∷ p) refl ⟨ + [] * (a ∷ p) ∎ +*-comm (a ∷ p) (b ∷ q) = begin (a ∷ p) * (b ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + ≈⟨ refl ⟩ a · (b ∷ q) + p * (0# ∷ b ∷ q) ≈⟨ +-congˡ (*-comm-lem (a *A b) a) ⟩ (a *A b ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) ≈⟨ +-congˡ (consˡ (CR.+-congʳ (CR.*-comm a b))) ⟩ (b *A a ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) - ≈⟨ +-congʳ step1 ⟩ - (b *A a ∷ []) + (a · (0# ∷ q)) + ((b · (0# ∷ p)) + (0# ∷ 0# ∷ p * q)) + ≈⟨ +-congʳ (step1 (*-comm p (b ∷ q)) (*-comm p q)) ⟩ + (b *A a ∷ []) + a · (0# ∷ q) + ((b · (0# ∷ p)) + (0# ∷ 0# ∷ p * q)) ≈⟨ step2 ⟩ ((b *A a ∷ []) + b · (0# ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ p * q)) ≈⟨ step3 ⟩ (b · (a ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))) - ≈⟨ +-congʳ step4 ⟨ + ≈⟨ +-congʳ (step4 (*-comm (a ∷ p) q)) ⟨ (b · (a ∷ p) + q * (0# ∷ a ∷ p)) - ≈⟨ cast-p≈p (cast-lem (suc m) n) ⟨ + ≈⟨ refl ⟩ (b ∷ q) * (a ∷ p) ∎ where - *-comm-lem : ∀ {m} → {p : Poly m} → (a b : A) → + *-comm-lem : {p : Poly} → (a b : A) → a ∷ (b · p) ≈ (a ∷ []) + (b · (0# ∷ p)) *-comm-lem {p = []} a b = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ b)) (CR.+-identityʳ a))) *-comm-lem {p = a ∷ p} b c = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ c)) (CR.+-identityʳ b))) - step1 = begin + step1 : p * (b ∷ q) ≈ (b ∷ q) * p + → p * q ≈ q * p + → p * (0# ∷ b ∷ q) ≈ b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) + step1 p*b∷q≈b∷q*p p*q≈q*p = begin p * (0# ∷ b ∷ q) ≈⟨ *-distrib-shift p (b ∷ q) ⟩ 0# ∷ (p * (b ∷ q)) - ≈⟨ consʳ (*-comm p (b ∷ q)) ⟩ + ≈⟨ consʳ p*b∷q≈b∷q*p ⟩ 0# ∷ ((b ∷ q) * p) - ≈⟨ consʳ (cast-p≈p (cast-lem m n)) ⟩ + ≈⟨ refl ⟩ 0# ∷ (b · p + q * (0# ∷ p)) ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ (0# ∷ (b · p)) + (0# ∷ (q * (0# ∷ p))) @@ -469,10 +99,10 @@ q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero (b · (0# ∷ p)) + (0# ∷ (q * (0# ∷ p))) ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (*-distrib-shift q p)) ⟩ b · (0# ∷ p) + (0# ∷ 0# ∷ (q * p)) - ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (consʳ (*-comm q p))) ⟩ + ≈⟨ consʳ (+-congʳ (consʳ (p*q≈q*p))) ⟨ b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) ∎ - + step2 = middleFour (b *A a ∷ []) (a · (0# ∷ q)) (b · (0# ∷ p)) (0# ∷ 0# ∷ (p * q)) @@ -481,13 +111,15 @@ q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero = +-congˡ {r = a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))} (sym (*-comm-lem {p = p} (b *A a) b)) - step4 = begin + step4 : (a ∷ p) * q ≈ q * (a ∷ p) + → q * (0# ∷ a ∷ p) ≈ a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) + step4 a∷p*q≈q*a∷p = begin q * (0# ∷ a ∷ p) ≈⟨ *-distrib-shift q (a ∷ p) ⟩ 0# ∷ (q * (a ∷ p)) - ≈⟨ consʳ (*-comm q (a ∷ p)) ⟩ + ≈⟨ consʳ a∷p*q≈q*a∷p ⟨ 0# ∷ ((a ∷ p) * q) - ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟩ + ≈⟨ refl ⟩ 0# ∷ (a · q + p * (0# ∷ q)) ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ (0# ∷ (a · q)) + (0# ∷ (p * (0# ∷ q))) @@ -497,197 +129,43 @@ q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) ∎ -shift-distrib-+ : (p : Poly m) → (q : Poly n) → - shift (p + q) ≈ (shift p) + (shift q) -shift-distrib-+ p q = cons (CR.sym (CR.+-identityʳ 0#)) refl - -0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ (shift p) * q -0∷[p*q]≈[0∷p]*q p q = begin - 0# ∷ (p * q) ≈⟨ consʳ (*-comm p q) ⟩ - 0# ∷ (q * p) ≈⟨ *-distrib-shift q p ⟨ - q * (0# ∷ p) ≈⟨ *-comm q (0# ∷ p) ⟩ - (0# ∷ p) * q ∎ - -0∷[p*q]≈q*[0∷p] : (p : Poly m) → (q : Poly n) → shift (p * q) ≈ q * (shift p) -0∷[p*q]≈q*[0∷p] p q = begin - 0# ∷ (p * q) ≈⟨ 0∷[p*q]≈[0∷p]*q p q ⟩ - (0# ∷ p) * q ≈⟨ *-comm (0# ∷ p) q ⟩ - q * (0# ∷ p) ∎ - -*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → - (q + r) * p ≈ (q * p) + (r * p) -*-distribʳ-+ {_} {_} {_} [] q r = begin - (q + r) * [] - ≈⟨ q≈[]→p*q≈[] (q + r) refl ⟩ - [] + [] - ≈⟨ +-cong (zeroʳ q) (zeroʳ r)⟨ - (q * []) + (r * []) - ∎ -*-distribʳ-+ {suc m} {n} {k} (a ∷ p) q r = begin - ((q + r) * (a ∷ p)) - ≈⟨ *-comm (q + r) (a ∷ p) ⟩ - ((a ∷ p) * (q + r)) - ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ - (a · (q + r)) + (p * (0# ∷ (q + r))) - ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ - (a · q + a · r) + (0# ∷ (p * (q + r))) - ≈⟨ +-congʳ step5 ⟩ - (a · q + a · r) + ((0# ∷ (q * p)) + (0# ∷ (r * p))) - ≈⟨ middleFour (a · q) (a · r) (0# ∷ (q * p)) (0# ∷ (r * p)) ⟩ - (a · q + (0# ∷ (q * p))) + (a · r + (0# ∷ (r * p))) - ≈⟨ +-congˡ step6 ⟩ - q * (a ∷ p) + (a · r + (0# ∷ r * p)) - ≈⟨ +-congʳ step7 ⟩ - (q * (a ∷ p) + r * (a ∷ p)) - ∎ - where - step5 = begin - 0# ∷ p * (q + r) - ≈⟨ consʳ (*-comm p (q + r)) ⟩ - 0# ∷ ((q + r) * p) - ≈⟨ consʳ (*-distribʳ-+ p q r) ⟩ - 0# ∷ q * p + r * p - ≈⟨ shift-distrib-+ (q * p) (r * p) ⟩ - (0# ∷ q * p) + (0# ∷ r * p) ∎ - - step6 = begin - a · q + (0# ∷ q * p) - ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] q p) ⟩ - a · q + p * (0# ∷ q) - ≈⟨ cast-p≈p (cast-lem n m) ⟨ - (a ∷ p) * q - ≈⟨ *-comm (a ∷ p) q ⟩ - q * (a ∷ p) ∎ - - step7 = begin - a · r + (0# ∷ r * p) - ≈⟨ +-congʳ (0∷[p*q]≈q*[0∷p] r p) ⟩ - a · r + p * (0# ∷ r) - ≈⟨ cast-p≈p (cast-lem k m) ⟨ - (a ∷ p) * r - ≈⟨ *-comm (a ∷ p) r ⟩ - r * (a ∷ p) ∎ - -·-distrib-* : (p : Poly m) → (q : Poly n) → (a : A) → - a · (p * q) ≈ (a · p) * q -·-distrib-* {_} {n} [] q a = begin - a · ([] * q) ≈⟨ ·-congʳ zerosm≈zerosn ⟩ - a · [] ≈⟨ zerosm≈zerosn ⟨ - (a · []) * q ∎ -·-distrib-* {suc m} {_} (b ∷ p) [] a = begin - a · ((b ∷ p) * []) - ≈⟨ a·-cong (cast-p≈p (cong pred n+1≡sucn+0)) ⟩ - a · ((b · []) + (p * (0# ∷ []))) - ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ - a · (p * (0# ∷ [])) - ≈⟨ a·-cong (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ - [] - ≈⟨ q≈[]→p*q≈[] ((a · p)) zerosm≈zerosn ⟨ - (a · p) * (0# ∷ []) - ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ - ((a *A b) · []) + ((a · p) * (0# ∷ [])) - ≈⟨ cast-p≈p (cong pred n+1≡sucn+0) ⟨ - (a · (b ∷ p)) * [] - ∎ -·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin - a · ((b ∷ p) * (c ∷ q)) - ≈⟨ a·-cong (cast-p≈p (cast-lem (suc n) m)) ⟩ - a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) - ≈⟨ ·-dist ⟩ - a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) - ≈⟨ +-congˡ (cons (CR.sym (CR.*-assoc a b c)) ·-assoc) ⟩ - (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) - ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ - (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟨ - (a · (b ∷ p)) * (c ∷ q) - ∎ - -*-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → - (p * q) * r ≈ p * (q * r) -*-assoc {_} {n} {k} [] q r = begin - zeros (n ℕ.∸ 1) * r - ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 (zerosIsZero (n ℕ.∸ 1))) ⟩ - [] - ≈⟨ zerosm≈zerosn ⟩ - zeros (pred (0 ℕ.+ pred (n ℕ.+ k))) - ∎ -*-assoc {suc m} {n} {k} (a ∷ p) q r = begin - ((a ∷ p) * q) * r - ≈⟨ *-congˡ (cast-p≈p (cast-lem n m)) ⟩ - ((a · q) + (p * (0# ∷ q))) * r - ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ - ((a · q) + (0# ∷ (p * q))) * r - ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ - ((a · q) * r) + ((0# ∷ (p * q)) * r) - ≈⟨ +-congʳ step8 ⟨ - ((a · q) * r) + (0# ∷ (p * (q * r))) - ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ - (a · (q * r)) + (0# ∷ (p * (q * r))) - ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ - (a · (q * r)) + (p * (0# ∷ (q * r))) - ≈⟨ cast-p≈p (cast-lem (pred (n ℕ.+ k)) m) ⟨ - (a ∷ p) * (q * r) - ∎ - where - step8 = begin - 0# ∷ (p * (q * r)) - ≈⟨ consʳ (*-assoc p q r) ⟨ - 0# ∷ ((p * q) * r) - ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ - (0# ∷ (p * q)) * r - ≈⟨ cast-p≈p (cast-lem k (m ℕ.+ n ℕ.∸ 1)) ⟩ - (0# · r) + ((p * q) * (0# ∷ r)) - ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r CR.refl) ) ⟩ - zeros k + ((p * q) * (0# ∷ r)) - ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ - zeros k + (0# ∷ ((p * q) * r)) - ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ - zeros k + ((0# ∷ (p * q)) * r) - ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ - (0# ∷ (p * q)) * r - ∎ - ---------------------------------------------------------------------- --- Multiplicative identity -*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p -*-identityʳ {0} [] = zerosm≈zerosn -*-identityʳ {suc n} (a ∷ p) = begin - (a ∷ p) * (1# ∷ []) - ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ - (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congˡ (consˡ (CR.*-identityʳ a)) ⟩ - (a ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ - (a ∷ []) + (0# ∷ (p * (1# ∷ []))) - ≈⟨ cons (CR.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ - a ∷ (p * (1# ∷ [])) - ≈⟨ consʳ (*-identityʳ p) ⟩ - a ∷ p ∎ +------------------------------------------------------------------ +-- Multiplicative structure + +*-isCommutativeMonoid : IsCommutativeMonoid _≈_ _*_ (1# ∷ []) +*-isCommutativeMonoid = record + { isMonoid = *-isMonoid + ; comm = *-comm + } + ++-*-isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ [] (1# ∷ []) ++-*-isCommutativeSemiring = record + { isSemiring = +-*-isSemiring + ; *-comm = *-comm + } + ++-*-isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ [] (1# ∷ []) ++-*-isCommutativeRing = record + { isRing = +-*-isRing + ; *-comm = *-comm + } + +--------------------------------------------------------------- +-- Multiplicative bundles + +*-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ +*-commutativeMonoid = record + { isCommutativeMonoid = *-isCommutativeMonoid + } + ++-*-commutativeSemiring : Algebra.Bundles.CommutativeSemiring _ _ ++-*-commutativeSemiring = record + { isCommutativeSemiring = +-*-isCommutativeSemiring + } + ++-*-commutativeRing : Algebra.Bundles.CommutativeRing _ _ ++-*-commutativeRing = record + { isCommutativeRing = +-*-isCommutativeRing + } -shift-is-x* : (p : Poly n) → (shift p) ≈ (0# ∷ 1# ∷ []) * p -shift-is-x* {n} [] = begin - 0# ∷ [] - ≈⟨ zerosm≈zerosn ⟩ - [] - ≈⟨ zeroʳ (0# ∷ 1# ∷ []) ⟨ - (0# ∷ 1# ∷ []) * [] - ∎ -shift-is-x* {suc n} (a ∷ p) = begin - 0# ∷ a ∷ p - ≈⟨ consʳ (consʳ (1·p≈p p)) ⟨ - 0# ∷ a ∷ 1# · p - ≈⟨ consʳ (cons (CR.*-identityˡ a) (+-identityʳ (1# · p))) ⟨ - 0# ∷ 1# *A a ∷ (1# · p + zeros n) - ≈⟨ cons (CR.+-identityˡ 0#) (+-identityˡ (1# *A a ∷ (1# · p + zeros n))) ⟨ - 0# +A 0# ∷ (zeros n + (1# *A a ∷ 1# · p + zeros n)) - ≈⟨ consʳ (+-cong (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# p CR.refl)) - (cons (CR.+-identityʳ (1# *A a)) (cast-p≈p (ℕ.⊔-idem n)))) ⟨ - 0# +A 0# ∷ (0# · p + Vec.cast (cong suc (ℕ.⊔-idem n)) (1# · (a ∷ p) + zeros (suc n))) - ≈⟨ consˡ (CR.+-identityˡ (0# +A 0#)) ⟨ - 0# +A (0# +A 0#) ∷ 0# · p + Vec.cast (cong suc (ℕ.⊔-idem n)) (1# · (a ∷ p) + zeros (suc n)) - ≈⟨ cons (CR.+-cong (CR.zeroˡ a) (CR.+-congʳ (CR.zeroʳ 1#))) - (cast-p≈p (ℕ.m≤n⇒m⊔n≡n (ℕ.n≤1+n n))) ⟨ - (0# ∷ 1# ∷ []) * (a ∷ p) - ∎ diff --git a/src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda b/src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda deleted file mode 100644 index d52acf2408..0000000000 --- a/src/Algebra/Polynomial/Poly/Properties/CommutativeRing2.agda +++ /dev/null @@ -1,171 +0,0 @@ -open import Algebra.Bundles using (CommutativeRing) - -module Algebra.Polynomial.Poly.Properties.CommutativeRing2 - {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) - where - -import Algebra.Definitions as Def -open import Algebra.Polynomial.Poly.Base.CommutativeRing2 R as P public - using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; module CR) -open import Algebra.Polynomial.Poly.Properties.Ring2 (CommutativeRing.ring R) public hiding ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ) -open import Algebra.Properties.Ring -open import Algebra.Structures - using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid - ; IsGroup; IsAbelianGroup; IsCommutativeMonoid; IsSemiring - ; IsRing; IsCommutativeSemiring; IsCommutativeRing ) -open import Data.List.Base as List using (List; []; _∷_) -open import Data.List.Relation.Unary.All using (All ; []; _∷_) -open import Data.Product.Base using (_,_) - -open ≈-Reasoning - -open CR - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ; -_ to -A_) - using (0#; 1#) - -open Def _≈_ - -private - variable - - a b : A - p : Poly - q : Poly - ----------------------------------------------------------------------------------- --- Multiplication of polynomials is commutative - -*-comm : (p : Poly) → (q : Poly) → p * q ≈ q * p -*-comm [] q = begin - [] * (q) - ≈⟨ p≈[]⇒p*q≈[] q refl ⟩ - [] - ≈⟨ p≈[]⇒q*p≈[] q refl ⟨ - q * [] ∎ -*-comm (a ∷ p) [] = begin - (a ∷ p) * [] - ≈⟨ p≈[]⇒q*p≈[] (a ∷ p) refl ⟩ - [] - ≈⟨ p≈[]⇒p*q≈[] (a ∷ p) refl ⟨ - [] * (a ∷ p) ∎ -*-comm (a ∷ p) (b ∷ q) = begin - (a ∷ p) * (b ∷ q) - ≈⟨ refl ⟩ - a · (b ∷ q) + p * (0# ∷ b ∷ q) - ≈⟨ +-congˡ (*-comm-lem (a *A b) a) ⟩ - (a *A b ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) - ≈⟨ +-congˡ (consˡ (CR.+-congʳ (CR.*-comm a b))) ⟩ - (b *A a ∷ []) + a · (0# ∷ q) + p * (0# ∷ b ∷ q) - ≈⟨ +-congʳ (step1 (*-comm p (b ∷ q)) (*-comm p q)) ⟩ - (b *A a ∷ []) + a · (0# ∷ q) + ((b · (0# ∷ p)) + (0# ∷ 0# ∷ p * q)) - ≈⟨ step2 ⟩ - ((b *A a ∷ []) + b · (0# ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ p * q)) - ≈⟨ step3 ⟩ - (b · (a ∷ p)) + (a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))) - ≈⟨ +-congʳ (step4 (*-comm (a ∷ p) q)) ⟨ - (b · (a ∷ p) + q * (0# ∷ a ∷ p)) - ≈⟨ refl ⟩ - (b ∷ q) * (a ∷ p) - ∎ - where - *-comm-lem : {p : Poly} → (a b : A) → - a ∷ (b · p) ≈ (a ∷ []) + (b · (0# ∷ p)) - *-comm-lem {p = []} a b - = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ b)) (CR.+-identityʳ a))) - *-comm-lem {p = a ∷ p} b c - = consˡ (CR.sym (CR.trans (CR.+-congˡ (CR.zeroʳ c)) (CR.+-identityʳ b))) - - step1 : p * (b ∷ q) ≈ (b ∷ q) * p - → p * q ≈ q * p - → p * (0# ∷ b ∷ q) ≈ b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) - step1 p*b∷q≈b∷q*p p*q≈q*p = begin - p * (0# ∷ b ∷ q) - ≈⟨ *-distrib-shift p (b ∷ q) ⟩ - 0# ∷ (p * (b ∷ q)) - ≈⟨ consʳ p*b∷q≈b∷q*p ⟩ - 0# ∷ ((b ∷ q) * p) - ≈⟨ refl ⟩ - 0# ∷ (b · p + q * (0# ∷ p)) - ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ - (0# ∷ (b · p)) + (0# ∷ (q * (0# ∷ p))) - ≈⟨ +-congˡ {r = (0# ∷ (q * (0# ∷ p)))} (·-distrib-shift b p) ⟨ - (b · (0# ∷ p)) + (0# ∷ (q * (0# ∷ p))) - ≈⟨ +-congʳ {p = b · (0# ∷ p)} (consʳ (*-distrib-shift q p)) ⟩ - b · (0# ∷ p) + (0# ∷ 0# ∷ (q * p)) - ≈⟨ consʳ (+-congʳ (consʳ (p*q≈q*p))) ⟨ - b · (0# ∷ p) + (0# ∷ 0# ∷ (p * q)) - ∎ - - step2 - = middleFour (b *A a ∷ []) (a · (0# ∷ q)) - (b · (0# ∷ p)) (0# ∷ 0# ∷ (p * q)) - - step3 - = +-congˡ {r = a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q))} - (sym (*-comm-lem {p = p} (b *A a) b)) - - step4 : (a ∷ p) * q ≈ q * (a ∷ p) - → q * (0# ∷ a ∷ p) ≈ a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) - step4 a∷p*q≈q*a∷p = begin - q * (0# ∷ a ∷ p) - ≈⟨ *-distrib-shift q (a ∷ p) ⟩ - 0# ∷ (q * (a ∷ p)) - ≈⟨ consʳ a∷p*q≈q*a∷p ⟨ - 0# ∷ ((a ∷ p) * q) - ≈⟨ refl ⟩ - 0# ∷ (a · q + p * (0# ∷ q)) - ≈⟨ consˡ (CR.sym (CR.+-identityʳ 0#)) ⟩ - (0# ∷ (a · q)) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ +-congˡ {r = (0# ∷ (p * (0# ∷ q)))} (·-distrib-shift a q) ⟨ - a · (0# ∷ q) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ +-congʳ {p = a · (0# ∷ q)} (consʳ (*-distrib-shift p q))⟩ - a · (0# ∷ q) + (0# ∷ 0# ∷ (p * q)) - ∎ - - ------------------------------------------------------------------- --- Multiplicative structure - -*-isCommutativeMonoid : IsCommutativeMonoid _≈_ _*_ (1# ∷ []) -*-isCommutativeMonoid = record - { isMonoid = *-isMonoid - ; comm = *-comm - } - -+-*-isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ [] (1# ∷ []) -+-*-isCommutativeSemiring = record - { isSemiring = +-*-isSemiring - ; *-comm = *-comm - } - -+-*-isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ [] (1# ∷ []) -+-*-isCommutativeRing = record - { isRing = +-*-isRing - ; *-comm = *-comm - } - ---------------------------------------------------------------- --- Multiplicative bundles - -*-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ -*-commutativeMonoid = record - { isCommutativeMonoid = *-isCommutativeMonoid - } - -+-*-commutativeSemiring : Algebra.Bundles.CommutativeSemiring _ _ -+-*-commutativeSemiring = record - { isCommutativeSemiring = +-*-isCommutativeSemiring - } - -+-*-commutativeRing : Algebra.Bundles.CommutativeRing _ _ -+-*-commutativeRing = record - { isCommutativeRing = +-*-isCommutativeRing - } - diff --git a/src/Algebra/Polynomial/Poly/Properties/Ring.agda b/src/Algebra/Polynomial/Poly/Properties/Ring.agda index 14c9f928f2..5199c0512e 100644 --- a/src/Algebra/Polynomial/Poly/Properties/Ring.agda +++ b/src/Algebra/Polynomial/Poly/Properties/Ring.agda @@ -4,21 +4,26 @@ module Algebra.Polynomial.Poly.Properties.Ring {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base.Ring R as P - using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym; zeros - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) +open import Algebra.Bundles.Raw +import Algebra.Definitions as Def +open import Algebra.Polynomial.Poly.Base.Ring R as P public + using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; module R) +open import Algebra.Polynomial.Poly.Properties.Semiring (Ring.semiring R) public + hiding ( Poly; _+_ ; _*_ ; _·_ ; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ ) open import Algebra.Properties.Ring -open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -import Data.Nat.Properties as ℕ -open import Data.Vec.Base as Vec using (Vec; []; _∷_) -open import Data.Vec.Relation.Unary.All using (All ; []; _∷_; head; tail) +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsGroup; IsAbelianGroup; IsSemiring; IsCommutativeMonoid + ; IsRing) +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All using (All ; []; _∷_) +open import Data.Product.Base using (_,_) import Level as L -open import Relation.Binary -open import Relation.Binary.PropositionalEquality as Eq - using (_≡_; module ≡-Reasoning) -open import Relation.Binary.PropositionalEquality.Core using (cong) -module R = Ring R +open Def _≈_ + open R renaming ( Carrier to A @@ -30,102 +35,31 @@ open R private variable - m n k l : ℕ - a b c d : A - p : Poly m - q : Poly n - r : Poly k - s : Poly l - ---------------------------------------------------------------------- --- Equational reasoning for Poly n and Poly m --- where m is not necesarily the same as n -private - - infix 4 _IsRelatedTo_ - - data _IsRelatedTo_ (p : Poly m) (q : Poly n) : Set (ℓ₁ L.⊔ ℓ₂) where - relTo : (p≈q : p ≈ q) → p IsRelatedTo q - - start : _IsRelatedTo_ {m} {n} ⇒ _≈_ - start (relTo p≈q) = p≈q - - ∼-go : Trans (_≈_) (_IsRelatedTo_ {n} {k}) (_IsRelatedTo_ {m} {k}) - ∼-go p≈q (relTo q≈r) = relTo (trans p≈q q≈r) - - stop : Reflexive (_IsRelatedTo_ {m} {m}) - stop = relTo refl - - forward : (p : Poly m) → q IsRelatedTo r → p ≈ q → p IsRelatedTo r - forward p qRr p≈q = ∼-go p≈q qRr - - backward : (p : Poly m) → q IsRelatedTo r → q ≈ p → p IsRelatedTo r - backward p qRr q≈p = ∼-go (sym q≈p) qRr - - infix 1 begin_ - begin_ : p IsRelatedTo q → p ≈ q - begin_ = start - - infixr 2 step-∼-⟩ - step-∼-⟩ = forward - syntax step-∼-⟩ p qRr p≈q = p ≈⟨ p≈q ⟩ qRr - - infixr 2 step-∼-⟨ - step-∼-⟨ = backward - syntax step-∼-⟨ p qRr q≈p = p ≈⟨ q≈p ⟨ qRr - - infix 3 _∎ - _∎ : (p : Poly m) → p IsRelatedTo p - p ∎ = stop - --- Properties of zero polynomial - -zerosIsZero : (n : ℕ) → IsZero (zeros n) -zerosIsZero 0 = [] -zerosIsZero (suc n) = R.refl ∷ (zerosIsZero n) - -zerosm≈zerosn : zeros m ≈ zeros n -zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) - -≈0⇒IsZero : p ≈ zeros m → IsZero p -≈0⇒IsZero ([]≈ zeros zeros≈0) = [] -≈0⇒IsZero (≈[] p p≈0) = p≈0 -≈0⇒IsZero (cons a≈0 p≈0) = a≈0 ∷ ≈0⇒IsZero p≈0 - -IsZero⇒≈0 : IsZero p → p ≈ zeros m -IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) - -All[p≈0∧q≈0]⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] [] = [] -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 -All[p≈0∧q≈0]⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = R.trans (R.+-cong a≈0 b≈0) (R.+-identityˡ 0#) ∷ All[p≈0∧q≈0]⇒p+q≈0 p≈0 q≈0 - ------------------------------------------------------- + a b : A + p : Poly + q : Poly + +---------------------------------------------------------------------- -- Additive inverse -[-p]+pIsZero : {p : Poly m} → IsZero ((- p) + p) +[-p]+pIsZero : {p : Poly} → IsZero ((- p) + p) [-p]+pIsZero {p = []} = [] [-p]+pIsZero {p = a ∷ p} = R.-‿inverseˡ a ∷ [-p]+pIsZero -p+[-p]IsZero : {p : Poly m} → IsZero (p + (- p)) +p+[-p]IsZero : {p : Poly} → IsZero (p + (- p)) p+[-p]IsZero {p = []} = [] p+[-p]IsZero {p = a ∷ p} = R.-‿inverseʳ a ∷ p+[-p]IsZero -+-inverseˡ : (p : Poly m) → (- p) + p ≈ [] ++-inverseˡ : (p : Poly) → (- p) + p ≈ [] +-inverseˡ [] = refl +-inverseˡ (a ∷ p) = ≈[] ((- (a ∷ p)) + (a ∷ p)) (R.-‿inverseˡ a ∷ [-p]+pIsZero) -+-inverseʳ : (p : Poly m) → p + (- p) ≈ [] ++-inverseʳ : (p : Poly) → p + (- p) ≈ [] +-inverseʳ [] = refl +-inverseʳ (a ∷ p) = ≈[] ((a ∷ p) + (- (a ∷ p))) ((R.-‿inverseʳ a) ∷ p+[-p]IsZero) -------------------------------------------------------- --- Negation is congruent - -⁺ : IsZero p → IsZero (- p) -⁺ [] = [] -⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε R a≈0 ∷ (-⁺ p≈0) @@ -139,505 +73,64 @@ p+[-p]IsZero {p = a ∷ p} = R.-‿inverseʳ a ∷ p+[-p]IsZero -‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) -‿cong (cons a≈b p≈q) = cons (R.-‿cong a≈b) (-‿cong p≈q) ------------------------------------------------------ --- Properties of polynomial addition - -+-comm : (p : Poly m) → (q : Poly n) → p + q ≈ q + p -+-comm [] [] = refl -+-comm [] (a ∷ p) = refl -+-comm (a ∷ p) [] = refl -+-comm (a ∷ p) (b ∷ q) = cons (R.+-comm a b) (+-comm p q) - -+-idʳ : (p : Poly n) → (q : Poly m) → IsZero q → p + q ≈ p -+-idʳ [] q [] = refl -+-idʳ (a ∷ p) q [] = refl -+-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) -+-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) - = cons (R.trans (R.+-congˡ b≈0) (R.+-identityʳ a)) (+-idʳ p q q≈0) - -+-idˡ : (p : Poly n) → (q : Poly m) → IsZero p → p + q ≈ q -+-idˡ p q p≈0 = begin - p + q ≈⟨ +-comm p q ⟩ - q + p ≈⟨ +-idʳ q p p≈0 ⟩ - q ∎ - -+-identityʳ : (p : Poly n) → p + (zeros m) ≈ p -+-identityʳ {m = m} p = +-idʳ p (zeros m) (zerosIsZero m) - -+-identityˡ : (p : Poly n) → (zeros m) + p ≈ p -+-identityˡ {m = m} p = +-idˡ (zeros m) p (zerosIsZero m) - -+-cong : p ≈ q → r ≈ s → p + r ≈ q + s -+-cong {p = _} {q = _} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin - [] + r ≈⟨ +-identityˡ r ⟩ - r ≈⟨ r≈s ⟩ - s ≈⟨ +-idˡ q s q≈0 ⟨ - q + s ∎ -+-cong {p = _} {q = _} {r = r} {s = s} (≈[] p p≈0) r≈s = begin - p + r ≈⟨ +-idˡ p r p≈0 ⟩ - r ≈⟨ r≈s ⟩ - s ≈⟨ +-identityˡ s ⟨ - [] + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} {r = _} {s = s} (cons a≈b p≈q) ([]≈ s s≈0) = begin - a ∷ p ≈⟨ cons a≈b p≈q ⟩ - b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ - (b ∷ q) + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} {r = r} {s = _} (cons a≈b p≈q) (≈[] r r≈0) = begin - (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ - a ∷ p ≈⟨ cons a≈b p≈q ⟩ - b ∷ q ∎ -+-cong (cons a≈b p≈q) (cons c≈d r≈s) - = cons (R.+-cong a≈b c≈d) (+-cong p≈q r≈s) - -+-congˡ : p ≈ q → p + r ≈ q + r -+-congˡ p≈q = +-cong p≈q refl - -+-congʳ : q ≈ r → p + q ≈ p + r -+-congʳ q≈r = +-cong refl q≈r - -+-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → - (p + q) + r ≈ p + (q + r) -+-assoc [] q r = begin - ([] + q) + r ≈⟨ +-congˡ (+-identityˡ q) ⟩ - q + r ≈⟨ +-identityˡ (q + r) ⟨ - [] + (q + r) ∎ -+-assoc (a ∷ p) [] r = +-congʳ (sym (+-identityˡ r)) -+-assoc (a ∷ p) (b ∷ q) [] = refl -+-assoc (a ∷ p) (b ∷ q) (c ∷ r) - = cons (R.+-assoc a b c) (+-assoc p q r) - -middleFour : (p : Poly m) → (q : Poly n) → (r : Poly k) → (w : Poly l) → - (p + q) + (r + w) ≈ (p + r) + (q + w) -middleFour p q r w = begin - (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ - (p + q + r) + w ≈⟨ +-congˡ (+-assoc p q r) ⟩ - (p + (q + r)) + w ≈⟨ +-congˡ (+-congʳ (+-comm q r)) ⟩ - (p + (r + q)) + w ≈⟨ +-congˡ (+-assoc p r q) ⟨ - (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ - (p + r) + (q + w) ∎ +-------------------------------------------------------------- +-- Algebraic properties of addition + ++-inverse : Inverse [] -_ _+_ ++-inverse = +-inverseˡ , +-inverseʳ + +--------------------------------------------------------------- +-- Additive structures + ++-isGroup : IsGroup _≈_ _+_ [] -_ ++-isGroup = record + { isMonoid = +-isMonoid + ; inverse = +-inverse + ; ⁻¹-cong = -‿cong + } + ++-isAbelianGroup : IsAbelianGroup _≈_ _+_ [] -_ ++-isAbelianGroup = record + { isGroup = +-isGroup + ; comm = +-comm + } + +--------------------------------------------------------------- +-- Additive bundles + +rawRing : Algebra.Bundles.Raw.RawRing _ _ +rawRing = record + { Carrier = Poly + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; -_ = -_ + ; 0# = [] + ; 1# = 1# ∷ [] + } + ++-abelianGroup : Algebra.Bundles.AbelianGroup _ _ ++-abelianGroup = record + { isAbelianGroup = +-isAbelianGroup + } ------------------------------------------------------------------ --- Vector casting lemmas - -private - - cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → - All (_≈A 0#) (Vec.cast m≡n p) - cast-p≈0⇒p≈0 {n = 0} {[]} m≡n [] = [] - cast-p≈0⇒p≈0 {n = suc n} {a ∷ p} m≡n (a≈0 ∷ p≈0) - = a≈0 ∷ cast-p≈0⇒p≈0 (cong pred m≡n) p≈0 - - cast-p≈p : (m≡n : m ≡ n) → Vec.cast m≡n p ≈ p - cast-p≈p {n = 0} {[]} Eq.refl = refl - cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) - - ------------------------------------------------------------------- --- Properties of polynomial shifting - -*-distrib-shift : (p : Poly m) → (q : Poly n) → - p * (shift q) ≈ shift (p * q) -*-distrib-shift {_} {_} [] qs = zerosm≈zerosn -*-distrib-shift {suc m} {n} (a ∷ p) q = begin - (a ∷ p) * (0# ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ - a · (0# ∷ q) + p * (0# ∷ 0# ∷ q) - ≈⟨ +-congˡ (consˡ (R.zeroʳ a)) ⟩ - (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) - ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ - (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ consˡ (R.+-identityˡ 0#) ⟩ - 0# ∷ (a · q + p * (0# ∷ q)) - ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟨ - 0# ∷ ((a ∷ p) * q) - ∎ - -·-distrib-shift : (a : A) → (p : Poly m) → a · (shift p) ≈ shift (a · p) -·-distrib-shift a [] = cons (R.zeroʳ a) (refl) -·-distrib-shift a (b ∷ p) = consˡ (R.zeroʳ a) - ----------------------------------------------------------------- --- Properties of polynomial scaling - -a·p≈a∷[]*p : (a : A) → (p : Poly n) → a · p ≈ (a ∷ []) * p -a·p≈a∷[]*p {_} a [] = refl -a·p≈a∷[]*p {suc n} a (b ∷ p) = begin - a · (b ∷ p) - ≈⟨ cons (R.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ - a *A b +A 0# ∷ (a · p + zeros n) - ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟨ - (a ∷ []) * (b ∷ p) ∎ - -1·p≈p : (p : Poly n) → 1# · p ≈ p -1·p≈p [] = refl -1·p≈p (a ∷ p) = cons (R.*-identityˡ a) (1·p≈p p) - - -pIsZero⇒a·pIsZero : (a : A) → (p : Poly n) → IsZero p → IsZero (a · p) -pIsZero⇒a·pIsZero a p [] = [] -pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) - = (R.trans (R.*-congˡ b≈0) (R.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 - -a≈0⇒a·pIsZero : (a : A) → (p : Poly n) → a ≈A 0# → IsZero (a · p) -a≈0⇒a·pIsZero a [] a≈0 = [] -a≈0⇒a·pIsZero a (b ∷ p) a≈0 - = R.trans (R.*-congʳ a≈0) (R.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) - -·-cong : a ≈A b → p ≈ q → a · p ≈ b · q -·-cong {a = _} {b = b} _ ([]≈ q q≈0) - = sym (IsZero⇒≈0 (pIsZero⇒a·pIsZero b q q≈0)) -·-cong {a = a} {b = _} _ (≈[] p p≈0) - = IsZero⇒≈0 (pIsZero⇒a·pIsZero a p p≈0) -·-cong {a = _} {b = _} c≈d (cons a≈b p≈q) - = cons (R.*-cong c≈d a≈b) (·-cong c≈d p≈q) - -·-congˡ : a ≈A b → a · p ≈ b · p -·-congˡ a≈b = ·-cong a≈b refl - -·-congʳ : p ≈ q → a · p ≈ a · q -·-congʳ = ·-cong R.refl - -·-dist : a · (p + q) ≈ (a · p) + (a · q) -·-dist {p = []} {q = []} = refl -·-dist {p = []} {q = b ∷ q} = refl -·-dist {p = b ∷ p} {q = []} = refl -·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (R.distribˡ a b c) ·-dist - -·-assoc : a · (b · p) ≈ (a *A b) · p -·-assoc {p = []} = refl -·-assoc {a} {b} {p = c ∷ p} = cons (R.sym (R.*-assoc a b c)) ·-assoc - -a·-cong : p ≈ q → a · p ≈ a · q -a·-cong = ·-cong R.refl - -·-distrib-+A : (a b : A) → (p : Poly m) → (a +A b) · p ≈ a · p + b · p -·-distrib-+A a b [] = refl -·-distrib-+A a b (c ∷ p) = cons (R.distribʳ c a b) (·-distrib-+A a b p) - ------------------------------------------------------------------ --- Properties of polynomial multiplication - -zeroˡ : (p : Poly m) → [] * p ≈ [] -zeroˡ p = zerosm≈zerosn - -zeroʳ : (p : Poly m) → p * [] ≈ [] -zeroʳ [] = refl -zeroʳ {m} (a ∷ p) = begin - (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ - (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ - p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ - 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ - 0# ∷ [] ≈⟨ zerosm≈zerosn ⟩ - [] ∎ - -pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) -pIsZero⇒p*qIsZero {n} {p = []} q [] = zerosIsZero (pred n) -pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) - = cast-p≈0⇒p≈0 (cast-lem n m) - (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) - -p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] -p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) - -*-cong : {p : Poly m} → {q : Poly n} → {r : Poly k} → {s : Poly l} → - p ≈ q → r ≈ s → p * r ≈ q * s -*-cong {k = k} {q = q} {r} {s} ([]≈ q q≈0) r≈s = begin - [] * r ≈⟨ p≈[]⇒p*q≈[] r refl ⟩ - [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒≈0 q≈0) ⟨ - q * s ∎ -*-cong {k = k} {q = q} {r} {s} (≈[] p p≈0) r≈s = begin - p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 p≈0) ⟩ - [] ≈⟨ zerosm≈zerosn ⟩ - [] * s ∎ -*-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin - (a ∷ p) * [] - ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ - [] + p * (0# ∷ []) - ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ - [] + q * (0# ∷ s) - ≈⟨ +-congˡ (zerosm≈zerosn) ⟩ - zeros l + q * (0# ∷ s) - ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero b s s≈0)) ⟨ - (b · s) + q * (0# ∷ s) - ≈⟨ cast-p≈p (cast-lem l n) ⟨ - (b ∷ q) * s - ∎ -*-cong {suc m} {k = k} {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) (≈[] r s≈0) = begin - (a ∷ p) * r - ≈⟨ cast-p≈p (cast-lem k m) ⟩ - (a · r) + p * (0# ∷ r) - ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ ([]≈ r s≈0))) ⟨ - (a · r) + q * (0# ∷ []) - ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero a r s≈0)) ⟩ - zeros k + q * (0# ∷ []) - ≈⟨ +-congˡ zerosm≈zerosn ⟩ - (b · []) + q * (0# ∷ []) - ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ - (b ∷ q) * [] - ∎ -*-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin - (a ∷ p) * (c ∷ r) - ≈⟨ cast-p≈p (cast-lem (suc k) m)⟩ - (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consˡ (R.*-cong a≈b c≈d)) ⟩ - (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consʳ (·-cong a≈b r≈s)) ⟩ - (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) - ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ - (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) - ≈⟨ cast-p≈p (cast-lem (suc l) n) ⟨ - (b ∷ q) * (d ∷ s) - ∎ - -*-congʳ : q ≈ r → p * q ≈ p * r -*-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r - -*-congˡ : p ≈ q → p * r ≈ q * r -*-congˡ p≈q = *-cong p≈q refl - -qIsZero⇒p*qIsZero : (p : Poly m) → IsZero q → IsZero (p * q) -qIsZero⇒p*qIsZero {m} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) -qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) - = ≈0⇒IsZero ( - begin - p * (b ∷ q) ≈⟨ *-congʳ {p = p} (consˡ b≈0) ⟩ - p * (0# ∷ q) ≈⟨ *-distrib-shift p q ⟩ - 0# ∷ (p * q) ≈⟨ consʳ (IsZero⇒≈0 (qIsZero⇒p*qIsZero p q≈0)) ⟩ - 0# ∷ (zeros m) ≈⟨ zerosm≈zerosn ⟩ - zeros m ∎ - ) - -q≈[]→p*q≈[] : (p : Poly n) → q ≈ [] → p * q ≈ [] -q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero q≈0)) - -shift-distrib-+ : (p : Poly m) → (q : Poly n) → - shift (p + q) ≈ (shift p) + (shift q) -shift-distrib-+ p q = cons (R.sym (R.+-identityʳ 0#)) refl - -*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p -*-identityʳ {0} [] = zerosm≈zerosn -*-identityʳ {suc n} (a ∷ p) = begin - (a ∷ p) * (1# ∷ []) - ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ - (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congˡ (consˡ (R.*-identityʳ a)) ⟩ - (a ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ - (a ∷ []) + (0# ∷ (p * (1# ∷ []))) - ≈⟨ cons (R.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ - a ∷ (p * (1# ∷ [])) - ≈⟨ consʳ (*-identityʳ p) ⟩ - a ∷ p ∎ - -*-identityˡ : (p : Poly n) → (1# ∷ []) * p ≈ p -*-identityˡ [] = refl -*-identityˡ {suc n} (a ∷ p) = begin - (1# ∷ []) * (a ∷ p) - ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟩ - 1# · (a ∷ p) + [] * (0# ∷ a ∷ p) - ≈⟨ +-identityʳ {m = pred (suc (suc n))} (1# · (a ∷ p) + []) ⟩ - 1# · (a ∷ p) + [] - ≈⟨ +-identityʳ {m = 0} (1# · (a ∷ p)) ⟩ - 1# · (a ∷ p) - ≈⟨ cons (R.*-identityˡ a) (1·p≈p p) ⟩ - a ∷ p ∎ - --- (0# ∷ 1# ∷ []) is the center of a polynomial ring -shiftp≈p*x : (p : Poly n) → shift p ≈ p * (0# ∷ 1# ∷ []) -shiftp≈p*x [] = refl -shiftp≈p*x {suc n} (a ∷ p) = begin - 0# ∷ a ∷ p - ≈⟨ cons (R.+-identityˡ 0#) (cons (R.+-identityʳ a) (+-identityˡ p)) ⟨ - (0# ∷ a ∷ []) + shift (shift p) - ≈⟨ consʳ (consʳ (+-congʳ (*-identityʳ p))) ⟨ - (0# ∷ a ∷ []) + (shift (shift (p * (1# ∷ [])))) - ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (consʳ (*-distrib-shift p (1# ∷ []))) ⟨ - (0# ∷ a ∷ []) + shift (p * shift (1# ∷ [])) - ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (*-distrib-shift p (0# ∷ 1# ∷ [])) ⟨ - (0# ∷ a ∷ []) + p * shift (shift (1# ∷ [])) - ≈⟨ +-congˡ (cons (R.zeroʳ a) (consˡ (R.*-identityʳ a))) ⟨ - a · (0# ∷ 1# ∷ []) + p * (0# ∷ 0# ∷ 1# ∷ []) - ≈⟨ cast-p≈p (cast-lem 2 n) ⟨ - (a ∷ p) * (0# ∷ 1# ∷ []) ∎ - -shiftp≈x*p : (p : Poly n) → shift p ≈ (0# ∷ 1# ∷ []) * p -shiftp≈x*p [] = consˡ (R.sym (R.trans (R.+-identityʳ (1# *A 0#)) (R.zeroʳ 1#))) -shiftp≈x*p {suc n} (a ∷ p) = begin - 0# ∷ a ∷ p - ≈⟨ *-identityˡ (0# ∷ a ∷ p) ⟨ - (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟨ - [] + (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟩ - (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ +-idˡ (0# *A a ∷ 0# · p) ((1# ∷ []) * (0# ∷ a ∷ p)) - ((R.zeroˡ a) ∷ a≈0⇒a·pIsZero 0# p R.refl) ⟨ - 0# · (a ∷ p) + (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ consʳ (cast-p≈p (ℕ.m≤n⇒m⊔n≡n (ℕ.n≤1+n n))) ⟨ - (0# ∷ 1# ∷ []) * (a ∷ p) ∎ - -·-distrib-* : (p : Poly m) → (q : Poly n) → (a : A) → - a · (p * q) ≈ (a · p) * q -·-distrib-* {_} {n} [] q a = begin - a · ([] * q) ≈⟨ ·-congʳ zerosm≈zerosn ⟩ - a · [] ≈⟨ zerosm≈zerosn ⟨ - (a · []) * q ∎ -·-distrib-* {suc m} {_} (b ∷ p) [] a = begin - a · ((b ∷ p) * []) - ≈⟨ a·-cong (cast-p≈p (cong pred ℕ.n+1≡suc[n+0])) ⟩ - a · ((b · []) + (p * (0# ∷ []))) - ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ - a · (p * (0# ∷ [])) - ≈⟨ a·-cong (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ - [] - ≈⟨ q≈[]→p*q≈[] ((a · p)) zerosm≈zerosn ⟨ - (a · p) * (0# ∷ []) - ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ - ((a *A b) · []) + ((a · p) * (0# ∷ [])) - ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ - (a · (b ∷ p)) * [] - ∎ -·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin - a · ((b ∷ p) * (c ∷ q)) - ≈⟨ a·-cong (cast-p≈p (cast-lem (suc n) m)) ⟩ - a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) - ≈⟨ ·-dist ⟩ - a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) - ≈⟨ +-congˡ (cons (R.sym (R.*-assoc a b c)) ·-assoc) ⟩ - (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) - ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ - (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟨ - (a · (b ∷ p)) * (c ∷ q) - ∎ - -0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → - shift (p * q) ≈ (shift p) * q -0∷[p*q]≈[0∷p]*q {n = n} [] q = begin - shift ([] * q) - ≈⟨ consʳ zerosm≈zerosn ⟩ - shift [] - ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero 0# q R.refl) - (≈0⇒IsZero {m = n} zerosm≈zerosn)) ⟨ - 0# · q + zeros (pred (suc n)) - ≈⟨ cast-p≈p (ℕ.⊔-idem (pred (1 ℕ.+ n))) ⟨ - shift [] * q ∎ -0∷[p*q]≈[0∷p]*q {m = suc m} {n = n} (a ∷ p) (q) = begin - shift ((a ∷ p) * q) - ≈⟨ *-distrib-shift (a ∷ p) q ⟨ - (a ∷ p) * shift q - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ - a · shift q + p * (0# ∷ shift q) - ≈⟨ +-idˡ (0# · q) (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) - (a≈0⇒a·pIsZero 0# q R.refl) ⟨ - 0# · q + (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) - ≈⟨ +-congʳ (cast-p≈p (cast-lem (suc n) m)) ⟨ - 0# · q + (a ∷ p) * (0# ∷ q) - ≈⟨ cast-p≈p (cast-lem n (suc m)) ⟨ - shift (a ∷ p) * q ∎ - -*-distribˡ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → - p * (q + r) ≈ p * q + p * r -*-distribˡ-+ [] q r = begin - [] * (q + r) - ≈⟨ zerosm≈zerosn ⟩ - [] - ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ - [] * q + [] * r ∎ -*-distribˡ-+ {m = suc m} {n = n} {k = k} (a ∷ p) q r = begin - (a ∷ p) * (q + r) - ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ - a · (q + r) + p * (0# ∷ q + r) - ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ - (a · q + a · r) + (0# ∷ (p * (q + r))) - ≈⟨ +-congʳ (consʳ (*-distribˡ-+ p q r)) ⟩ - (a · q + a · r) + (0# ∷ (p * q + p * r)) - ≈⟨ +-congʳ (consˡ (R.+-identityʳ 0#)) ⟨ - (a · q + a · r) + ((0# ∷ (p * q)) + (0# ∷ (p * r))) - ≈⟨ middleFour (a · q) (a · r) (0# ∷ p * q) (0# ∷ p * r) ⟩ - ((a · q) + (0# ∷ (p * q))) + ((a · r) + (0# ∷ (p * r))) - ≈⟨ +-cong (+-congʳ (*-distrib-shift p q)) (+-congʳ (*-distrib-shift p r)) ⟨ - (a · q + p * (0# ∷ q)) + (a · r + p * (0# ∷ r)) - ≈⟨ +-cong (cast-p≈p (cast-lem n m)) (cast-p≈p (cast-lem k m)) ⟨ - (a ∷ p) * q + (a ∷ p) * r - ∎ - -*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → - (q + r) * p ≈ (q * p) + (r * p) -*-distribʳ-+ {m = m} p [] [] = sym (+-identityʳ (zeros (m ℕ.∸ 1))) -*-distribʳ-+ {m = m} {k = suc k} p [] (c ∷ r) = begin - ([] + (c ∷ r)) * p - ≈⟨ cast-p≈p (cast-lem m k) ⟩ - c · p + r * (0# ∷ p) - ≈⟨ cast-p≈p (cast-lem m k) ⟨ - (c ∷ r) * p - ≈⟨ +-identityˡ ((c ∷ r) * p) ⟨ - [] * p + (c ∷ r) * p - ∎ -*-distribʳ-+ {m = m} {n = suc n} p (b ∷ q) [] = begin - ((b ∷ q) + []) * p - ≈⟨ cast-p≈p (cast-lem m n) ⟩ - b · p + q * (0# ∷ p) - ≈⟨ cast-p≈p (cast-lem m n) ⟨ - (b ∷ q) * p - ≈⟨ +-identityʳ ((b ∷ q) * p) ⟨ - (b ∷ q) * p + [] * p - ∎ -*-distribʳ-+ {m} {suc n} {suc k} p (b ∷ q) (c ∷ r) = begin - ((b ∷ q) + (c ∷ r)) * p - ≈⟨ cast-p≈p (cast-lem m (n ⊔ k)) ⟩ - (b +A c) · p + (q + r) * (0# ∷ p) - ≈⟨ +-cong (·-distrib-+A b c p) (*-distribʳ-+ (0# ∷ p) q r) ⟩ - ((b · p) + (c · p)) + (q * (0# ∷ p) + r * (0# ∷ p)) - ≈⟨ middleFour (b · p) (c · p) (q * (0# ∷ p)) (r * (0# ∷ p)) ⟩ - (b · p + q * (0# ∷ p)) + (c · p + r * (0# ∷ p)) - ≈⟨ +-cong (cast-p≈p (cast-lem m n)) (cast-p≈p (cast-lem m k)) ⟨ - (b ∷ q) * p + (c ∷ r) * p - ∎ - -*-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → - (p * q) * r ≈ p * (q * r) -*-assoc {n = n} {k} [] q r = begin - zeros (n ℕ.∸ 1) * r - ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 (zerosIsZero (n ℕ.∸ 1))) ⟩ - [] - ≈⟨ zerosm≈zerosn ⟩ - zeros (pred (0 ℕ.+ pred (n ℕ.+ k))) - ∎ -*-assoc {suc m} {n} {k} (a ∷ p) q r = begin - ((a ∷ p) * q) * r - ≈⟨ *-congˡ (cast-p≈p (cast-lem n m)) ⟩ - ((a · q) + (p * (0# ∷ q))) * r - ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ - ((a · q) + (0# ∷ (p * q))) * r - ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ - ((a · q) * r) + ((0# ∷ (p * q)) * r) - ≈⟨ +-congʳ step1 ⟨ - ((a · q) * r) + (0# ∷ (p * (q * r))) - ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ - (a · (q * r)) + (0# ∷ (p * (q * r))) - ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ - (a · (q * r)) + (p * (0# ∷ (q * r))) - ≈⟨ cast-p≈p (cast-lem (pred (n ℕ.+ k)) m) ⟨ - (a ∷ p) * (q * r) - ∎ - where - step1 = begin - 0# ∷ (p * (q * r)) - ≈⟨ consʳ (*-assoc p q r) ⟨ - 0# ∷ ((p * q) * r) - ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ - (0# ∷ (p * q)) * r - ≈⟨ cast-p≈p (cast-lem k (m ℕ.+ n ℕ.∸ 1)) ⟩ - (0# · r) + ((p * q) * (0# ∷ r)) - ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r R.refl) ) ⟩ - zeros k + ((p * q) * (0# ∷ r)) - ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ - zeros k + (0# ∷ ((p * q) * r)) - ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ - zeros k + ((0# ∷ (p * q)) * r) - ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ - (0# ∷ (p * q)) * r - ∎ - +-- Multiplicative structure + ++-*-isRing : IsRing _≈_ _+_ _*_ -_ [] (1# ∷ []) ++-*-isRing = record + { +-isAbelianGroup = +-isAbelianGroup + ; *-cong = *-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + +--------------------------------------------------------------- +-- Multiplicative bundles + ++-*-ring : Algebra.Bundles.Ring _ _ ++-*-ring = record + { isRing = +-*-isRing + } diff --git a/src/Algebra/Polynomial/Poly/Properties/Ring2.agda b/src/Algebra/Polynomial/Poly/Properties/Ring2.agda deleted file mode 100644 index 008c80852d..0000000000 --- a/src/Algebra/Polynomial/Poly/Properties/Ring2.agda +++ /dev/null @@ -1,136 +0,0 @@ -open import Algebra.Bundles using (Ring) - -module Algebra.Polynomial.Poly.Properties.Ring2 - {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) - where - -open import Algebra.Bundles.Raw -import Algebra.Definitions as Def -open import Algebra.Polynomial.Poly.Base.Ring2 R as P public - using ( Poly; _+_ ; _*_ ; _·_ ; -_; shift; _≈_; refl; trans; sym - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; module R) -open import Algebra.Polynomial.Poly.Properties.Semiring2 (Ring.semiring R) public - hiding ( Poly; _+_ ; _*_ ; _·_ ; shift; _≈_; refl; trans; sym - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ ) -open import Algebra.Properties.Ring -open import Algebra.Structures - using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid - ; IsGroup; IsAbelianGroup; IsSemiring; IsCommutativeMonoid - ; IsRing) -open import Data.List.Base as List using (List; []; _∷_) -open import Data.List.Relation.Unary.All using (All ; []; _∷_) -open import Data.Product.Base using (_,_) -import Level as L - -open Def _≈_ - -open R - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ; -_ to -A_) - using (0#; 1#) - -private - variable - a b : A - p : Poly - q : Poly - ----------------------------------------------------------------------- --- Additive inverse - -[-p]+pIsZero : {p : Poly} → IsZero ((- p) + p) -[-p]+pIsZero {p = []} = [] -[-p]+pIsZero {p = a ∷ p} = R.-‿inverseˡ a ∷ [-p]+pIsZero - -p+[-p]IsZero : {p : Poly} → IsZero (p + (- p)) -p+[-p]IsZero {p = []} = [] -p+[-p]IsZero {p = a ∷ p} = R.-‿inverseʳ a ∷ p+[-p]IsZero - -+-inverseˡ : (p : Poly) → (- p) + p ≈ [] -+-inverseˡ [] = refl -+-inverseˡ (a ∷ p) - = ≈[] ((- (a ∷ p)) + (a ∷ p)) (R.-‿inverseˡ a ∷ [-p]+pIsZero) - -+-inverseʳ : (p : Poly) → p + (- p) ≈ [] -+-inverseʳ [] = refl -+-inverseʳ (a ∷ p) - = ≈[] ((a ∷ p) + (- (a ∷ p))) ((R.-‿inverseʳ a) ∷ p+[-p]IsZero) - --⁺ : IsZero p → IsZero (- p) --⁺ [] = [] --⁺ (a≈0 ∷ p≈0) = x≈ε⇒x⁻¹≈ε R a≈0 ∷ (-⁺ p≈0) - --⁻ : IsZero (- p) → IsZero p --⁻ {p = []} -p≈0 = -p≈0 --⁻ {p = a ∷ p} (-a≈0 ∷ -p≈0) = x⁻¹≈ε⇒x≈ε R -a≈0 ∷ (-⁻ -p≈0) - --‿cong : p ≈ q → - p ≈ - q --‿cong ([]≈ q q≈0) = []≈ (- q) (-⁺ q≈0) --‿cong (≈[] p p≈0) = ≈[] (- p) (-⁺ p≈0) --‿cong (cons a≈b p≈q) = cons (R.-‿cong a≈b) (-‿cong p≈q) - --------------------------------------------------------------- --- Algebraic properties of addition - -+-inverse : Inverse [] -_ _+_ -+-inverse = +-inverseˡ , +-inverseʳ - ---------------------------------------------------------------- --- Additive structures - -+-isGroup : IsGroup _≈_ _+_ [] -_ -+-isGroup = record - { isMonoid = +-isMonoid - ; inverse = +-inverse - ; ⁻¹-cong = -‿cong - } - -+-isAbelianGroup : IsAbelianGroup _≈_ _+_ [] -_ -+-isAbelianGroup = record - { isGroup = +-isGroup - ; comm = +-comm - } - ---------------------------------------------------------------- --- Additive bundles - -rawRing : Algebra.Bundles.Raw.RawRing _ _ -rawRing = record - { Carrier = Poly - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; -_ = -_ - ; 0# = [] - ; 1# = 1# ∷ [] - } - -+-abelianGroup : Algebra.Bundles.AbelianGroup _ _ -+-abelianGroup = record - { isAbelianGroup = +-isAbelianGroup - } - ------------------------------------------------------------------- --- Multiplicative structure - -+-*-isRing : IsRing _≈_ _+_ _*_ -_ [] (1# ∷ []) -+-*-isRing = record - { +-isAbelianGroup = +-isAbelianGroup - ; *-cong = *-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - ---------------------------------------------------------------- --- Multiplicative bundles - -+-*-ring : Algebra.Bundles.Ring _ _ -+-*-ring = record - { isRing = +-*-isRing - } - diff --git a/src/Algebra/Polynomial/Poly/Properties/Semiring.agda b/src/Algebra/Polynomial/Poly/Properties/Semiring.agda index 1d51e6922f..1920836feb 100644 --- a/src/Algebra/Polynomial/Poly/Properties/Semiring.agda +++ b/src/Algebra/Polynomial/Poly/Properties/Semiring.agda @@ -4,18 +4,28 @@ module Algebra.Polynomial.Poly.Properties.Semiring {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Base.Semiring SR as P - using ( Poly; _+_ ; _*_ ; _·_ ; shift; _≈_; refl; trans; sym; zeros - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ; cast-lem) +open import Algebra.Bundles.Raw +import Algebra.Definitions as Def +open import Algebra.Polynomial.Poly.Base.Semiring SR as P public + using ( Poly; _+_; _*_; _·_; shift; _≈_; refl; trans; sym + ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ) +open import Algebra.Structures + using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid + ; IsSemiring; IsCommutativeMonoid) +open import Data.Empty using (⊥; ⊥-elim) +open import Data.List.Base as List using (List; []; _∷_) +open import Data.List.Relation.Unary.All using (All ; []; _∷_) +open import Data.Maybe.Base as Maybe using (Maybe; just; nothing) open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -import Data.Nat.Properties as ℕ -open import Data.Vec.Base as Vec using (Vec; []; _∷_) -open import Data.Vec.Relation.Unary.All using (All ; []; _∷_; head; tail) -import Level as L +open import Data.Product using (_,_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq - using (_≡_; module ≡-Reasoning) -open import Relation.Binary.PropositionalEquality.Core using (cong) + using (_≡_; _≢_; module ≡-Reasoning) +open import Relation.Binary.PropositionalEquality.Core using (cong) +import Relation.Binary.Reasoning.Setoid as SetoidReasoning +open import Relation.Nullary using (Dec; yes; no) + +open Def _≈_ module SR = Semiring SR open SR @@ -29,122 +39,109 @@ open SR private variable - m n k l : ℕ a b c d : A - p : Poly m - q : Poly n - r : Poly k - s : Poly l - ---------------------------------------------------------------------- --- Equational reasoning for Poly n and Poly m --- where m is not necesarily the same as n -private - - infix 4 _IsRelatedTo_ - - data _IsRelatedTo_ (p : Poly m) (q : Poly n) : Set (ℓ₁ L.⊔ ℓ₂) where - relTo : (p≈q : p ≈ q) → p IsRelatedTo q - - start : _IsRelatedTo_ {m} {n} ⇒ _≈_ - start (relTo p≈q) = p≈q - - ∼-go : Trans (_≈_) (_IsRelatedTo_ {n} {k}) (_IsRelatedTo_ {m} {k}) - ∼-go p≈q (relTo q≈r) = relTo (trans p≈q q≈r) - - stop : Reflexive (_IsRelatedTo_ {m} {m}) - stop = relTo refl - - forward : (p : Poly m) → q IsRelatedTo r → p ≈ q → p IsRelatedTo r - forward p qRr p≈q = ∼-go p≈q qRr - - backward : (p : Poly m) → q IsRelatedTo r → q ≈ p → p IsRelatedTo r - backward p qRr q≈p = ∼-go (sym q≈p) qRr - - infix 1 begin_ - begin_ : p IsRelatedTo q → p ≈ q - begin_ = start - - infixr 2 step-∼-⟩ - step-∼-⟩ = forward - syntax step-∼-⟩ p qRr p≈q = p ≈⟨ p≈q ⟩ qRr - - infixr 2 step-∼-⟨ - step-∼-⟨ = backward - syntax step-∼-⟨ p qRr q≈p = p ≈⟨ q≈p ⟨ qRr - - infix 3 _∎ - _∎ : (p : Poly m) → p IsRelatedTo p - p ∎ = stop - --- Properties of zero polynomial - -zerosIsZero : (n : ℕ) → IsZero (zeros n) -zerosIsZero 0 = [] -zerosIsZero (suc n) = SR.refl ∷ (zerosIsZero n) - -zerosm≈zerosn : zeros m ≈ zeros n -zerosm≈zerosn {m} {n} = zeros-unique (zerosIsZero m) (zerosIsZero n) - -≈0⇒IsZero : p ≈ zeros m → IsZero p -≈0⇒IsZero ([]≈ zeros zeros≈0) = [] -≈0⇒IsZero (≈[] p p≈0) = p≈0 -≈0⇒IsZero (cons a≈0 p≈0) = a≈0 ∷ ≈0⇒IsZero p≈0 - -IsZero⇒≈0 : IsZero p → p ≈ zeros m -IsZero⇒≈0 {m = m} p≈0 = zeros-unique p≈0 (zerosIsZero m) - -All[p≈0∧q≈0]⇒p+q≈0 : IsZero p → IsZero q → IsZero (p + q) -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] [] = [] -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 -All[p≈0∧q≈0]⇒p+q≈0 {p = _} {q = _} (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 -All[p≈0∧q≈0]⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = SR.trans (SR.+-cong a≈0 b≈0) (SR.+-identityˡ 0#) ∷ All[p≈0∧q≈0]⇒p+q≈0 p≈0 q≈0 - ------------------------------------------------------ --- Properties of polynomial addition - -+-comm : (p : Poly m) → (q : Poly n) → p + q ≈ q + p + p : Poly + q : Poly + r : Poly + s : Poly + +--------------------------------------------------- +-- Equational reasoning for Polynomials + +≈-setoid : Setoid _ _ +≈-setoid = record + { Carrier = Poly + ; _≈_ = _≈_ + ; isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + } + +open module ≈-Reasoning = SetoidReasoning ≈-setoid + +--Properties of zero polynomial + +IsZero⇒p≈[] : IsZero p → p ≈ [] +IsZero⇒p≈[] [] = refl +IsZero⇒p≈[] (a≈0 ∷ p≈0) = ≈[] (_) (a≈0 ∷ p≈0) + +p≈[]⇒IsZero : p ≈ [] → IsZero p +p≈[]⇒IsZero ([]≈ [] q≈0) = q≈0 +p≈[]⇒IsZero (≈[] _ p≈0) = p≈0 + +IsZero⇒IsZero : IsZero p → IsZero q → p ≈ q +IsZero⇒IsZero [] q≈0 = []≈ _ q≈0 +IsZero⇒IsZero (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) +IsZero⇒IsZero (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = cons (SR.trans a≈0 (SR.sym b≈0)) + (trans (IsZero⇒IsZero p≈0 p≈0) (IsZero⇒IsZero p≈0 q≈0)) + +p≈[]⇒0∷p≈0 : p ≈ [] → IsZero (0# ∷ p) +p≈[]⇒0∷p≈0 ([]≈ [] refl) = SR.refl ∷ refl +p≈[]⇒0∷p≈0 (≈[] p p≈[]) = SR.refl ∷ p≈[] + +a∷p≈[]⇒a≈0 : (a ∷ p) ≈ [] → a ≈A 0# +a∷p≈[]⇒a≈0 (≈[] a∷p (a≈0 ∷ p≈0)) = a≈0 + +p≈[]⇒0∷p≈p : p ≈ [] → p ≈ (0# ∷ p) +p≈[]⇒0∷p≈p ([]≈ [] refl) = []≈ (0# ∷ []) (SR.refl ∷ refl) +p≈[]⇒0∷p≈p (≈[] [] p≈[]) = []≈ (0# ∷ []) (SR.refl ∷ p≈[]) +p≈[]⇒0∷p≈p (≈[] (a ∷ p) (a≈0 ∷ p≈0)) + = IsZero⇒IsZero (a≈0 ∷ p≈0) (SR.refl ∷ a≈0 ∷ p≈0) + +p≈[]∧q≈[]⇒p+q≈[] : IsZero p → IsZero q → IsZero (p + q) +p≈[]∧q≈[]⇒p+q≈[] [] [] = [] +p≈[]∧q≈[]⇒p+q≈[] [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 +p≈[]∧q≈[]⇒p+q≈[] (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 +p≈[]∧q≈[]⇒p+q≈[] (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) + = SR.trans (SR.+-cong a≈0 b≈0) (SR.+-identityʳ 0#) ∷ p≈[]∧q≈[]⇒p+q≈[] p≈0 q≈0 + +------------------------------------------- +--Properties of polynomial addition + ++-comm : (p : Poly) → (q : Poly) → p + q ≈ q + p +-comm [] [] = refl +-comm [] (a ∷ p) = refl +-comm (a ∷ p) [] = refl +-comm (a ∷ p) (b ∷ q) = cons (SR.+-comm a b) (+-comm p q) -+-idʳ : (p : Poly n) → (q : Poly m) → IsZero q → p + q ≈ p ++-idʳ : (p : Poly) → (q : Poly) → IsZero q → p + q ≈ p +-idʳ [] q [] = refl +-idʳ (a ∷ p) q [] = refl +-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) +-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) = cons (SR.trans (SR.+-congˡ b≈0) (SR.+-identityʳ a)) (+-idʳ p q q≈0) -+-idˡ : (p : Poly n) → (q : Poly m) → IsZero p → p + q ≈ q ++-idˡ : (p : Poly) → (q : Poly) → IsZero p → p + q ≈ q +-idˡ p q p≈0 = begin p + q ≈⟨ +-comm p q ⟩ q + p ≈⟨ +-idʳ q p p≈0 ⟩ q ∎ -+-identityʳ : (p : Poly n) → p + (zeros m) ≈ p -+-identityʳ {m = m} p = +-idʳ p (zeros m) (zerosIsZero m) ++-identityˡ : (p : Poly) → [] + p ≈ p ++-identityˡ p = +-idˡ [] p [] -+-identityˡ : (p : Poly n) → (zeros m) + p ≈ p -+-identityˡ {m = m} p = +-idˡ (zeros m) p (zerosIsZero m) ++-identityʳ : (p : Poly) → p + [] ≈ p ++-identityʳ p = +-idʳ p [] [] +-cong : p ≈ q → r ≈ s → p + r ≈ q + s -+-cong {p = _} {q = _} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin - [] + r ≈⟨ +-identityˡ r ⟩ ++-cong {r = r} {s = s} ([]≈ q q≈0) r≈s = begin + [] + r ≈⟨ +-idˡ [] r [] ⟩ r ≈⟨ r≈s ⟩ s ≈⟨ +-idˡ q s q≈0 ⟨ q + s ∎ -+-cong {p = _} {q = _} {r = r} {s = s} (≈[] p p≈0) r≈s = begin ++-cong {r = r} {s = s} (≈[] p p≈0) r≈s = begin p + r ≈⟨ +-idˡ p r p≈0 ⟩ r ≈⟨ r≈s ⟩ - s ≈⟨ +-identityˡ s ⟨ + s ≈⟨ +-idˡ [] s [] ⟨ [] + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} {r = _} {s = s} (cons a≈b p≈q) ([]≈ s s≈0) = begin ++-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin a ∷ p ≈⟨ cons a≈b p≈q ⟩ b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ (b ∷ q) + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} {r = r} {s = _} (cons a≈b p≈q) (≈[] r r≈0) = begin ++-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) (≈[] r r≈0) = begin (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ a ∷ p ≈⟨ cons a≈b p≈q ⟩ b ∷ q ∎ @@ -157,18 +154,18 @@ All[p≈0∧q≈0]⇒p+q≈0 {p = a ∷ p} {q = b ∷ q} (a≈0 ∷ p≈0) (b≈ +-congʳ : q ≈ r → p + q ≈ p + r +-congʳ q≈r = +-cong refl q≈r -+-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → ++-assoc : (p : Poly) → (q : Poly) → (r : Poly) → (p + q) + r ≈ p + (q + r) +-assoc [] q r = begin - ([] + q) + r ≈⟨ +-congˡ (+-identityˡ q) ⟩ - q + r ≈⟨ +-identityˡ (q + r) ⟨ + [] + q + r ≈⟨ +-congˡ (+-idˡ [] q []) ⟩ + q + r ≈⟨ +-idˡ [] (q + r) [] ⟨ [] + (q + r) ∎ -+-assoc (a ∷ p) [] r = +-congʳ (sym (+-identityˡ r)) ++-assoc (a ∷ p) [] r = +-congʳ (sym (+-idˡ [] r [])) +-assoc (a ∷ p) (b ∷ q) [] = refl +-assoc (a ∷ p) (b ∷ q) (c ∷ r) = cons (SR.+-assoc a b c) (+-assoc p q r) -middleFour : (p : Poly m) → (q : Poly n) → (r : Poly k) → (w : Poly l) → +middleFour : (p : Poly) → (q : Poly) → (r : Poly) → (w : Poly) → (p + q) + (r + w) ≈ (p + r) + (q + w) middleFour p q r w = begin (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ @@ -178,78 +175,62 @@ middleFour p q r w = begin (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ (p + r) + (q + w) ∎ ------------------------------------------------------------------- --- Vector casting lemmas - -private - - cast-p≈0⇒p≈0 : (m≡n : m ≡ n) → All (_≈A 0#) p → - All (_≈A 0#) (Vec.cast m≡n p) - cast-p≈0⇒p≈0 {n = 0} {[]} m≡n [] = [] - cast-p≈0⇒p≈0 {n = suc n} {a ∷ p} m≡n (a≈0 ∷ p≈0) - = a≈0 ∷ cast-p≈0⇒p≈0 (cong pred m≡n) p≈0 - - cast-p≈p : (m≡n : m ≡ n) → Vec.cast m≡n p ≈ p - cast-p≈p {n = 0} {[]} Eq.refl = refl - cast-p≈p {n = suc n} {a ∷ p} m≡n = consʳ (cast-p≈p (cong pred m≡n)) - ------------------------------------------------------------------- +-------------------------------------------------------------------- -- Properties of polynomial shifting -*-distrib-shift : (p : Poly m) → (q : Poly n) → - p * (shift q) ≈ shift (p * q) -*-distrib-shift {_} {_} [] qs = zerosm≈zerosn -*-distrib-shift {suc m} {n} (a ∷ p) q = begin +*-distrib-shift : (p : Poly) → (q : Poly) → + p * (shift q) ≈ shift (p * q) +*-distrib-shift [] q = begin + [] * (0# ∷ q) + ≈⟨ []≈ [] [] ⟩ + [] + ≈⟨ ≈[] (0# ∷ [] * q) (SR.refl ∷ []) ⟨ + 0# ∷ [] * q ∎ +*-distrib-shift (a ∷ p) q = begin (a ∷ p) * (0# ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ - a · (0# ∷ q) + p * (0# ∷ 0# ∷ q) ≈⟨ +-congˡ (consˡ (SR.zeroʳ a)) ⟩ (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) - ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ + ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ consˡ (SR.+-identityˡ 0#) ⟩ + ≈⟨ consˡ (SR.+-identityˡ 0#) ⟩ 0# ∷ (a · q + p * (0# ∷ q)) - ≈⟨ consʳ (cast-p≈p (cast-lem n m)) ⟨ + ≈⟨ consʳ refl ⟨ 0# ∷ ((a ∷ p) * q) - ∎ + ∎ -·-distrib-shift : (a : A) → (p : Poly m) → a · (shift p) ≈ shift (a · p) +·-distrib-shift : (a : A) → (p : Poly) → a · (shift p) ≈ shift (a · p) ·-distrib-shift a [] = cons (SR.zeroʳ a) (refl) ·-distrib-shift a (b ∷ p) = consˡ (SR.zeroʳ a) ---------------------------------------------------------------- -- Properties of polynomial scaling -a·p≈a∷[]*p : (a : A) → (p : Poly n) → a · p ≈ (a ∷ []) * p -a·p≈a∷[]*p {_} a [] = refl -a·p≈a∷[]*p {suc n} a (b ∷ p) = begin - a · (b ∷ p) - ≈⟨ cons (SR.+-identityʳ (a *A b)) (+-identityʳ (a · p)) ⟨ - a *A b +A 0# ∷ (a · p + zeros n) - ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟨ +a·p≈a∷[]*p : (a : A) → (p : Poly) → a · p ≈ (a ∷ []) * p +a·p≈a∷[]*p a [] = refl +a·p≈a∷[]*p a (b ∷ p) = begin + a · (b ∷ p) ≈⟨ +-idʳ (a · (b ∷ p)) ([] * (0# ∷ b ∷ p)) [] ⟨ (a ∷ []) * (b ∷ p) ∎ -1·p≈p : (p : Poly n) → 1# · p ≈ p +1·p≈p : (p : Poly) → 1# · p ≈ p 1·p≈p [] = refl 1·p≈p (a ∷ p) = cons (SR.*-identityˡ a) (1·p≈p p) - -pIsZero⇒a·pIsZero : (a : A) → (p : Poly n) → IsZero p → IsZero (a · p) -pIsZero⇒a·pIsZero a p [] = [] +pIsZero⇒a·pIsZero : (a : A) → (p : Poly) → IsZero p → IsZero (a · p) +pIsZero⇒a·pIsZero a p [] = [] pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) = (SR.trans (SR.*-congˡ b≈0) (SR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 -a≈0⇒a·pIsZero : (a : A) → (p : Poly n) → a ≈A 0# → IsZero (a · p) +a≈0⇒a·pIsZero : (a : A) → (p : Poly) → a ≈A 0# → IsZero (a · p) a≈0⇒a·pIsZero a [] a≈0 = [] a≈0⇒a·pIsZero a (b ∷ p) a≈0 = SR.trans (SR.*-congʳ a≈0) (SR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) ·-cong : a ≈A b → p ≈ q → a · p ≈ b · q -·-cong {a = _} {b = b} _ ([]≈ q q≈0) - = sym (IsZero⇒≈0 (pIsZero⇒a·pIsZero b q q≈0)) -·-cong {a = a} {b = _} _ (≈[] p p≈0) - = IsZero⇒≈0 (pIsZero⇒a·pIsZero a p p≈0) -·-cong {a = _} {b = _} c≈d (cons a≈b p≈q) +·-cong {a = a} {b = b} _ ([]≈ q q≈0) + = sym (≈[] (b · q) (pIsZero⇒a·pIsZero b q q≈0)) +·-cong {a = a} {b = b} _ (≈[] p p≈0) + = sym ([]≈ (a · p) (pIsZero⇒a·pIsZero a p p≈0)) +·-cong {a = a} {b = b} c≈d (cons a≈b p≈q) = cons (SR.*-cong c≈d a≈b) (·-cong c≈d p≈q) ·-congˡ : a ≈A b → a · p ≈ b · p @@ -266,79 +247,71 @@ a≈0⇒a·pIsZero a (b ∷ p) a≈0 ·-assoc : a · (b · p) ≈ (a *A b) · p ·-assoc {p = []} = refl -·-assoc {a} {b} {p = c ∷ p} = cons (SR.sym (SR.*-assoc a b c)) ·-assoc +·-assoc {a = a} {b = b} {p = c ∷ p} = cons (SR.sym (SR.*-assoc a b c)) ·-assoc a·-cong : p ≈ q → a · p ≈ a · q a·-cong = ·-cong SR.refl -·-distrib-+A : (a b : A) → (p : Poly m) → (a +A b) · p ≈ a · p + b · p +·-distrib-+A : (a b : A) → (p : Poly) → (a +A b) · p ≈ a · p + b · p ·-distrib-+A a b [] = refl ·-distrib-+A a b (c ∷ p) = cons (SR.distribʳ c a b) (·-distrib-+A a b p) ----------------------------------------------------------------- -- Properties of polynomial multiplication -zeroˡ : (p : Poly m) → [] * p ≈ [] -zeroˡ p = zerosm≈zerosn +pIsZero⇒p*qIsZero : (q : Poly) → IsZero p → IsZero (p * q) +pIsZero⇒p*qIsZero q [] = [] +pIsZero⇒p*qIsZero {p = a ∷ p} q (a≈0 ∷ p≈0) + = p≈[]∧q≈[]⇒p+q≈[] (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0) + +pIsZero⇒q*pIsZero : (q : Poly) → IsZero p → IsZero (q * p) +pIsZero⇒q*pIsZero [] p≈0 = [] +pIsZero⇒q*pIsZero {p = p} (b ∷ q) p≈0 + = p≈[]∧q≈[]⇒p+q≈[] (pIsZero⇒a·pIsZero b p p≈0) + (pIsZero⇒q*pIsZero q (SR.refl ∷ p≈0)) + +p≈[]⇒p*q≈[] : (q : Poly) → p ≈ [] → p * q ≈ [] +p≈[]⇒p*q≈[] q p≈[] + = IsZero⇒p≈[] (pIsZero⇒p*qIsZero q (p≈[]⇒IsZero p≈[])) + +p≈[]⇒q*p≈[] : (q : Poly) → p ≈ [] → q * p ≈ [] +p≈[]⇒q*p≈[] q p≈[] + = IsZero⇒p≈[] (pIsZero⇒q*pIsZero q (p≈[]⇒IsZero p≈[])) -zeroʳ : (p : Poly m) → p * [] ≈ [] +zeroˡ : (p : Poly) → [] * p ≈ [] +zeroˡ p = refl + +zeroʳ : (p : Poly) → p * [] ≈ [] zeroʳ [] = refl -zeroʳ {m} (a ∷ p) = begin - (a ∷ p) * [] ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ - (a · []) + p * (0# ∷ []) ≈⟨ +-identityˡ (p * (0# ∷ [])) ⟩ - p * (0# ∷ []) ≈⟨ *-distrib-shift p [] ⟩ - 0# ∷ (p * []) ≈⟨ consʳ (zeroʳ p) ⟩ - 0# ∷ [] ≈⟨ zerosm≈zerosn ⟩ - [] ∎ - -pIsZero⇒p*qIsZero : (q : Poly n) → IsZero p → IsZero (p * q) -pIsZero⇒p*qIsZero {n} {p = []} q [] = zerosIsZero (pred n) -pIsZero⇒p*qIsZero {n} {suc m} {p = a ∷ p} q (a≈0 ∷ p≈0) - = cast-p≈0⇒p≈0 (cast-lem n m) - (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0)) - -p≈[]⇒p*q≈[] : (q : Poly n) → p ≈ [] → p * q ≈ [] -p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero p≈0)) - -*-cong : {p : Poly m} → {q : Poly n} → {r : Poly k} → {s : Poly l} → - p ≈ q → r ≈ s → p * r ≈ q * s -*-cong {k = k} {q = q} {r} {s} ([]≈ q q≈0) r≈s = begin - [] * r ≈⟨ p≈[]⇒p*q≈[] r refl ⟩ - [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒≈0 q≈0) ⟨ - q * s ∎ -*-cong {k = k} {q = q} {r} {s} (≈[] p p≈0) r≈s = begin - p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 p≈0) ⟩ - [] ≈⟨ zerosm≈zerosn ⟩ - [] * s ∎ -*-cong {n = suc n} {l = l} {a ∷ p} {b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin +zeroʳ (a ∷ p) = begin (a ∷ p) * [] - ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟩ - [] + p * (0# ∷ []) - ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ (IsZero⇒≈0 s≈0))) ⟨ - [] + q * (0# ∷ s) - ≈⟨ +-congˡ (zerosm≈zerosn) ⟩ - zeros l + q * (0# ∷ s) - ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero b s s≈0)) ⟨ - (b · s) + q * (0# ∷ s) - ≈⟨ cast-p≈p (cast-lem l n) ⟨ - (b ∷ q) * s - ∎ -*-cong {suc m} {k = k} {p = a ∷ p} {b ∷ q} (cons a≈b p≈q) (≈[] r s≈0) = begin - (a ∷ p) * r - ≈⟨ cast-p≈p (cast-lem k m) ⟩ - (a · r) + p * (0# ∷ r) - ≈⟨ +-congʳ (*-cong (sym p≈q) (consʳ ([]≈ r s≈0))) ⟨ - (a · r) + q * (0# ∷ []) - ≈⟨ +-congˡ (IsZero⇒≈0 (pIsZero⇒a·pIsZero a r s≈0)) ⟩ - zeros k + q * (0# ∷ []) - ≈⟨ +-congˡ zerosm≈zerosn ⟩ - (b · []) + q * (0# ∷ []) - ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ - (b ∷ q) * [] - ∎ -*-cong {suc m} {suc n} {suc k} {suc l} {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin + ≈⟨ +-idˡ [] (p * (0# ∷ [])) [] ⟩ + p * (0# ∷ []) + ≈⟨ ≈[] (p * (0# ∷ [])) (pIsZero⇒q*pIsZero p (SR.refl ∷ [])) ⟩ + [] + ∎ + +*-cong : {p : Poly} → {q : Poly} → {r : Poly} → {s : Poly} → + p ≈ q → r ≈ s → p * r ≈ q * s +*-cong {q = q} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin + [] * r ≈⟨ zeroˡ r ⟩ + [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒p≈[] q≈0) ⟨ + q * s ∎ +*-cong {q = q} {r = r} {s = s} (≈[] p p≈0) r≈s = begin + p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒p≈[] p≈0) ⟩ + [] ≈⟨ zeroˡ p ⟨ + [] * s ∎ +*-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin + (a ∷ p) * [] ≈⟨ zeroʳ (a ∷ p) ⟩ + [] ≈⟨ p≈[]⇒q*p≈[] (b ∷ q) (IsZero⇒p≈[] s≈0) ⟨ + (b ∷ q) * s ∎ +*-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) (≈[] r r≈0) = begin + (a ∷ p) * r ≈⟨ p≈[]⇒q*p≈[] (a ∷ p) (IsZero⇒p≈[] r≈0) ⟩ + [] ≈⟨ zeroʳ (b ∷ q) ⟨ + (b ∷ q) * [] ∎ +*-cong {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin (a ∷ p) * (c ∷ r) - ≈⟨ cast-p≈p (cast-lem (suc k) m)⟩ + ≈⟨ refl ⟩ (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) ≈⟨ +-congˡ (consˡ (SR.*-cong a≈b c≈d)) ⟩ (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) @@ -346,9 +319,9 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) - ≈⟨ cast-p≈p (cast-lem (suc l) n) ⟨ + ≈⟨ refl ⟩ (b ∷ q) * (d ∷ s) - ∎ + ∎ *-congʳ : q ≈ r → p * q ≈ p * r *-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r @@ -356,30 +329,15 @@ p≈[]⇒p*q≈[] q p≈0 = IsZero⇒≈0 (pIsZero⇒p*qIsZero q (≈0⇒IsZero *-congˡ : p ≈ q → p * r ≈ q * r *-congˡ p≈q = *-cong p≈q refl -qIsZero⇒p*qIsZero : (p : Poly m) → IsZero q → IsZero (p * q) -qIsZero⇒p*qIsZero {m} {q = []} p [] = ≈0⇒IsZero (zeroʳ p) -qIsZero⇒p*qIsZero {m} {suc n} {q = b ∷ q} p (b≈0 ∷ q≈0) - = ≈0⇒IsZero ( - begin - p * (b ∷ q) ≈⟨ *-congʳ {p = p} (consˡ b≈0) ⟩ - p * (0# ∷ q) ≈⟨ *-distrib-shift p q ⟩ - 0# ∷ (p * q) ≈⟨ consʳ (IsZero⇒≈0 (qIsZero⇒p*qIsZero p q≈0)) ⟩ - 0# ∷ (zeros m) ≈⟨ zerosm≈zerosn ⟩ - zeros m ∎ - ) - -q≈[]→p*q≈[] : (p : Poly n) → q ≈ [] → p * q ≈ [] -q≈[]→p*q≈[] p q≈0 = IsZero⇒≈0 (qIsZero⇒p*qIsZero p (≈0⇒IsZero q≈0)) - -shift-distrib-+ : (p : Poly m) → (q : Poly n) → +shift-distrib-+ : (p : Poly) → (q : Poly) → shift (p + q) ≈ (shift p) + (shift q) shift-distrib-+ p q = cons (SR.sym (SR.+-identityʳ 0#)) refl -*-identityʳ : (p : Poly n) → p * (1# ∷ []) ≈ p -*-identityʳ {0} [] = zerosm≈zerosn -*-identityʳ {suc n} (a ∷ p) = begin +*-identityʳ : (p : Poly) → p * (1# ∷ []) ≈ p +*-identityʳ [] = zeroˡ [] +*-identityʳ (a ∷ p) = begin (a ∷ p) * (1# ∷ []) - ≈⟨ cast-p≈p (cast-lem 1 n) ⟩ + ≈⟨ refl ⟩ (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) ≈⟨ +-congˡ (consˡ (SR.*-identityʳ a)) ⟩ (a ∷ []) + (p * (0# ∷ 1# ∷ [])) @@ -390,23 +348,27 @@ shift-distrib-+ p q = cons (SR.sym (SR.+-identityʳ 0#)) refl ≈⟨ consʳ (*-identityʳ p) ⟩ a ∷ p ∎ -*-identityˡ : (p : Poly n) → (1# ∷ []) * p ≈ p +*-identityˡ : (p : Poly) → (1# ∷ []) * p ≈ p *-identityˡ [] = refl -*-identityˡ {suc n} (a ∷ p) = begin +*-identityˡ (a ∷ p) = begin (1# ∷ []) * (a ∷ p) - ≈⟨ consʳ (cast-p≈p (ℕ.⊔-idem n)) ⟩ + ≈⟨ consʳ refl ⟩ 1# · (a ∷ p) + [] * (0# ∷ a ∷ p) - ≈⟨ +-identityʳ {m = pred (suc (suc n))} (1# · (a ∷ p) + []) ⟩ + ≈⟨ +-identityʳ (1# · (a ∷ p) + []) ⟩ 1# · (a ∷ p) + [] - ≈⟨ +-identityʳ {m = 0} (1# · (a ∷ p)) ⟩ + ≈⟨ +-identityʳ (1# · (a ∷ p)) ⟩ 1# · (a ∷ p) ≈⟨ cons (SR.*-identityˡ a) (1·p≈p p) ⟩ a ∷ p ∎ --- (0# ∷ 1# ∷ []) is the center of a polynomial ring -shiftp≈p*x : (p : Poly n) → shift p ≈ p * (0# ∷ 1# ∷ []) -shiftp≈p*x [] = refl -shiftp≈p*x {suc n} (a ∷ p) = begin +shiftp≈p*x : (p : Poly) → shift p ≈ p * (0# ∷ 1# ∷ []) +shiftp≈p*x [] = sym (begin + [] * (0# ∷ 1# ∷ []) + ≈⟨ refl ⟩ + [] + ≈⟨ p≈[]⇒0∷p≈p refl ⟩ + 0# ∷ [] ∎) +shiftp≈p*x (a ∷ p) = begin 0# ∷ a ∷ p ≈⟨ cons (SR.+-identityˡ 0#) (cons (SR.+-identityʳ a) (+-identityˡ p)) ⟨ (0# ∷ a ∷ []) + shift (shift p) @@ -418,50 +380,46 @@ shiftp≈p*x {suc n} (a ∷ p) = begin (0# ∷ a ∷ []) + p * shift (shift (1# ∷ [])) ≈⟨ +-congˡ (cons (SR.zeroʳ a) (consˡ (SR.*-identityʳ a))) ⟨ a · (0# ∷ 1# ∷ []) + p * (0# ∷ 0# ∷ 1# ∷ []) - ≈⟨ cast-p≈p (cast-lem 2 n) ⟨ + ≈⟨ refl ⟨ (a ∷ p) * (0# ∷ 1# ∷ []) ∎ -shiftp≈x*p : (p : Poly n) → shift p ≈ (0# ∷ 1# ∷ []) * p -shiftp≈x*p [] - = consˡ (SR.sym (SR.trans (SR.+-identityʳ (1# *A 0#)) (SR.zeroʳ 1#))) -shiftp≈x*p {suc n} (a ∷ p) = begin - 0# ∷ a ∷ p - ≈⟨ *-identityˡ (0# ∷ a ∷ p) ⟨ - (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟨ - [] + (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ +-identityˡ {m = 0} ((1# ∷ []) * (0# ∷ a ∷ p)) ⟩ - (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ +-idˡ (0# *A a ∷ 0# · p) ((1# ∷ []) * (0# ∷ a ∷ p)) - ((SR.zeroˡ a) ∷ a≈0⇒a·pIsZero 0# p SR.refl) ⟨ - 0# · (a ∷ p) + (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ consʳ (cast-p≈p (ℕ.m≤n⇒m⊔n≡n (ℕ.n≤1+n n))) ⟨ - (0# ∷ 1# ∷ []) * (a ∷ p) ∎ - -·-distrib-* : (p : Poly m) → (q : Poly n) → (a : A) → +shiftp≈x*p : (p : Poly) → shift p ≈ (0# ∷ 1# ∷ []) * p +shiftp≈x*p [] = begin + 0# ∷ [] + ≈⟨ p≈[]⇒0∷p≈p refl ⟨ + [] + ≈⟨ zeroʳ (0# ∷ 1# ∷ []) ⟨ + (0# ∷ 1# ∷ []) * [] + ∎ +shiftp≈x*p (a ∷ p) = begin + 0# ∷ a ∷ p + ≈⟨ 1·p≈p (0# ∷ a ∷ p) ⟨ + 1# · (0# ∷ a ∷ p) + ≈⟨ +-identityʳ (1# · (0# ∷ a ∷ p)) ⟨ + 1# · (0# ∷ a ∷ p) + [] + ≈⟨ refl ⟨ + (1# ∷ []) * (0# ∷ a ∷ p) + ≈⟨ +-idˡ (0# · (a ∷ p)) ((1# ∷ []) * (0# ∷ a ∷ p)) + (a≈0⇒a·pIsZero 0# (a ∷ p) SR.refl)⟨ + (0# · (a ∷ p)) + ((1# ∷ []) * (0# ∷ a ∷ p)) + ≈⟨ refl ⟨ + (0# ∷ 1# ∷ []) * (a ∷ p) + ∎ + +·-distrib-* : (p : Poly) → (q : Poly) → (a : A) → a · (p * q) ≈ (a · p) * q -·-distrib-* {_} {n} [] q a = begin - a · ([] * q) ≈⟨ ·-congʳ zerosm≈zerosn ⟩ - a · [] ≈⟨ zerosm≈zerosn ⟨ - (a · []) * q ∎ -·-distrib-* {suc m} {_} (b ∷ p) [] a = begin - a · ((b ∷ p) * []) - ≈⟨ a·-cong (cast-p≈p (cong pred ℕ.n+1≡suc[n+0])) ⟩ - a · ((b · []) + (p * (0# ∷ []))) - ≈⟨ a·-cong (+-identityˡ (p * (0# ∷ []))) ⟩ - a · (p * (0# ∷ [])) - ≈⟨ a·-cong (q≈[]→p*q≈[] p zerosm≈zerosn) ⟩ +·-distrib-* [] q a = refl +·-distrib-* (b ∷ p) [] a = begin + a · ((b ∷ p) * []) + ≈⟨ a·-cong ( +-idʳ [] (p * (0# ∷ [])) + (pIsZero⇒q*pIsZero p (p≈[]⇒0∷p≈0 refl))) ⟩ [] - ≈⟨ q≈[]→p*q≈[] ((a · p)) zerosm≈zerosn ⟨ - (a · p) * (0# ∷ []) - ≈⟨ +-identityˡ ((a · p) * (0# ∷ [])) ⟨ - ((a *A b) · []) + ((a · p) * (0# ∷ [])) - ≈⟨ cast-p≈p (cong pred ℕ.n+1≡suc[n+0]) ⟨ + ≈⟨ zeroʳ (a · (b ∷ p)) ⟨ (a · (b ∷ p)) * [] ∎ -·-distrib-* {suc m} {suc n} (b ∷ p) (c ∷ q) a = begin +·-distrib-* (b ∷ p) (c ∷ q) a = begin a · ((b ∷ p) * (c ∷ q)) - ≈⟨ a·-cong (cast-p≈p (cast-lem (suc n) m)) ⟩ + ≈⟨ refl ⟩ a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) ≈⟨ ·-dist ⟩ a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) @@ -469,46 +427,41 @@ shiftp≈x*p {suc n} (a ∷ p) = begin (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟨ - (a · (b ∷ p)) * (c ∷ q) - ∎ + ≈⟨ refl ⟩ + (a · (b ∷ p)) * (c ∷ q) ∎ -0∷[p*q]≈[0∷p]*q : (p : Poly m) → (q : Poly n) → - shift (p * q) ≈ (shift p) * q -0∷[p*q]≈[0∷p]*q {n = n} [] q = begin +0∷[p*q]≈[0∷p]*q : (p : Poly) → (q : Poly) → shift (p * q) ≈ (shift p) * q +0∷[p*q]≈[0∷p]*q [] q = begin shift ([] * q) - ≈⟨ consʳ zerosm≈zerosn ⟩ + ≈⟨ consʳ (refl) ⟩ shift [] - ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (a≈0⇒a·pIsZero 0# q SR.refl) - (≈0⇒IsZero {m = n} zerosm≈zerosn)) ⟨ - 0# · q + zeros (pred (suc n)) - ≈⟨ cast-p≈p (ℕ.⊔-idem (pred (1 ℕ.+ n))) ⟨ - shift [] * q ∎ -0∷[p*q]≈[0∷p]*q {m = suc m} {n = n} (a ∷ p) (q) = begin + ≈⟨ p≈[]⇒0∷p≈p refl ⟨ + [] + ≈⟨ p≈[]⇒p*q≈[] q (sym (p≈[]⇒0∷p≈p refl)) ⟨ + (0# ∷ []) * q + ∎ +0∷[p*q]≈[0∷p]*q (a ∷ p) q = begin shift ((a ∷ p) * q) ≈⟨ *-distrib-shift (a ∷ p) q ⟨ (a ∷ p) * shift q - ≈⟨ cast-p≈p (cast-lem (suc n) m) ⟩ + ≈⟨ refl ⟩ a · shift q + p * (0# ∷ shift q) ≈⟨ +-idˡ (0# · q) (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) - (a≈0⇒a·pIsZero 0# q SR.refl) ⟨ + (a≈0⇒a·pIsZero 0# q SR.refl) ⟨ 0# · q + (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) - ≈⟨ +-congʳ (cast-p≈p (cast-lem (suc n) m)) ⟨ - 0# · q + (a ∷ p) * (0# ∷ q) - ≈⟨ cast-p≈p (cast-lem n (suc m)) ⟨ - shift (a ∷ p) * q ∎ - -*-distribˡ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → + ≈⟨ refl ⟩ + shift (a ∷ p) * q + ∎ + +*-distribˡ-+ : (p : Poly) → (q : Poly) → (r : Poly) → p * (q + r) ≈ p * q + p * r *-distribˡ-+ [] q r = begin - [] * (q + r) - ≈⟨ zerosm≈zerosn ⟩ - [] - ≈⟨ IsZero⇒≈0 (All[p≈0∧q≈0]⇒p+q≈0 (≈0⇒IsZero refl) (≈0⇒IsZero refl)) ⟨ - [] * q + [] * r ∎ -*-distribˡ-+ {m = suc m} {n = n} {k = k} (a ∷ p) q r = begin - (a ∷ p) * (q + r) - ≈⟨ cast-p≈p (cast-lem (n ⊔ k) m) ⟩ + [] * (q + r) ≈⟨ zeroˡ (q + r) ⟩ + [] ≈⟨ refl ⟩ + [] * q + [] * r ∎ +*-distribˡ-+ (a ∷ p) q r = begin + (a ∷ p) * (q + r) + ≈⟨ refl ⟩ a · (q + r) + p * (0# ∷ q + r) ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ (a · q + a · r) + (0# ∷ (p * (q + r))) @@ -520,55 +473,39 @@ shiftp≈x*p {suc n} (a ∷ p) = begin ((a · q) + (0# ∷ (p * q))) + ((a · r) + (0# ∷ (p * r))) ≈⟨ +-cong (+-congʳ (*-distrib-shift p q)) (+-congʳ (*-distrib-shift p r)) ⟨ (a · q + p * (0# ∷ q)) + (a · r + p * (0# ∷ r)) - ≈⟨ +-cong (cast-p≈p (cast-lem n m)) (cast-p≈p (cast-lem k m)) ⟨ + ≈⟨ refl ⟨ (a ∷ p) * q + (a ∷ p) * r ∎ -*-distribʳ-+ : (p : Poly m) → (q : Poly n) → (r : Poly k) → +*-distribʳ-+ : (p : Poly) → (q : Poly) → (r : Poly) → (q + r) * p ≈ (q * p) + (r * p) -*-distribʳ-+ {m = m} p [] [] = sym (+-identityʳ (zeros (m ℕ.∸ 1))) -*-distribʳ-+ {m = m} {k = suc k} p [] (c ∷ r) = begin - ([] + (c ∷ r)) * p - ≈⟨ cast-p≈p (cast-lem m k) ⟩ - c · p + r * (0# ∷ p) - ≈⟨ cast-p≈p (cast-lem m k) ⟨ - (c ∷ r) * p - ≈⟨ +-identityˡ ((c ∷ r) * p) ⟨ - [] * p + (c ∷ r) * p - ∎ -*-distribʳ-+ {m = m} {n = suc n} p (b ∷ q) [] = begin - ((b ∷ q) + []) * p - ≈⟨ cast-p≈p (cast-lem m n) ⟩ - b · p + q * (0# ∷ p) - ≈⟨ cast-p≈p (cast-lem m n) ⟨ - (b ∷ q) * p - ≈⟨ +-identityʳ ((b ∷ q) * p) ⟨ - (b ∷ q) * p + [] * p - ∎ -*-distribʳ-+ {m} {suc n} {suc k} p (b ∷ q) (c ∷ r) = begin +*-distribʳ-+ p [] [] = sym (+-identityʳ ([])) +*-distribʳ-+ p [] (c ∷ r) = begin + ([] + (c ∷ r)) * p ≈⟨ refl ⟩ + (c ∷ r) * p ≈⟨ +-identityˡ ((c ∷ r) * p) ⟨ + [] * p + (c ∷ r) * p ∎ +*-distribʳ-+ p (b ∷ q) [] = begin + ((b ∷ q) + []) * p ≈⟨ refl ⟩ + (b ∷ q) * p ≈⟨ +-identityʳ ((b ∷ q) * p) ⟨ + (b ∷ q) * p + [] * p ∎ +*-distribʳ-+ p (b ∷ q) (c ∷ r) = begin ((b ∷ q) + (c ∷ r)) * p - ≈⟨ cast-p≈p (cast-lem m (n ⊔ k)) ⟩ + ≈⟨ refl ⟩ (b +A c) · p + (q + r) * (0# ∷ p) ≈⟨ +-cong (·-distrib-+A b c p) (*-distribʳ-+ (0# ∷ p) q r) ⟩ ((b · p) + (c · p)) + (q * (0# ∷ p) + r * (0# ∷ p)) ≈⟨ middleFour (b · p) (c · p) (q * (0# ∷ p)) (r * (0# ∷ p)) ⟩ (b · p + q * (0# ∷ p)) + (c · p + r * (0# ∷ p)) - ≈⟨ +-cong (cast-p≈p (cast-lem m n)) (cast-p≈p (cast-lem m k)) ⟨ + ≈⟨ refl ⟨ (b ∷ q) * p + (c ∷ r) * p ∎ -*-assoc : (p : Poly m) → (q : Poly n) → (r : Poly k) → +*-assoc : (p : Poly) → (q : Poly) → (r : Poly) → (p * q) * r ≈ p * (q * r) -*-assoc {n = n} {k} [] q r = begin - zeros (n ℕ.∸ 1) * r - ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒≈0 (zerosIsZero (n ℕ.∸ 1))) ⟩ - [] - ≈⟨ zerosm≈zerosn ⟩ - zeros (pred (0 ℕ.+ pred (n ℕ.+ k))) - ∎ -*-assoc {suc m} {n} {k} (a ∷ p) q r = begin +*-assoc [] q r = refl +*-assoc (a ∷ p) q r = begin ((a ∷ p) * q) * r - ≈⟨ *-congˡ (cast-p≈p (cast-lem n m)) ⟩ + ≈⟨ refl ⟩ ((a · q) + (p * (0# ∷ q))) * r ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ ((a · q) + (0# ∷ (p * q))) * r @@ -580,7 +517,7 @@ shiftp≈x*p {suc n} (a ∷ p) = begin (a · (q * r)) + (0# ∷ (p * (q * r))) ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ (a · (q * r)) + (p * (0# ∷ (q * r))) - ≈⟨ cast-p≈p (cast-lem (pred (n ℕ.+ k)) m) ⟨ + ≈⟨ refl ⟩ (a ∷ p) * (q * r) ∎ where @@ -590,16 +527,230 @@ shiftp≈x*p {suc n} (a ∷ p) = begin 0# ∷ ((p * q) * r) ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ (0# ∷ (p * q)) * r - ≈⟨ cast-p≈p (cast-lem k (m ℕ.+ n ℕ.∸ 1)) ⟩ + ≈⟨ refl ⟩ (0# · r) + ((p * q) * (0# ∷ r)) - ≈⟨ +-congˡ (IsZero⇒≈0 (a≈0⇒a·pIsZero 0# r SR.refl) ) ⟩ - zeros k + ((p * q) * (0# ∷ r)) + ≈⟨ +-congˡ (IsZero⇒p≈[] (a≈0⇒a·pIsZero 0# r SR.refl) ) ⟩ + [] + ((p * q) * (0# ∷ r)) ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ - zeros k + (0# ∷ ((p * q) * r)) + [] + (0# ∷ ((p * q) * r)) ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ - zeros k + ((0# ∷ (p * q)) * r) + [] + ((0# ∷ (p * q)) * r) ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ (0# ∷ (p * q)) * r ∎ - + +-------------------------------------------------------------- +-- Algebraic properties of addition ++-identity : Identity [] _+_ ++-identity = +-identityˡ , +-identityʳ + +--------------------------------------------------------------- +-- Additive structures + +isEquivalence : IsEquivalence _≈_ +isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + ++-isMagma : IsMagma _≈_ _+_ ++-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = +-cong + } + ++-isSemigroup : IsSemigroup _≈_ _+_ ++-isSemigroup = record + { isMagma = +-isMagma + ; assoc = +-assoc + } + ++-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ ++-isCommutativeSemigroup = record + { isSemigroup = +-isSemigroup + ; comm = +-comm + } + ++-isMonoid : IsMonoid _≈_ _+_ [] ++-isMonoid = record + { isSemigroup = +-isSemigroup + ; identity = +-identity + } + ++-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ [] ++-isCommutativeMonoid = record + { isMonoid = +-isMonoid + ; comm = +-comm + } + +--------------------------------------------------------------- +-- Additive raw bundles ++-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ ++-rawMagma = record + { Carrier = Poly + ; _≈_ = _≈_ + ; _∙_ = _+_ + } + ++-rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ ++-rawSemiring = record + { Carrier = Poly + ; _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = [] + ; 1# = 1# ∷ [] + } + +-- Additive bundles + ++-magma : Algebra.Bundles.Magma _ _ ++-magma = record + { isMagma = +-isMagma + } + ++-semigroup : Algebra.Bundles.Semigroup _ _ ++-semigroup = record + { isSemigroup = +-isSemigroup + } + ++-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ ++-commutativeSemigroup = record + { isCommutativeSemigroup = +-isCommutativeSemigroup + } + ++-monoid : Algebra.Bundles.Monoid _ _ ++-monoid = record + { isMonoid = +-isMonoid + } + ++-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ ++-commutativeMonoid = record + { isCommutativeMonoid = +-isCommutativeMonoid + } + +*-identity : Identity (1# ∷ []) _*_ +*-identity = *-identityˡ , *-identityʳ + +*-zeroˡ : LeftZero [] _*_ +*-zeroˡ p = zeroˡ p + +*-zeroʳ : RightZero [] _*_ +*-zeroʳ p = zeroʳ p + +*-zero : Zero [] _*_ +*-zero = *-zeroˡ , *-zeroʳ + +*-distrib-+ : _*_ DistributesOver _+_ +*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ + +------------------------------------------------------------------ +-- Multiplicative structure + +*-isMagma : IsMagma _≈_ _*_ +*-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = *-cong + } + +*-isSemigroup : IsSemigroup _≈_ _*_ +*-isSemigroup = record + { isMagma = *-isMagma + ; assoc = *-assoc + } + +*-isMonoid : IsMonoid _≈_ _*_ (1# ∷ []) +*-isMonoid = record + { isSemigroup = *-isSemigroup + ; identity = *-identity + } + ++-*-isSemiring : IsSemiring _≈_ _+_ _*_ [] (1# ∷ []) ++-*-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = +-isCommutativeMonoid + ; *-cong = *-cong + ; *-assoc = *-assoc + ; *-identity = *-identity + ; distrib = *-distrib-+ + } + ; zero = *-zero + } + +--------------------------------------------------------------- +-- Multiplicative bundles + +*-magma : Algebra.Bundles.Magma _ _ +*-magma = record + { isMagma = *-isMagma + } + +*-semigroup : Algebra.Bundles.Semigroup _ _ +*-semigroup = record + { isSemigroup = *-isSemigroup + } + +*-monoid : Algebra.Bundles.Monoid _ _ +*-monoid = record + { isMonoid = *-isMonoid + } + ++-*-semiring : Semiring _ _ ++-*-semiring = record + { isSemiring = +-*-isSemiring + } + +------------------------------------------------------ +-- Degree function and polynomial normalization + +module _ (_≟0 : ∀ a → Dec (a ≈A 0#)) where + +-- true degree function of a polynomial + deg : Poly → Maybe ℕ + deg [] = nothing + deg (a ∷ p) with deg p + ... | just n = just (suc n) + ... | nothing with a ≟0 + ... | yes _ = nothing + ... | no _ = just 0 + +-- normalization operation for a polynomial + norm : Poly → Poly + norm [] = [] + norm (a ∷ p) with norm p + ... | b ∷ q = a ∷ b ∷ q + ... | [] with a ≟0 + ... | yes _ = [] + ... | no _ = a ∷ [] + + just≢nothing : ∀ {n : ℕ} → just n ≢ nothing + just≢nothing () + + IsZero⇒deg≡nothing : ∀ {p} → IsZero p → deg p ≡ nothing + IsZero⇒deg≡nothing [] = Eq.refl + IsZero⇒deg≡nothing {a ∷ p} (a≈0 ∷ p≈0) + rewrite IsZero⇒deg≡nothing p≈0 with a ≟0 + ... | yes _ = Eq.refl + ... | no ¬a≈0 = ⊥-elim (¬a≈0 a≈0) + + deg≡nothing⇒IsZero : ∀ {p} → deg p ≡ nothing → IsZero p + deg≡nothing⇒IsZero {[]} eq = [] + deg≡nothing⇒IsZero {a ∷ p} eq with deg p in taildeg + ... | just n = ⊥-elim (just≢nothing eq) + ... | nothing with a ≟0 + ... | yes a≈0 = a≈0 ∷ deg≡nothing⇒IsZero {p} taildeg + ... | no _ = ⊥-elim (just≢nothing eq) + + deg-cong : ∀ {p q} → p ≈ q → deg p ≡ deg q + deg-cong ([]≈ q []≈q) = Eq.sym (IsZero⇒deg≡nothing []≈q) + deg-cong (≈[] p p≈[]) = IsZero⇒deg≡nothing p≈[] + deg-cong {a ∷ p} {b ∷ q} (cons a≈b p≈q) + rewrite deg-cong p≈q with deg q + ... | just n = Eq.refl + ... | nothing with a ≟0 | b ≟0 + ... | yes _ | yes _ = Eq.refl + ... | no _ | no _ = Eq.refl + ... | yes a≈0 | no ¬b≈0 = ⊥-elim (¬b≈0 (SR.trans (SR.sym a≈b) a≈0)) + ... | no ¬a≈0 | yes b≈0 = ⊥-elim (¬a≈0 (SR.trans a≈b b≈0)) diff --git a/src/Algebra/Polynomial/Poly/Properties/Semiring2.agda b/src/Algebra/Polynomial/Poly/Properties/Semiring2.agda deleted file mode 100644 index baf3048901..0000000000 --- a/src/Algebra/Polynomial/Poly/Properties/Semiring2.agda +++ /dev/null @@ -1,756 +0,0 @@ -open import Algebra.Bundles using (Semiring) - -module Algebra.Polynomial.Poly.Properties.Semiring2 - {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) - where - -open import Algebra.Bundles.Raw -import Algebra.Definitions as Def -open import Algebra.Polynomial.Poly.Base.Semiring2 SR as P public - using ( Poly; _+_; _*_; _·_; shift; _≈_; refl; trans; sym - ; IsZero; []≈ ; ≈[]; cons; zeros-unique; consˡ; consʳ) -open import Algebra.Structures - using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid - ; IsSemiring; IsCommutativeMonoid) -open import Data.Empty using (⊥; ⊥-elim) -open import Data.List.Base as List using (List; []; _∷_) -open import Data.List.Relation.Unary.All using (All ; []; _∷_) -open import Data.Maybe.Base as Maybe using (Maybe; just; nothing) -open import Data.Nat.Base as ℕ using (ℕ; suc; pred; _⊔_) -open import Data.Product using (_,_) -open import Relation.Binary -open import Relation.Binary.PropositionalEquality as Eq - using (_≡_; _≢_; module ≡-Reasoning) -open import Relation.Binary.PropositionalEquality.Core using (cong) -import Relation.Binary.Reasoning.Setoid as SetoidReasoning -open import Relation.Nullary using (Dec; yes; no) - -open Def _≈_ - -module SR = Semiring SR -open SR - renaming - ( Carrier to A - ; _≈_ to _≈A_ - ; _+_ to _+A_ - ; _*_ to _*A_ - ) - using (0#; 1#) - -private - variable - a b c d : A - p : Poly - q : Poly - r : Poly - s : Poly - ---------------------------------------------------- --- Equational reasoning for Polynomials - -≈-setoid : Setoid _ _ -≈-setoid = record - { Carrier = Poly - ; _≈_ = _≈_ - ; isEquivalence = record - { refl = refl - ; sym = sym - ; trans = trans - } - } - -open module ≈-Reasoning = SetoidReasoning ≈-setoid - ---Properties of zero polynomial - -IsZero⇒p≈[] : IsZero p → p ≈ [] -IsZero⇒p≈[] [] = refl -IsZero⇒p≈[] (a≈0 ∷ p≈0) = ≈[] (_) (a≈0 ∷ p≈0) - -p≈[]⇒IsZero : p ≈ [] → IsZero p -p≈[]⇒IsZero ([]≈ [] q≈0) = q≈0 -p≈[]⇒IsZero (≈[] _ p≈0) = p≈0 - -IsZero⇒IsZero : IsZero p → IsZero q → p ≈ q -IsZero⇒IsZero [] q≈0 = []≈ _ q≈0 -IsZero⇒IsZero (a≈0 ∷ p≈0) [] = ≈[] (_ ∷ _) (a≈0 ∷ p≈0) -IsZero⇒IsZero (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = cons (SR.trans a≈0 (SR.sym b≈0)) - (trans (IsZero⇒IsZero p≈0 p≈0) (IsZero⇒IsZero p≈0 q≈0)) - -p≈[]⇒0∷p≈0 : p ≈ [] → IsZero (0# ∷ p) -p≈[]⇒0∷p≈0 ([]≈ [] refl) = SR.refl ∷ refl -p≈[]⇒0∷p≈0 (≈[] p p≈[]) = SR.refl ∷ p≈[] - -a∷p≈[]⇒a≈0 : (a ∷ p) ≈ [] → a ≈A 0# -a∷p≈[]⇒a≈0 (≈[] a∷p (a≈0 ∷ p≈0)) = a≈0 - -p≈[]⇒0∷p≈p : p ≈ [] → p ≈ (0# ∷ p) -p≈[]⇒0∷p≈p ([]≈ [] refl) = []≈ (0# ∷ []) (SR.refl ∷ refl) -p≈[]⇒0∷p≈p (≈[] [] p≈[]) = []≈ (0# ∷ []) (SR.refl ∷ p≈[]) -p≈[]⇒0∷p≈p (≈[] (a ∷ p) (a≈0 ∷ p≈0)) - = IsZero⇒IsZero (a≈0 ∷ p≈0) (SR.refl ∷ a≈0 ∷ p≈0) - -p≈[]∧q≈[]⇒p+q≈[] : IsZero p → IsZero q → IsZero (p + q) -p≈[]∧q≈[]⇒p+q≈[] [] [] = [] -p≈[]∧q≈[]⇒p+q≈[] [] (b≈0 ∷ q≈0) = b≈0 ∷ q≈0 -p≈[]∧q≈[]⇒p+q≈[] (a≈0 ∷ p≈0) [] = a≈0 ∷ p≈0 -p≈[]∧q≈[]⇒p+q≈[] (a≈0 ∷ p≈0) (b≈0 ∷ q≈0) - = SR.trans (SR.+-cong a≈0 b≈0) (SR.+-identityʳ 0#) ∷ p≈[]∧q≈[]⇒p+q≈[] p≈0 q≈0 - -------------------------------------------- ---Properties of polynomial addition - -+-comm : (p : Poly) → (q : Poly) → p + q ≈ q + p -+-comm [] [] = refl -+-comm [] (a ∷ p) = refl -+-comm (a ∷ p) [] = refl -+-comm (a ∷ p) (b ∷ q) = cons (SR.+-comm a b) (+-comm p q) - -+-idʳ : (p : Poly) → (q : Poly) → IsZero q → p + q ≈ p -+-idʳ [] q [] = refl -+-idʳ (a ∷ p) q [] = refl -+-idʳ [] (a ∷ q) (a≈0 ∷ q≈0) = ≈[] (a ∷ q) (a≈0 ∷ q≈0) -+-idʳ (a ∷ p) (b ∷ q) (b≈0 ∷ q≈0) - = cons (SR.trans (SR.+-congˡ b≈0) (SR.+-identityʳ a)) (+-idʳ p q q≈0) - -+-idˡ : (p : Poly) → (q : Poly) → IsZero p → p + q ≈ q -+-idˡ p q p≈0 = begin - p + q ≈⟨ +-comm p q ⟩ - q + p ≈⟨ +-idʳ q p p≈0 ⟩ - q ∎ - -+-identityˡ : (p : Poly) → [] + p ≈ p -+-identityˡ p = +-idˡ [] p [] - -+-identityʳ : (p : Poly) → p + [] ≈ p -+-identityʳ p = +-idʳ p [] [] - -+-cong : p ≈ q → r ≈ s → p + r ≈ q + s -+-cong {r = r} {s = s} ([]≈ q q≈0) r≈s = begin - [] + r ≈⟨ +-idˡ [] r [] ⟩ - r ≈⟨ r≈s ⟩ - s ≈⟨ +-idˡ q s q≈0 ⟨ - q + s ∎ -+-cong {r = r} {s = s} (≈[] p p≈0) r≈s = begin - p + r ≈⟨ +-idˡ p r p≈0 ⟩ - r ≈⟨ r≈s ⟩ - s ≈⟨ +-idˡ [] s [] ⟨ - [] + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin - a ∷ p ≈⟨ cons a≈b p≈q ⟩ - b ∷ q ≈⟨ +-idʳ (b ∷ q) s s≈0 ⟨ - (b ∷ q) + s ∎ -+-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) (≈[] r r≈0) = begin - (a ∷ p) + r ≈⟨ +-idʳ (a ∷ p) r r≈0 ⟩ - a ∷ p ≈⟨ cons a≈b p≈q ⟩ - b ∷ q ∎ -+-cong (cons a≈b p≈q) (cons c≈d r≈s) - = cons (SR.+-cong a≈b c≈d) (+-cong p≈q r≈s) - -+-congˡ : p ≈ q → p + r ≈ q + r -+-congˡ p≈q = +-cong p≈q refl - -+-congʳ : q ≈ r → p + q ≈ p + r -+-congʳ q≈r = +-cong refl q≈r - -+-assoc : (p : Poly) → (q : Poly) → (r : Poly) → - (p + q) + r ≈ p + (q + r) -+-assoc [] q r = begin - [] + q + r ≈⟨ +-congˡ (+-idˡ [] q []) ⟩ - q + r ≈⟨ +-idˡ [] (q + r) [] ⟨ - [] + (q + r) ∎ -+-assoc (a ∷ p) [] r = +-congʳ (sym (+-idˡ [] r [])) -+-assoc (a ∷ p) (b ∷ q) [] = refl -+-assoc (a ∷ p) (b ∷ q) (c ∷ r) - = cons (SR.+-assoc a b c) (+-assoc p q r) - -middleFour : (p : Poly) → (q : Poly) → (r : Poly) → (w : Poly) → - (p + q) + (r + w) ≈ (p + r) + (q + w) -middleFour p q r w = begin - (p + q) + (r + w) ≈⟨ +-assoc (p + q) r w ⟨ - (p + q + r) + w ≈⟨ +-congˡ (+-assoc p q r) ⟩ - (p + (q + r)) + w ≈⟨ +-congˡ (+-congʳ (+-comm q r)) ⟩ - (p + (r + q)) + w ≈⟨ +-congˡ (+-assoc p r q) ⟨ - (p + r + q) + w ≈⟨ +-assoc (p + r) q w ⟩ - (p + r) + (q + w) ∎ - --------------------------------------------------------------------- --- Properties of polynomial shifting - -*-distrib-shift : (p : Poly) → (q : Poly) → - p * (shift q) ≈ shift (p * q) -*-distrib-shift [] q = begin - [] * (0# ∷ q) - ≈⟨ []≈ [] [] ⟩ - [] - ≈⟨ ≈[] (0# ∷ [] * q) (SR.refl ∷ []) ⟨ - 0# ∷ [] * q ∎ -*-distrib-shift (a ∷ p) q = begin - (a ∷ p) * (0# ∷ q) - ≈⟨ +-congˡ (consˡ (SR.zeroʳ a)) ⟩ - (0# ∷ a · q) + p * (0# ∷ 0# ∷ q) - ≈⟨ +-congʳ (*-distrib-shift p (0# ∷ q)) ⟩ - (0# ∷ a · q) + (0# ∷ (p * (0# ∷ q))) - ≈⟨ consˡ (SR.+-identityˡ 0#) ⟩ - 0# ∷ (a · q + p * (0# ∷ q)) - ≈⟨ consʳ refl ⟨ - 0# ∷ ((a ∷ p) * q) - ∎ - -·-distrib-shift : (a : A) → (p : Poly) → a · (shift p) ≈ shift (a · p) -·-distrib-shift a [] = cons (SR.zeroʳ a) (refl) -·-distrib-shift a (b ∷ p) = consˡ (SR.zeroʳ a) - ----------------------------------------------------------------- --- Properties of polynomial scaling - -a·p≈a∷[]*p : (a : A) → (p : Poly) → a · p ≈ (a ∷ []) * p -a·p≈a∷[]*p a [] = refl -a·p≈a∷[]*p a (b ∷ p) = begin - a · (b ∷ p) ≈⟨ +-idʳ (a · (b ∷ p)) ([] * (0# ∷ b ∷ p)) [] ⟨ - (a ∷ []) * (b ∷ p) ∎ - -1·p≈p : (p : Poly) → 1# · p ≈ p -1·p≈p [] = refl -1·p≈p (a ∷ p) = cons (SR.*-identityˡ a) (1·p≈p p) - -pIsZero⇒a·pIsZero : (a : A) → (p : Poly) → IsZero p → IsZero (a · p) -pIsZero⇒a·pIsZero a p [] = [] -pIsZero⇒a·pIsZero a (b ∷ p) (b≈0 ∷ p≈0) - = (SR.trans (SR.*-congˡ b≈0) (SR.zeroʳ a)) ∷ pIsZero⇒a·pIsZero a p p≈0 - -a≈0⇒a·pIsZero : (a : A) → (p : Poly) → a ≈A 0# → IsZero (a · p) -a≈0⇒a·pIsZero a [] a≈0 = [] -a≈0⇒a·pIsZero a (b ∷ p) a≈0 - = SR.trans (SR.*-congʳ a≈0) (SR.zeroˡ b) ∷ (a≈0⇒a·pIsZero a p a≈0) - -·-cong : a ≈A b → p ≈ q → a · p ≈ b · q -·-cong {a = a} {b = b} _ ([]≈ q q≈0) - = sym (≈[] (b · q) (pIsZero⇒a·pIsZero b q q≈0)) -·-cong {a = a} {b = b} _ (≈[] p p≈0) - = sym ([]≈ (a · p) (pIsZero⇒a·pIsZero a p p≈0)) -·-cong {a = a} {b = b} c≈d (cons a≈b p≈q) - = cons (SR.*-cong c≈d a≈b) (·-cong c≈d p≈q) - -·-congˡ : a ≈A b → a · p ≈ b · p -·-congˡ a≈b = ·-cong a≈b refl - -·-congʳ : p ≈ q → a · p ≈ a · q -·-congʳ = ·-cong SR.refl - -·-dist : a · (p + q) ≈ (a · p) + (a · q) -·-dist {p = []} {q = []} = refl -·-dist {p = []} {q = b ∷ q} = refl -·-dist {p = b ∷ p} {q = []} = refl -·-dist {a = a} {p = b ∷ p} {q = c ∷ q} = cons (SR.distribˡ a b c) ·-dist - -·-assoc : a · (b · p) ≈ (a *A b) · p -·-assoc {p = []} = refl -·-assoc {a = a} {b = b} {p = c ∷ p} = cons (SR.sym (SR.*-assoc a b c)) ·-assoc - -a·-cong : p ≈ q → a · p ≈ a · q -a·-cong = ·-cong SR.refl - -·-distrib-+A : (a b : A) → (p : Poly) → (a +A b) · p ≈ a · p + b · p -·-distrib-+A a b [] = refl -·-distrib-+A a b (c ∷ p) = cons (SR.distribʳ c a b) (·-distrib-+A a b p) - ------------------------------------------------------------------ --- Properties of polynomial multiplication - -pIsZero⇒p*qIsZero : (q : Poly) → IsZero p → IsZero (p * q) -pIsZero⇒p*qIsZero q [] = [] -pIsZero⇒p*qIsZero {p = a ∷ p} q (a≈0 ∷ p≈0) - = p≈[]∧q≈[]⇒p+q≈[] (a≈0⇒a·pIsZero a q a≈0) (pIsZero⇒p*qIsZero (0# ∷ q) p≈0) - -pIsZero⇒q*pIsZero : (q : Poly) → IsZero p → IsZero (q * p) -pIsZero⇒q*pIsZero [] p≈0 = [] -pIsZero⇒q*pIsZero {p = p} (b ∷ q) p≈0 - = p≈[]∧q≈[]⇒p+q≈[] (pIsZero⇒a·pIsZero b p p≈0) - (pIsZero⇒q*pIsZero q (SR.refl ∷ p≈0)) - -p≈[]⇒p*q≈[] : (q : Poly) → p ≈ [] → p * q ≈ [] -p≈[]⇒p*q≈[] q p≈[] - = IsZero⇒p≈[] (pIsZero⇒p*qIsZero q (p≈[]⇒IsZero p≈[])) - -p≈[]⇒q*p≈[] : (q : Poly) → p ≈ [] → q * p ≈ [] -p≈[]⇒q*p≈[] q p≈[] - = IsZero⇒p≈[] (pIsZero⇒q*pIsZero q (p≈[]⇒IsZero p≈[])) - -zeroˡ : (p : Poly) → [] * p ≈ [] -zeroˡ p = refl - -zeroʳ : (p : Poly) → p * [] ≈ [] -zeroʳ [] = refl -zeroʳ (a ∷ p) = begin - (a ∷ p) * [] - ≈⟨ +-idˡ [] (p * (0# ∷ [])) [] ⟩ - p * (0# ∷ []) - ≈⟨ ≈[] (p * (0# ∷ [])) (pIsZero⇒q*pIsZero p (SR.refl ∷ [])) ⟩ - [] - ∎ - -*-cong : {p : Poly} → {q : Poly} → {r : Poly} → {s : Poly} → - p ≈ q → r ≈ s → p * r ≈ q * s -*-cong {q = q} {r = r} {s = s} ([]≈ q q≈0) r≈s = begin - [] * r ≈⟨ zeroˡ r ⟩ - [] ≈⟨ p≈[]⇒p*q≈[] s (IsZero⇒p≈[] q≈0) ⟨ - q * s ∎ -*-cong {q = q} {r = r} {s = s} (≈[] p p≈0) r≈s = begin - p * r ≈⟨ p≈[]⇒p*q≈[] r (IsZero⇒p≈[] p≈0) ⟩ - [] ≈⟨ zeroˡ p ⟨ - [] * s ∎ -*-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) ([]≈ s s≈0) = begin - (a ∷ p) * [] ≈⟨ zeroʳ (a ∷ p) ⟩ - [] ≈⟨ p≈[]⇒q*p≈[] (b ∷ q) (IsZero⇒p≈[] s≈0) ⟨ - (b ∷ q) * s ∎ -*-cong {p = a ∷ p} {q = b ∷ q} (cons a≈b p≈q) (≈[] r r≈0) = begin - (a ∷ p) * r ≈⟨ p≈[]⇒q*p≈[] (a ∷ p) (IsZero⇒p≈[] r≈0) ⟩ - [] ≈⟨ zeroʳ (b ∷ q) ⟨ - (b ∷ q) * [] ∎ -*-cong {a ∷ p} {b ∷ q} {c ∷ r} {d ∷ s} (cons a≈b p≈q) (cons c≈d r≈s) = begin - (a ∷ p) * (c ∷ r) - ≈⟨ refl ⟩ - (a *A c ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consˡ (SR.*-cong a≈b c≈d)) ⟩ - (b *A d ∷ a · r) + p * (0# ∷ c ∷ r) - ≈⟨ +-congˡ (consʳ (·-cong a≈b r≈s)) ⟩ - (b *A d ∷ b · s) + p * (0# ∷ c ∷ r) - ≈⟨ +-congʳ (*-cong p≈q (consʳ (cons c≈d r≈s))) ⟩ - (b *A d ∷ b · s) + q * (0# ∷ d ∷ s) - ≈⟨ refl ⟩ - (b ∷ q) * (d ∷ s) - ∎ - -*-congʳ : q ≈ r → p * q ≈ p * r -*-congʳ {p = p} q≈r = *-cong {p = p} refl q≈r - -*-congˡ : p ≈ q → p * r ≈ q * r -*-congˡ p≈q = *-cong p≈q refl - -shift-distrib-+ : (p : Poly) → (q : Poly) → - shift (p + q) ≈ (shift p) + (shift q) -shift-distrib-+ p q = cons (SR.sym (SR.+-identityʳ 0#)) refl - -*-identityʳ : (p : Poly) → p * (1# ∷ []) ≈ p -*-identityʳ [] = zeroˡ [] -*-identityʳ (a ∷ p) = begin - (a ∷ p) * (1# ∷ []) - ≈⟨ refl ⟩ - (a *A 1# ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congˡ (consˡ (SR.*-identityʳ a)) ⟩ - (a ∷ []) + (p * (0# ∷ 1# ∷ [])) - ≈⟨ +-congʳ (*-distrib-shift p (1# ∷ [])) ⟩ - (a ∷ []) + (0# ∷ (p * (1# ∷ []))) - ≈⟨ cons (SR.+-identityʳ a) (+-identityˡ (p * (1# ∷ []))) ⟩ - a ∷ (p * (1# ∷ [])) - ≈⟨ consʳ (*-identityʳ p) ⟩ - a ∷ p ∎ - -*-identityˡ : (p : Poly) → (1# ∷ []) * p ≈ p -*-identityˡ [] = refl -*-identityˡ (a ∷ p) = begin - (1# ∷ []) * (a ∷ p) - ≈⟨ consʳ refl ⟩ - 1# · (a ∷ p) + [] * (0# ∷ a ∷ p) - ≈⟨ +-identityʳ (1# · (a ∷ p) + []) ⟩ - 1# · (a ∷ p) + [] - ≈⟨ +-identityʳ (1# · (a ∷ p)) ⟩ - 1# · (a ∷ p) - ≈⟨ cons (SR.*-identityˡ a) (1·p≈p p) ⟩ - a ∷ p ∎ - -shiftp≈p*x : (p : Poly) → shift p ≈ p * (0# ∷ 1# ∷ []) -shiftp≈p*x [] = sym (begin - [] * (0# ∷ 1# ∷ []) - ≈⟨ refl ⟩ - [] - ≈⟨ p≈[]⇒0∷p≈p refl ⟩ - 0# ∷ [] ∎) -shiftp≈p*x (a ∷ p) = begin - 0# ∷ a ∷ p - ≈⟨ cons (SR.+-identityˡ 0#) (cons (SR.+-identityʳ a) (+-identityˡ p)) ⟨ - (0# ∷ a ∷ []) + shift (shift p) - ≈⟨ consʳ (consʳ (+-congʳ (*-identityʳ p))) ⟨ - (0# ∷ a ∷ []) + (shift (shift (p * (1# ∷ [])))) - ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (consʳ (*-distrib-shift p (1# ∷ []))) ⟨ - (0# ∷ a ∷ []) + shift (p * shift (1# ∷ [])) - ≈⟨ +-congʳ {p = 0# ∷ a ∷ []} (*-distrib-shift p (0# ∷ 1# ∷ [])) ⟨ - (0# ∷ a ∷ []) + p * shift (shift (1# ∷ [])) - ≈⟨ +-congˡ (cons (SR.zeroʳ a) (consˡ (SR.*-identityʳ a))) ⟨ - a · (0# ∷ 1# ∷ []) + p * (0# ∷ 0# ∷ 1# ∷ []) - ≈⟨ refl ⟨ - (a ∷ p) * (0# ∷ 1# ∷ []) ∎ - -shiftp≈x*p : (p : Poly) → shift p ≈ (0# ∷ 1# ∷ []) * p -shiftp≈x*p [] = begin - 0# ∷ [] - ≈⟨ p≈[]⇒0∷p≈p refl ⟨ - [] - ≈⟨ zeroʳ (0# ∷ 1# ∷ []) ⟨ - (0# ∷ 1# ∷ []) * [] - ∎ -shiftp≈x*p (a ∷ p) = begin - 0# ∷ a ∷ p - ≈⟨ 1·p≈p (0# ∷ a ∷ p) ⟨ - 1# · (0# ∷ a ∷ p) - ≈⟨ +-identityʳ (1# · (0# ∷ a ∷ p)) ⟨ - 1# · (0# ∷ a ∷ p) + [] - ≈⟨ refl ⟨ - (1# ∷ []) * (0# ∷ a ∷ p) - ≈⟨ +-idˡ (0# · (a ∷ p)) ((1# ∷ []) * (0# ∷ a ∷ p)) - (a≈0⇒a·pIsZero 0# (a ∷ p) SR.refl)⟨ - (0# · (a ∷ p)) + ((1# ∷ []) * (0# ∷ a ∷ p)) - ≈⟨ refl ⟨ - (0# ∷ 1# ∷ []) * (a ∷ p) - ∎ - -·-distrib-* : (p : Poly) → (q : Poly) → (a : A) → - a · (p * q) ≈ (a · p) * q -·-distrib-* [] q a = refl -·-distrib-* (b ∷ p) [] a = begin - a · ((b ∷ p) * []) - ≈⟨ a·-cong ( +-idʳ [] (p * (0# ∷ [])) - (pIsZero⇒q*pIsZero p (p≈[]⇒0∷p≈0 refl))) ⟩ - [] - ≈⟨ zeroʳ (a · (b ∷ p)) ⟨ - (a · (b ∷ p)) * [] - ∎ -·-distrib-* (b ∷ p) (c ∷ q) a = begin - a · ((b ∷ p) * (c ∷ q)) - ≈⟨ refl ⟩ - a · ((b · (c ∷ q)) + (p * (0# ∷ c ∷ q))) - ≈⟨ ·-dist ⟩ - a · (b *A c ∷ (b · q)) + a · (p * (0# ∷ c ∷ q)) - ≈⟨ +-congˡ (cons (SR.sym (SR.*-assoc a b c)) ·-assoc) ⟩ - (a *A b *A c ∷ ((a *A b) · q)) + a · (p * (0# ∷ c ∷ q)) - ≈⟨ +-congʳ (·-distrib-* p (0# ∷ c ∷ q) a) ⟩ - (a *A b) · (c ∷ q) + (a · p) * (0# ∷ c ∷ q) - ≈⟨ refl ⟩ - (a · (b ∷ p)) * (c ∷ q) ∎ - -0∷[p*q]≈[0∷p]*q : (p : Poly) → (q : Poly) → shift (p * q) ≈ (shift p) * q -0∷[p*q]≈[0∷p]*q [] q = begin - shift ([] * q) - ≈⟨ consʳ (refl) ⟩ - shift [] - ≈⟨ p≈[]⇒0∷p≈p refl ⟨ - [] - ≈⟨ p≈[]⇒p*q≈[] q (sym (p≈[]⇒0∷p≈p refl)) ⟨ - (0# ∷ []) * q - ∎ -0∷[p*q]≈[0∷p]*q (a ∷ p) q = begin - shift ((a ∷ p) * q) - ≈⟨ *-distrib-shift (a ∷ p) q ⟨ - (a ∷ p) * shift q - ≈⟨ refl ⟩ - a · shift q + p * (0# ∷ shift q) - ≈⟨ +-idˡ (0# · q) (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) - (a≈0⇒a·pIsZero 0# q SR.refl) ⟨ - 0# · q + (a · (0# ∷ q) + p * (0# ∷ 0# ∷ q)) - ≈⟨ refl ⟩ - shift (a ∷ p) * q - ∎ - -*-distribˡ-+ : (p : Poly) → (q : Poly) → (r : Poly) → - p * (q + r) ≈ p * q + p * r -*-distribˡ-+ [] q r = begin - [] * (q + r) ≈⟨ zeroˡ (q + r) ⟩ - [] ≈⟨ refl ⟩ - [] * q + [] * r ∎ -*-distribˡ-+ (a ∷ p) q r = begin - (a ∷ p) * (q + r) - ≈⟨ refl ⟩ - a · (q + r) + p * (0# ∷ q + r) - ≈⟨ +-cong ·-dist (*-distrib-shift p (q + r)) ⟩ - (a · q + a · r) + (0# ∷ (p * (q + r))) - ≈⟨ +-congʳ (consʳ (*-distribˡ-+ p q r)) ⟩ - (a · q + a · r) + (0# ∷ (p * q + p * r)) - ≈⟨ +-congʳ (consˡ (SR.+-identityʳ 0#)) ⟨ - (a · q + a · r) + ((0# ∷ (p * q)) + (0# ∷ (p * r))) - ≈⟨ middleFour (a · q) (a · r) (0# ∷ p * q) (0# ∷ p * r) ⟩ - ((a · q) + (0# ∷ (p * q))) + ((a · r) + (0# ∷ (p * r))) - ≈⟨ +-cong (+-congʳ (*-distrib-shift p q)) (+-congʳ (*-distrib-shift p r)) ⟨ - (a · q + p * (0# ∷ q)) + (a · r + p * (0# ∷ r)) - ≈⟨ refl ⟨ - (a ∷ p) * q + (a ∷ p) * r - ∎ - -*-distribʳ-+ : (p : Poly) → (q : Poly) → (r : Poly) → - (q + r) * p ≈ (q * p) + (r * p) -*-distribʳ-+ p [] [] = sym (+-identityʳ ([])) -*-distribʳ-+ p [] (c ∷ r) = begin - ([] + (c ∷ r)) * p ≈⟨ refl ⟩ - (c ∷ r) * p ≈⟨ +-identityˡ ((c ∷ r) * p) ⟨ - [] * p + (c ∷ r) * p ∎ -*-distribʳ-+ p (b ∷ q) [] = begin - ((b ∷ q) + []) * p ≈⟨ refl ⟩ - (b ∷ q) * p ≈⟨ +-identityʳ ((b ∷ q) * p) ⟨ - (b ∷ q) * p + [] * p ∎ -*-distribʳ-+ p (b ∷ q) (c ∷ r) = begin - ((b ∷ q) + (c ∷ r)) * p - ≈⟨ refl ⟩ - (b +A c) · p + (q + r) * (0# ∷ p) - ≈⟨ +-cong (·-distrib-+A b c p) (*-distribʳ-+ (0# ∷ p) q r) ⟩ - ((b · p) + (c · p)) + (q * (0# ∷ p) + r * (0# ∷ p)) - ≈⟨ middleFour (b · p) (c · p) (q * (0# ∷ p)) (r * (0# ∷ p)) ⟩ - (b · p + q * (0# ∷ p)) + (c · p + r * (0# ∷ p)) - ≈⟨ refl ⟨ - (b ∷ q) * p + (c ∷ r) * p - ∎ - -*-assoc : (p : Poly) → (q : Poly) → (r : Poly) → - (p * q) * r ≈ p * (q * r) -*-assoc [] q r = refl -*-assoc (a ∷ p) q r = begin - ((a ∷ p) * q) * r - ≈⟨ refl ⟩ - ((a · q) + (p * (0# ∷ q))) * r - ≈⟨ *-congˡ (+-congʳ {p = a · q} (*-distrib-shift p q)) ⟩ - ((a · q) + (0# ∷ (p * q))) * r - ≈⟨ *-distribʳ-+ r (a · q) (0# ∷ p * q) ⟩ - ((a · q) * r) + ((0# ∷ (p * q)) * r) - ≈⟨ +-congʳ step1 ⟨ - ((a · q) * r) + (0# ∷ (p * (q * r))) - ≈⟨ +-congˡ (·-distrib-* q r a) ⟨ - (a · (q * r)) + (0# ∷ (p * (q * r))) - ≈⟨ +-congʳ (*-distrib-shift p (q * r)) ⟨ - (a · (q * r)) + (p * (0# ∷ (q * r))) - ≈⟨ refl ⟩ - (a ∷ p) * (q * r) - ∎ - where - step1 = begin - 0# ∷ (p * (q * r)) - ≈⟨ consʳ (*-assoc p q r) ⟨ - 0# ∷ ((p * q) * r) - ≈⟨ 0∷[p*q]≈[0∷p]*q (p * q) r ⟩ - (0# ∷ (p * q)) * r - ≈⟨ refl ⟩ - (0# · r) + ((p * q) * (0# ∷ r)) - ≈⟨ +-congˡ (IsZero⇒p≈[] (a≈0⇒a·pIsZero 0# r SR.refl) ) ⟩ - [] + ((p * q) * (0# ∷ r)) - ≈⟨ +-congʳ (*-distrib-shift (p * q) r) ⟩ - [] + (0# ∷ ((p * q) * r)) - ≈⟨ +-congʳ (0∷[p*q]≈[0∷p]*q (p * q) r) ⟩ - [] + ((0# ∷ (p * q)) * r) - ≈⟨ +-identityˡ ((0# ∷ (p * q)) * r) ⟩ - (0# ∷ (p * q)) * r - ∎ - --------------------------------------------------------------- --- Algebraic properties of addition -+-identity : Identity [] _+_ -+-identity = +-identityˡ , +-identityʳ - ---------------------------------------------------------------- --- Additive structures - -isEquivalence : IsEquivalence _≈_ -isEquivalence = record - { refl = refl - ; sym = sym - ; trans = trans - } - -+-isMagma : IsMagma _≈_ _+_ -+-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = +-cong - } - -+-isSemigroup : IsSemigroup _≈_ _+_ -+-isSemigroup = record - { isMagma = +-isMagma - ; assoc = +-assoc - } - -+-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ -+-isCommutativeSemigroup = record - { isSemigroup = +-isSemigroup - ; comm = +-comm - } - -+-isMonoid : IsMonoid _≈_ _+_ [] -+-isMonoid = record - { isSemigroup = +-isSemigroup - ; identity = +-identity - } - -+-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ [] -+-isCommutativeMonoid = record - { isMonoid = +-isMonoid - ; comm = +-comm - } - ---------------------------------------------------------------- --- Additive raw bundles -+-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ -+-rawMagma = record - { Carrier = Poly - ; _≈_ = _≈_ - ; _∙_ = _+_ - } - -+-rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ -+-rawSemiring = record - { Carrier = Poly - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; 0# = [] - ; 1# = 1# ∷ [] - } - --- Additive bundles - -+-magma : Algebra.Bundles.Magma _ _ -+-magma = record - { isMagma = +-isMagma - } - -+-semigroup : Algebra.Bundles.Semigroup _ _ -+-semigroup = record - { isSemigroup = +-isSemigroup - } - -+-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ -+-commutativeSemigroup = record - { isCommutativeSemigroup = +-isCommutativeSemigroup - } - -+-monoid : Algebra.Bundles.Monoid _ _ -+-monoid = record - { isMonoid = +-isMonoid - } - -+-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ -+-commutativeMonoid = record - { isCommutativeMonoid = +-isCommutativeMonoid - } - -*-identity : Identity (1# ∷ []) _*_ -*-identity = *-identityˡ , *-identityʳ - -*-zeroˡ : LeftZero [] _*_ -*-zeroˡ p = zeroˡ p - -*-zeroʳ : RightZero [] _*_ -*-zeroʳ p = zeroʳ p - -*-zero : Zero [] _*_ -*-zero = *-zeroˡ , *-zeroʳ - -*-distrib-+ : _*_ DistributesOver _+_ -*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ - ------------------------------------------------------------------- --- Multiplicative structure - -*-isMagma : IsMagma _≈_ _*_ -*-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = *-cong - } - -*-isSemigroup : IsSemigroup _≈_ _*_ -*-isSemigroup = record - { isMagma = *-isMagma - ; assoc = *-assoc - } - -*-isMonoid : IsMonoid _≈_ _*_ (1# ∷ []) -*-isMonoid = record - { isSemigroup = *-isSemigroup - ; identity = *-identity - } - -+-*-isSemiring : IsSemiring _≈_ _+_ _*_ [] (1# ∷ []) -+-*-isSemiring = record - { isSemiringWithoutAnnihilatingZero = record - { +-isCommutativeMonoid = +-isCommutativeMonoid - ; *-cong = *-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - ; zero = *-zero - } - ---------------------------------------------------------------- --- Multiplicative bundles - -*-magma : Algebra.Bundles.Magma _ _ -*-magma = record - { isMagma = *-isMagma - } - -*-semigroup : Algebra.Bundles.Semigroup _ _ -*-semigroup = record - { isSemigroup = *-isSemigroup - } - -*-monoid : Algebra.Bundles.Monoid _ _ -*-monoid = record - { isMonoid = *-isMonoid - } - -+-*-semiring : Semiring _ _ -+-*-semiring = record - { isSemiring = +-*-isSemiring - } - ------------------------------------------------------- --- Degree function and polynomial normalization - -module _ (_≟0 : ∀ a → Dec (a ≈A 0#)) where - --- true degree function of a polynomial - deg : Poly → Maybe ℕ - deg [] = nothing - deg (a ∷ p) with deg p - ... | just n = just (suc n) - ... | nothing with a ≟0 - ... | yes _ = nothing - ... | no _ = just 0 - --- normalization operation for a polynomial - norm : Poly → Poly - norm [] = [] - norm (a ∷ p) with norm p - ... | b ∷ q = a ∷ b ∷ q - ... | [] with a ≟0 - ... | yes _ = [] - ... | no _ = a ∷ [] - - just≢nothing : ∀ {n : ℕ} → just n ≢ nothing - just≢nothing () - - IsZero⇒deg≡nothing : ∀ {p} → IsZero p → deg p ≡ nothing - IsZero⇒deg≡nothing [] = Eq.refl - IsZero⇒deg≡nothing {a ∷ p} (a≈0 ∷ p≈0) - rewrite IsZero⇒deg≡nothing p≈0 with a ≟0 - ... | yes _ = Eq.refl - ... | no ¬a≈0 = ⊥-elim (¬a≈0 a≈0) - - deg≡nothing⇒IsZero : ∀ {p} → deg p ≡ nothing → IsZero p - deg≡nothing⇒IsZero {[]} eq = [] - deg≡nothing⇒IsZero {a ∷ p} eq with deg p in taildeg - ... | just n = ⊥-elim (just≢nothing eq) - ... | nothing with a ≟0 - ... | yes a≈0 = a≈0 ∷ deg≡nothing⇒IsZero {p} taildeg - ... | no _ = ⊥-elim (just≢nothing eq) - - deg-cong : ∀ {p q} → p ≈ q → deg p ≡ deg q - deg-cong ([]≈ q []≈q) = Eq.sym (IsZero⇒deg≡nothing []≈q) - deg-cong (≈[] p p≈[]) = IsZero⇒deg≡nothing p≈[] - deg-cong {a ∷ p} {b ∷ q} (cons a≈b p≈q) - rewrite deg-cong p≈q with deg q - ... | just n = Eq.refl - ... | nothing with a ≟0 | b ≟0 - ... | yes _ | yes _ = Eq.refl - ... | no _ | no _ = Eq.refl - ... | yes a≈0 | no ¬b≈0 = ⊥-elim (¬b≈0 (SR.trans (SR.sym a≈b) a≈0)) - ... | no ¬a≈0 | yes b≈0 = ⊥-elim (¬a≈0 (SR.trans a≈b b≈0)) - From 225c70fd5e0869675969af5f214aa644b200fab0 Mon Sep 17 00:00:00 2001 From: Sam Park Date: Fri, 28 Aug 2026 23:12:06 +0900 Subject: [PATCH 6/8] Remove obsolete polynomial modules --- .../Polynomial/Base/CommutativeRing.agda | 89 ----- src/Algebra/Polynomial/Base/Ring.agda | 89 ----- src/Algebra/Polynomial/Base/Semiring.agda | 85 ----- .../Properties/CommutativeRing.agda | 350 ------------------ src/Algebra/Polynomial/Properties/Ring.agda | 292 --------------- .../Polynomial/Properties/Semiring.agda | 234 ------------ 6 files changed, 1139 deletions(-) delete mode 100644 src/Algebra/Polynomial/Base/CommutativeRing.agda delete mode 100644 src/Algebra/Polynomial/Base/Ring.agda delete mode 100644 src/Algebra/Polynomial/Base/Semiring.agda delete mode 100644 src/Algebra/Polynomial/Properties/CommutativeRing.agda delete mode 100644 src/Algebra/Polynomial/Properties/Ring.agda delete mode 100644 src/Algebra/Polynomial/Properties/Semiring.agda diff --git a/src/Algebra/Polynomial/Base/CommutativeRing.agda b/src/Algebra/Polynomial/Base/CommutativeRing.agda deleted file mode 100644 index 3bf52b5e8a..0000000000 --- a/src/Algebra/Polynomial/Base/CommutativeRing.agda +++ /dev/null @@ -1,89 +0,0 @@ -open import Algebra.Bundles using (CommutativeRing) -open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) -open import Data.Product.Base using (_,_) -open import Data.Vec.Base as Vec using ([]; _∷_) -import Level as L - -module Algebra.Polynomial.Base.CommutativeRing - {ℓ₁ ℓ₂} (CR : CommutativeRing ℓ₁ ℓ₂) - where - -open import Algebra.Polynomial.Poly.Base.CommutativeRing CR as Poly - using (Poly; zeros) - -open CommutativeRing CR - using (0#; 1#) - renaming (Carrier to A) - -private - variable - m n k : ℕ - p : Poly m - q : Poly n - r : Poly k - ---------------------------------------------------- --- Types - --- The degree of the polynomial denotes the length of the vector --- The polynomial a₀ + a₁x + ⋯ + aₙxⁿ has degree n+1 -record Polynomial : Set ℓ₁ where - constructor _,_ - field - degree : ℕ - polynomial : Poly degree - -private - variable - P Q R : Polynomial - --- Equivalence relation for representations of polynomials -infix 4 _≈_ -_≈_ : Polynomial → Polynomial → Set (ℓ₁ L.⊔ ℓ₂) -(m , p) ≈ (n , q) = p Poly.≈ q - -refl : P ≈ P -refl = Poly.refl - -sym : P ≈ Q → Q ≈ P -sym = Poly.sym - -trans : P ≈ Q → Q ≈ R → P ≈ R -trans = Poly.trans - --------------------------------------------------- --- Constants - -zero : Polynomial -zero = (0 , []) - -one : Polynomial -one = (1 , (1# ∷ [])) - ---------------------------------------------------- --- Operations - --- Multiply the polynomial by a factor of x -shift : Polynomial → Polynomial -shift (m , p) = (suc m , Poly.shift p) - --- Multiply the polynomial by xⁿ -shift-by-n : (n : ℕ) → Polynomial → Polynomial -shift-by-n 0 (m , p) = (m , p) -shift-by-n (suc n) (m , p) = shift (shift-by-n n (m , p)) - --- Negation --_ : Polynomial → Polynomial -- (m , p) = (m , Poly.- p) - --- Scaling -_·_ : A → Polynomial → Polynomial -a · (m , p) = (m , a Poly.· p) - --- Addition -_+_ : Polynomial → Polynomial → Polynomial -(m , p) + (n , q) = (m ⊔ n , p Poly.+ q) - --- Multiplication -_*_ : Polynomial → Polynomial → Polynomial -(m , p) * (n , q) = (pred (m ℕ.+ n) , p Poly.* q) diff --git a/src/Algebra/Polynomial/Base/Ring.agda b/src/Algebra/Polynomial/Base/Ring.agda deleted file mode 100644 index dd50f9349e..0000000000 --- a/src/Algebra/Polynomial/Base/Ring.agda +++ /dev/null @@ -1,89 +0,0 @@ -open import Algebra.Bundles using (Ring) -open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) -open import Data.Product.Base using (_,_) -open import Data.Vec.Base as Vec using ([]; _∷_) -import Level as L - -module Algebra.Polynomial.Base.Ring - {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) - where - -open import Algebra.Polynomial.Poly.Base.Ring R as Poly - using (Poly; zeros) - -open Ring R - using (0#; 1#) - renaming (Carrier to A) - -private - variable - m n k : ℕ - p : Poly m - q : Poly n - r : Poly k - ---------------------------------------------------- --- Types - --- The degree of the polynomial denotes the length of the vector --- The polynomial a₀ + a₁x + ⋯ + aₙxⁿ has degree n+1 -record Polynomial : Set ℓ₁ where - constructor _,_ - field - degree : ℕ - polynomial : Poly degree - -private - variable - P Q W : Polynomial - --- Equivalence relation for representations of polynomials -infix 4 _≈_ -_≈_ : Polynomial → Polynomial → Set (ℓ₁ L.⊔ ℓ₂) -(m , p) ≈ (n , q) = p Poly.≈ q - -refl : P ≈ P -refl = Poly.refl - -sym : P ≈ Q → Q ≈ P -sym = Poly.sym - -trans : P ≈ Q → Q ≈ W → P ≈ W -trans = Poly.trans - --------------------------------------------------- --- Constants - -zero : Polynomial -zero = (0 , []) - -one : Polynomial -one = (1 , (1# ∷ [])) - ---------------------------------------------------- --- Operations - --- Multiply the polynomial by x -shift : Polynomial → Polynomial -shift (m , p) = (suc m , Poly.shift p) - --- Multiply the polynomial by xⁿ -shift-by-n : (n : ℕ) → Polynomial → Polynomial -shift-by-n 0 (m , p) = (m , p) -shift-by-n (suc n) (m , p) = shift (shift-by-n n (m , p)) - --- Negation --_ : Polynomial → Polynomial -- (m , p) = (m , Poly.- p) - --- Scaling -_·_ : A → Polynomial → Polynomial -a · (m , p) = (m , a Poly.· p) - --- Addition -_+_ : Polynomial → Polynomial → Polynomial -(m , p) + (n , q) = (m ⊔ n , p Poly.+ q) - --- Multiplication -_*_ : Polynomial → Polynomial → Polynomial -(m , p) * (n , q) = (pred (m ℕ.+ n) , p Poly.* q) diff --git a/src/Algebra/Polynomial/Base/Semiring.agda b/src/Algebra/Polynomial/Base/Semiring.agda deleted file mode 100644 index de7317f9a5..0000000000 --- a/src/Algebra/Polynomial/Base/Semiring.agda +++ /dev/null @@ -1,85 +0,0 @@ -open import Algebra.Bundles using (Semiring) -open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) -open import Data.Product.Base using (_,_) -open import Data.Vec.Base as Vec using ([]; _∷_) -import Level as L - -module Algebra.Polynomial.Base.Semiring - {ℓ₁ ℓ₂} (SR : Semiring ℓ₁ ℓ₂) - where - -open import Algebra.Polynomial.Poly.Base.Semiring SR as Poly - using (Poly; zeros) - -open Semiring SR - using (0#; 1#) - renaming (Carrier to A) - -private - variable - m n k : ℕ - p : Poly m - q : Poly n - r : Poly k - ---------------------------------------------------- --- Types - --- The degree of the polynomial denotes the length of the vector --- The polynomial a₀ + a₁x + ⋯ + aₙxⁿ has degree n+1 -record Polynomial : Set ℓ₁ where - constructor _,_ - field - degree : ℕ - polynomial : Poly degree - -private - variable - P Q R : Polynomial - --- Equivalence relation for representations of polynomials -infix 4 _≈_ -_≈_ : Polynomial → Polynomial → Set (ℓ₁ L.⊔ ℓ₂) -(m , p) ≈ (n , q) = p Poly.≈ q - -refl : P ≈ P -refl = Poly.refl - -sym : P ≈ Q → Q ≈ P -sym = Poly.sym - -trans : P ≈ Q → Q ≈ R → P ≈ R -trans = Poly.trans - --------------------------------------------------- --- Constants - -zero : Polynomial -zero = (0 , []) - -one : Polynomial -one = (1 , (1# ∷ [])) - ---------------------------------------------------- --- Operations - --- Multiply the polynomial by x -shift : Polynomial → Polynomial -shift (m , p) = (suc m , Poly.shift p) - --- Multiply the polynomial by xⁿ -shift-by-n : (n : ℕ) → Polynomial → Polynomial -shift-by-n 0 (m , p) = (m , p) -shift-by-n (suc n) (m , p) = shift (shift-by-n n (m , p)) - --- Scaling -_·_ : A → Polynomial → Polynomial -a · (m , p) = (m , a Poly.· p) - --- Addition -_+_ : Polynomial → Polynomial → Polynomial -(m , p) + (n , q) = (m ⊔ n , p Poly.+ q) - --- Multiplication -_*_ : Polynomial → Polynomial → Polynomial -(m , p) * (n , q) = (pred (m ℕ.+ n) , p Poly.* q) diff --git a/src/Algebra/Polynomial/Properties/CommutativeRing.agda b/src/Algebra/Polynomial/Properties/CommutativeRing.agda deleted file mode 100644 index c28b138843..0000000000 --- a/src/Algebra/Polynomial/Properties/CommutativeRing.agda +++ /dev/null @@ -1,350 +0,0 @@ -open import Algebra.Bundles using (Magma; CommutativeRing) -open import Algebra.Bundles.Raw - -module Algebra.Polynomial.Properties.CommutativeRing - {ℓ₁ ℓ₂} - (CR : CommutativeRing ℓ₁ ℓ₂) - where - -import Algebra.Consequences.Setoid as C - using (comm∧distrʳ⇒distrˡ ; comm∧idʳ⇒idˡ) -import Algebra.Definitions as Def -import Algebra.Polynomial.Poly.Properties.CommutativeRing CR as Poly -open import Algebra.Polynomial.Base.CommutativeRing CR - using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ - ; zero; one; -_; refl; sym; trans) -open import Algebra.Properties.AbelianGroup -open import Algebra.Properties.Ring -open import Algebra.Structures - using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid - ; IsGroup; IsAbelianGroup; IsCommutativeMonoid; IsSemiring - ; IsRing; IsCommutativeSemiring; IsCommutativeRing ) -open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) -open import Data.Product.Base using (_,_) -open import Data.Vec.Base as Vec using ([]; _∷_) -open import Relation.Binary using (IsEquivalence) - -open Polynomial - -open CommutativeRing CR - using (0#; 1#) - renaming (Carrier to A) - -open Def _≈_ - -private - variable - P Q R : Polynomial - --------------------------------------------------------------- --- Algebraic properties of addition - -+-identityˡ : LeftIdentity zero _+_ -+-identityˡ P = Poly.+-identityˡ (polynomial P) - -+-identityʳ : RightIdentity zero _+_ -+-identityʳ P = Poly.+-identityʳ (polynomial P) - -+-identity : Identity zero _+_ -+-identity = +-identityˡ , +-identityʳ - -+-comm : Commutative _+_ -+-comm P Q = Poly.+-comm (polynomial P) (polynomial Q) - -+-assoc : Associative _+_ -+-assoc P Q R - = Poly.+-assoc (polynomial P) (polynomial Q) (polynomial R) - -+-inverseˡ : LeftInverse zero -_ _+_ -+-inverseˡ P = Poly.+-inverseˡ (polynomial P) - -+-inverseʳ : RightInverse zero -_ _+_ -+-inverseʳ P = Poly.+-inverseʳ (polynomial P) - -+-inverse : Inverse zero -_ _+_ -+-inverse = +-inverseˡ , +-inverseʳ - --‿cong : P ≈ Q → - P ≈ - Q --‿cong = Poly.-‿cong - ---------------------------------------------------------------- --- Additive structures - -isEquivalence : IsEquivalence _≈_ -isEquivalence = record - { refl = refl - ; sym = sym - ; trans = trans - } - -+-isMagma : IsMagma _≈_ _+_ -+-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = Poly.+-cong - } - -+-isSemigroup : IsSemigroup _≈_ _+_ -+-isSemigroup = record - { isMagma = +-isMagma - ; assoc = +-assoc - } - -+-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ -+-isCommutativeSemigroup = record - { isSemigroup = +-isSemigroup - ; comm = +-comm - } - -+-isMonoid : IsMonoid _≈_ _+_ zero -+-isMonoid = record - { isSemigroup = +-isSemigroup - ; identity = +-identity - } - -+-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ zero -+-isCommutativeMonoid = record - { isMonoid = +-isMonoid - ; comm = +-comm - } - -+-isGroup : IsGroup _≈_ _+_ zero -_ -+-isGroup = record - { isMonoid = +-isMonoid - ; inverse = +-inverse - ; ⁻¹-cong = -‿cong - } - -+-isAbelianGroup : IsAbelianGroup _≈_ _+_ zero -_ -+-isAbelianGroup = record - { isGroup = +-isGroup - ; comm = +-comm - } - ---------------------------------------------------------------- --- Additive bundles --- Additive bundles - -+-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ -+-rawMagma = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _∙_ = _+_ - } - -*-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ -*-rawMagma = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _∙_ = _*_ - } - -rawNearSemiring : Algebra.Bundles.Raw.RawNearSemiring _ _ -rawNearSemiring = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; 0# = zero - } - -rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ -rawSemiring = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; 0# = zero - ; 1# = one - } - -rawRing : Algebra.Bundles.Raw.RawRing _ _ -rawRing = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; -_ = -_ - ; 0# = zero - ; 1# = one - } - -+-magma : Algebra.Bundles.Magma _ _ -+-magma = record - { isMagma = +-isMagma - } - -+-semigroup : Algebra.Bundles.Semigroup _ _ -+-semigroup = record - { isSemigroup = +-isSemigroup - } - -+-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ -+-commutativeSemigroup = record - { isCommutativeSemigroup = +-isCommutativeSemigroup - } - -+-monoid : Algebra.Bundles.Monoid _ _ -+-monoid = record - { isMonoid = +-isMonoid - } - -+-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ -+-commutativeMonoid = record - { isCommutativeMonoid = +-isCommutativeMonoid - } - -+-abelianGroup : Algebra.Bundles.AbelianGroup _ _ -+-abelianGroup = record - { isAbelianGroup = +-isAbelianGroup - } - ------------------------------------------------------------------ --- Algebraic properties of multiplication - -a·p≈a∷[]*p : (a : A) → (P : Polynomial) → a · P ≈ (1 , (a ∷ [])) * P -a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) - -*-comm : Commutative _*_ -*-comm P Q = Poly.*-comm (polynomial P) (polynomial Q) - -*-identityʳ : RightIdentity one _*_ -*-identityʳ P = Poly.*-identityʳ (polynomial P) - -*-identityˡ : LeftIdentity one _*_ -*-identityˡ = C.comm∧idʳ⇒idˡ (Magma.setoid +-magma) *-comm *-identityʳ - -*-identity : Identity one _*_ -*-identity = *-identityˡ , *-identityʳ - -*-zeroˡ : LeftZero zero _*_ -*-zeroˡ P = Poly.zeroˡ (polynomial P) - -*-zeroʳ : RightZero zero _*_ -*-zeroʳ P = Poly.zeroʳ (polynomial P) - -*-zero : Zero zero _*_ -*-zero = *-zeroˡ , *-zeroʳ - -*-assoc : Associative _*_ -*-assoc P Q R - = Poly.*-assoc (polynomial P) (polynomial Q) (polynomial R) - -*-distribʳ-+ : _*_ DistributesOverʳ _+_ -*-distribʳ-+ P Q R - = Poly.*-distribʳ-+ (polynomial P) (polynomial Q) (polynomial R) - -*-distribˡ-+ : _*_ DistributesOverˡ _+_ -*-distribˡ-+ - = C.comm∧distrʳ⇒distrˡ (Magma.setoid +-magma) Poly.+-cong *-comm *-distribʳ-+ - -*-distrib-+ : _*_ DistributesOver _+_ -*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ - ------------------------------------------------------------------- --- Multiplicative structure - -*-isMagma : IsMagma _≈_ _*_ -*-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = Poly.*-cong - } - -*-isSemigroup : IsSemigroup _≈_ _*_ -*-isSemigroup = record - { isMagma = *-isMagma - ; assoc = *-assoc - } - -*-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _*_ -*-isCommutativeSemigroup = record - { isSemigroup = *-isSemigroup - ; comm = *-comm - } - -*-isMonoid : IsMonoid _≈_ _*_ one -*-isMonoid = record - { isSemigroup = *-isSemigroup - ; identity = *-identity - } - -*-isCommutativeMonoid : IsCommutativeMonoid _≈_ _*_ one -*-isCommutativeMonoid = record - { isMonoid = *-isMonoid - ; comm = *-comm - } - -+-*-isSemiring : IsSemiring _≈_ _+_ _*_ zero one -+-*-isSemiring = record - { isSemiringWithoutAnnihilatingZero = record - { +-isCommutativeMonoid = +-isCommutativeMonoid - ; *-cong = Poly.*-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - ; zero = *-zero - } - -+-*-isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ zero one -+-*-isCommutativeSemiring = record - { isSemiring = +-*-isSemiring - ; *-comm = *-comm - } - -+-*-isRing : IsRing _≈_ _+_ _*_ -_ zero one -+-*-isRing = record - { +-isAbelianGroup = +-isAbelianGroup - ; *-cong = Poly.*-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - -+-*-isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ zero one -+-*-isCommutativeRing = record - { isRing = +-*-isRing - ; *-comm = *-comm - } - ---------------------------------------------------------------- --- Multiplicative bundles - -*-magma : Algebra.Bundles.Magma _ _ -*-magma = record - { isMagma = *-isMagma - } - -*-semigroup : Algebra.Bundles.Semigroup _ _ -*-semigroup = record - { isSemigroup = *-isSemigroup - } - -*-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ -*-commutativeSemigroup = record - { isCommutativeSemigroup = *-isCommutativeSemigroup - } - -*-monoid : Algebra.Bundles.Monoid _ _ -*-monoid = record - { isMonoid = *-isMonoid - } - -*-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ -*-commutativeMonoid = record - { isCommutativeMonoid = *-isCommutativeMonoid - } - -+-*-commutativeSemiring : Algebra.Bundles.CommutativeSemiring _ _ -+-*-commutativeSemiring = record - { isCommutativeSemiring = +-*-isCommutativeSemiring - } - -+-*-ring : Algebra.Bundles.Ring _ _ -+-*-ring = record - { isRing = +-*-isRing - } - -+-*-commutativeRing : Algebra.Bundles.CommutativeRing _ _ -+-*-commutativeRing = record - { isCommutativeRing = +-*-isCommutativeRing - } diff --git a/src/Algebra/Polynomial/Properties/Ring.agda b/src/Algebra/Polynomial/Properties/Ring.agda deleted file mode 100644 index 4670897fba..0000000000 --- a/src/Algebra/Polynomial/Properties/Ring.agda +++ /dev/null @@ -1,292 +0,0 @@ -open import Algebra.Bundles using (Magma; Ring) - -module Algebra.Polynomial.Properties.Ring - {ℓ₁ ℓ₂} - (R : Ring ℓ₁ ℓ₂) - where - -open import Algebra.Bundles.Raw -import Algebra.Definitions as Def -import Algebra.Polynomial.Poly.Properties.Ring R as Poly -open import Algebra.Polynomial.Base.Ring R - using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ - ; zero; one; -_; refl; sym; trans) -open import Algebra.Properties.AbelianGroup -open import Algebra.Properties.Ring -open import Algebra.Structures - using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid - ; IsGroup; IsAbelianGroup; IsSemiring; IsCommutativeMonoid - ; IsRing) -open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) -open import Data.Product.Base using (_,_) -open import Data.Vec.Base as Vec using ([]; _∷_) -open import Relation.Binary using (IsEquivalence) - -open Polynomial - -open Ring R - using (0#; 1#) - renaming (Carrier to A) - -open Def _≈_ - -private - variable - P Q W : Polynomial - --------------------------------------------------------------- --- Algebraic properties of addition - -+-identityˡ : LeftIdentity zero _+_ -+-identityˡ P = Poly.+-identityˡ (polynomial P) - -+-identityʳ : RightIdentity zero _+_ -+-identityʳ P = Poly.+-identityʳ (polynomial P) - -+-identity : Identity zero _+_ -+-identity = +-identityˡ , +-identityʳ - -+-comm : Commutative _+_ -+-comm P Q = Poly.+-comm (polynomial P) (polynomial Q) - -+-assoc : Associative _+_ -+-assoc P Q W - = Poly.+-assoc (polynomial P) (polynomial Q) (polynomial W) - -+-inverseˡ : LeftInverse zero -_ _+_ -+-inverseˡ P = Poly.+-inverseˡ (polynomial P) - -+-inverseʳ : RightInverse zero -_ _+_ -+-inverseʳ P = Poly.+-inverseʳ (polynomial P) - -+-inverse : Inverse zero -_ _+_ -+-inverse = +-inverseˡ , +-inverseʳ - --‿cong : P ≈ Q → - P ≈ - Q --‿cong = Poly.-‿cong - ---------------------------------------------------------------- --- Additive structures - -isEquivalence : IsEquivalence _≈_ -isEquivalence = record - { refl = refl - ; sym = sym - ; trans = trans - } - -+-isMagma : IsMagma _≈_ _+_ -+-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = Poly.+-cong - } - -+-isSemigroup : IsSemigroup _≈_ _+_ -+-isSemigroup = record - { isMagma = +-isMagma - ; assoc = +-assoc - } - -+-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ -+-isCommutativeSemigroup = record - { isSemigroup = +-isSemigroup - ; comm = +-comm - } - -+-isMonoid : IsMonoid _≈_ _+_ zero -+-isMonoid = record - { isSemigroup = +-isSemigroup - ; identity = +-identity - } - -+-isGroup : IsGroup _≈_ _+_ zero -_ -+-isGroup = record - { isMonoid = +-isMonoid - ; inverse = +-inverse - ; ⁻¹-cong = -‿cong - } - -+-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ zero -+-isCommutativeMonoid = record - { isMonoid = +-isMonoid - ; comm = +-comm - } - -+-isAbelianGroup : IsAbelianGroup _≈_ _+_ zero -_ -+-isAbelianGroup = record - { isGroup = +-isGroup - ; comm = +-comm - } - ---------------------------------------------------------------- --- Additive bundles - -+-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ -+-rawMagma = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _∙_ = _+_ - } - -*-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ -*-rawMagma = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _∙_ = _*_ - } - -rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ -rawSemiring = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; 0# = zero - ; 1# = one - } - -rawRing : Algebra.Bundles.Raw.RawRing _ _ -rawRing = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; -_ = -_ - ; 0# = zero - ; 1# = one - } - -+-magma : Algebra.Bundles.Magma _ _ -+-magma = record - { isMagma = +-isMagma - } - -+-semigroup : Algebra.Bundles.Semigroup _ _ -+-semigroup = record - { isSemigroup = +-isSemigroup - } - -+-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ -+-commutativeSemigroup = record - { isCommutativeSemigroup = +-isCommutativeSemigroup - } - -+-monoid : Algebra.Bundles.Monoid _ _ -+-monoid = record - { isMonoid = +-isMonoid - } - -+-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ -+-commutativeMonoid = record - { isCommutativeMonoid = +-isCommutativeMonoid - } - -+-abelianGroup : Algebra.Bundles.AbelianGroup _ _ -+-abelianGroup = record - { isAbelianGroup = +-isAbelianGroup - } - ------------------------------------------------------------------ --- Algebraic properties of multiplication - -a·p≈a∷[]*p : (a : A) → (P : Polynomial) → a · P ≈ (1 , (a ∷ [])) * P -a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) - -*-identityʳ : RightIdentity one _*_ -*-identityʳ P = Poly.*-identityʳ (polynomial P) - -*-identityˡ : LeftIdentity one _*_ -*-identityˡ P = Poly.*-identityˡ (polynomial P) - -*-identity : Identity one _*_ -*-identity = *-identityˡ , *-identityʳ - -*-zeroˡ : LeftZero zero _*_ -*-zeroˡ P = Poly.zeroˡ (polynomial P) - -*-zeroʳ : RightZero zero _*_ -*-zeroʳ P = Poly.zeroʳ (polynomial P) - -*-zero : Zero zero _*_ -*-zero = *-zeroˡ , *-zeroʳ - -*-assoc : Associative _*_ -*-assoc P Q R - = Poly.*-assoc (polynomial P) (polynomial Q) (polynomial R) - -*-distribʳ-+ : _*_ DistributesOverʳ _+_ -*-distribʳ-+ P Q R - = Poly.*-distribʳ-+ (polynomial P) (polynomial Q) (polynomial R) - -*-distribˡ-+ : _*_ DistributesOverˡ _+_ -*-distribˡ-+ P Q W - = Poly.*-distribˡ-+ (polynomial P) (polynomial Q) (polynomial W) - -*-distrib-+ : _*_ DistributesOver _+_ -*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ - ------------------------------------------------------------------- --- Multiplicative structure - -*-isMagma : IsMagma _≈_ _*_ -*-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = Poly.*-cong - } - -*-isSemigroup : IsSemigroup _≈_ _*_ -*-isSemigroup = record - { isMagma = *-isMagma - ; assoc = *-assoc - } - -*-isMonoid : IsMonoid _≈_ _*_ one -*-isMonoid = record - { isSemigroup = *-isSemigroup - ; identity = *-identity - } - -+-*-isSemiring : IsSemiring _≈_ _+_ _*_ zero one -+-*-isSemiring = record - { isSemiringWithoutAnnihilatingZero = record - { +-isCommutativeMonoid = +-isCommutativeMonoid - ; *-cong = Poly.*-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - ; zero = *-zero - } - -+-*-isRing : IsRing _≈_ _+_ _*_ -_ zero one -+-*-isRing = record - { +-isAbelianGroup = +-isAbelianGroup - ; *-cong = Poly.*-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - ---------------------------------------------------------------- --- Multiplicative bundles - -*-magma : Algebra.Bundles.Magma _ _ -*-magma = record - { isMagma = *-isMagma - } - -*-semigroup : Algebra.Bundles.Semigroup _ _ -*-semigroup = record - { isSemigroup = *-isSemigroup - } - -*-monoid : Algebra.Bundles.Monoid _ _ -*-monoid = record - { isMonoid = *-isMonoid - } - -+-*-ring : Algebra.Bundles.Ring _ _ -+-*-ring = record - { isRing = +-*-isRing - } - diff --git a/src/Algebra/Polynomial/Properties/Semiring.agda b/src/Algebra/Polynomial/Properties/Semiring.agda deleted file mode 100644 index 2785f88d2c..0000000000 --- a/src/Algebra/Polynomial/Properties/Semiring.agda +++ /dev/null @@ -1,234 +0,0 @@ -open import Algebra.Bundles using (Magma; Semiring) - -module Algebra.Polynomial.Properties.Semiring - {ℓ₁ ℓ₂} - (SR : Semiring ℓ₁ ℓ₂) - where - -open import Algebra.Bundles.Raw -import Algebra.Definitions as Def -import Algebra.Polynomial.Poly.Properties.Semiring SR as Poly -open import Algebra.Polynomial.Base.Semiring SR - using ( Polynomial; _,_; _≈_; shift; _+_; _*_; _·_ - ; zero; one; refl; sym; trans) -open import Algebra.Structures - using ( IsMagma; IsSemigroup; IsCommutativeSemigroup; IsMonoid - ; IsSemiring; IsCommutativeMonoid - ) -open import Data.Nat.Base as ℕ using (ℕ; _⊔_; suc; pred) -open import Data.Product.Base using (_,_) -open import Data.Vec.Base as Vec using ([]; _∷_) -open import Relation.Binary using (IsEquivalence) - -open Polynomial - -open Semiring SR - using (0#; 1#) - renaming (Carrier to A) - -open Def _≈_ - -private - variable - P Q R : Polynomial - --------------------------------------------------------------- --- Algebraic properties of addition - -+-identityˡ : LeftIdentity zero _+_ -+-identityˡ P = Poly.+-identityˡ (polynomial P) - -+-identityʳ : RightIdentity zero _+_ -+-identityʳ P = Poly.+-identityʳ (polynomial P) - -+-identity : Identity zero _+_ -+-identity = +-identityˡ , +-identityʳ - -+-comm : Commutative _+_ -+-comm P Q = Poly.+-comm (polynomial P) (polynomial Q) - -+-assoc : Associative _+_ -+-assoc P Q R - = Poly.+-assoc (polynomial P) (polynomial Q) (polynomial R) - ---------------------------------------------------------------- --- Additive structures - -isEquivalence : IsEquivalence _≈_ -isEquivalence = record - { refl = refl - ; sym = sym - ; trans = trans - } - -+-isMagma : IsMagma _≈_ _+_ -+-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = Poly.+-cong - } - -+-isSemigroup : IsSemigroup _≈_ _+_ -+-isSemigroup = record - { isMagma = +-isMagma - ; assoc = +-assoc - } - -+-isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _+_ -+-isCommutativeSemigroup = record - { isSemigroup = +-isSemigroup - ; comm = +-comm - } - -+-isMonoid : IsMonoid _≈_ _+_ zero -+-isMonoid = record - { isSemigroup = +-isSemigroup - ; identity = +-identity - } - -+-isCommutativeMonoid : IsCommutativeMonoid _≈_ _+_ zero -+-isCommutativeMonoid = record - { isMonoid = +-isMonoid - ; comm = +-comm - } - ---------------------------------------------------------------- --- Additive raw bundles -+-rawMagma : Algebra.Bundles.Raw.RawMagma _ _ -+-rawMagma = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _∙_ = _+_ - } - -+-rawSemiring : Algebra.Bundles.Raw.RawSemiring _ _ -+-rawSemiring = record - { Carrier = Polynomial - ; _≈_ = _≈_ - ; _+_ = _+_ - ; _*_ = _*_ - ; 0# = zero - ; 1# = one - } - - --- Additive bundles - -+-magma : Algebra.Bundles.Magma _ _ -+-magma = record - { isMagma = +-isMagma - } - -+-semigroup : Algebra.Bundles.Semigroup _ _ -+-semigroup = record - { isSemigroup = +-isSemigroup - } - -+-commutativeSemigroup : Algebra.Bundles.CommutativeSemigroup _ _ -+-commutativeSemigroup = record - { isCommutativeSemigroup = +-isCommutativeSemigroup - } - -+-monoid : Algebra.Bundles.Monoid _ _ -+-monoid = record - { isMonoid = +-isMonoid - } - -+-commutativeMonoid : Algebra.Bundles.CommutativeMonoid _ _ -+-commutativeMonoid = record - { isCommutativeMonoid = +-isCommutativeMonoid - } - ------------------------------------------------------------------ --- Algebraic properties of multiplication - -a·p≈a∷[]*p : (a : A) → (P : Polynomial) → a · P ≈ (1 , (a ∷ [])) * P -a·p≈a∷[]*p a P = Poly.a·p≈a∷[]*p a (polynomial P) - -*-identityʳ : RightIdentity one _*_ -*-identityʳ P = Poly.*-identityʳ (polynomial P) - -*-identityˡ : LeftIdentity one _*_ -*-identityˡ P = Poly.*-identityˡ (polynomial P) - -*-identity : Identity one _*_ -*-identity = *-identityˡ , *-identityʳ - -*-zeroˡ : LeftZero zero _*_ -*-zeroˡ P = Poly.zeroˡ (polynomial P) - -*-zeroʳ : RightZero zero _*_ -*-zeroʳ P = Poly.zeroʳ (polynomial P) - -*-zero : Zero zero _*_ -*-zero = *-zeroˡ , *-zeroʳ - -*-assoc : Associative _*_ -*-assoc P Q R - = Poly.*-assoc (polynomial P) (polynomial Q) (polynomial R) - -*-distribʳ-+ : _*_ DistributesOverʳ _+_ -*-distribʳ-+ P Q R - = Poly.*-distribʳ-+ (polynomial P) (polynomial Q) (polynomial R) - -*-distribˡ-+ : _*_ DistributesOverˡ _+_ -*-distribˡ-+ P Q R - = Poly.*-distribˡ-+ (polynomial P) (polynomial Q) (polynomial R) - -*-distrib-+ : _*_ DistributesOver _+_ -*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ - ------------------------------------------------------------------- --- Multiplicative structure - -*-isMagma : IsMagma _≈_ _*_ -*-isMagma = record - { isEquivalence = isEquivalence - ; ∙-cong = Poly.*-cong - } - -*-isSemigroup : IsSemigroup _≈_ _*_ -*-isSemigroup = record - { isMagma = *-isMagma - ; assoc = *-assoc - } - -*-isMonoid : IsMonoid _≈_ _*_ one -*-isMonoid = record - { isSemigroup = *-isSemigroup - ; identity = *-identity - } - -+-*-isSemiring : IsSemiring _≈_ _+_ _*_ zero one -+-*-isSemiring = record - { isSemiringWithoutAnnihilatingZero = record - { +-isCommutativeMonoid = +-isCommutativeMonoid - ; *-cong = Poly.*-cong - ; *-assoc = *-assoc - ; *-identity = *-identity - ; distrib = *-distrib-+ - } - ; zero = *-zero - } - ---------------------------------------------------------------- --- Multiplicative bundles - -*-magma : Algebra.Bundles.Magma _ _ -*-magma = record - { isMagma = *-isMagma - } - -*-semigroup : Algebra.Bundles.Semigroup _ _ -*-semigroup = record - { isSemigroup = *-isSemigroup - } - -*-monoid : Algebra.Bundles.Monoid _ _ -*-monoid = record - { isMonoid = *-isMonoid - } - -+-*-semiring : Semiring _ _ -+-*-semiring = record - { isSemiring = +-*-isSemiring - } From 10d28d0b9215d8445058a1fccd133c7cf0e6e829 Mon Sep 17 00:00:00 2001 From: Sam Sungho Park Date: Thu, 1 Oct 2026 19:56:24 +0900 Subject: [PATCH 7/8] Update src/Algebra/Polynomial/Morphism/Morphism.agda Co-authored-by: G. Allais --- src/Algebra/Polynomial/Morphism/Morphism.agda | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Algebra/Polynomial/Morphism/Morphism.agda b/src/Algebra/Polynomial/Morphism/Morphism.agda index 67da6c2dbb..0f5304c56e 100644 --- a/src/Algebra/Polynomial/Morphism/Morphism.agda +++ b/src/Algebra/Polynomial/Morphism/Morphism.agda @@ -192,7 +192,7 @@ module PolynomialRingMorphism (⟦ a ⟧ +B β *B 0#) *B (⟦ b ⟧ +B β *B eval β p) ∎ - eval-shift : (β : CR.Carrier B) → (p : Poly) → eval β (A0# ∷ p) ≈B β *B eval β p + eval-shift : (β : CR.Carrier B) → (p : Poly) → eval β (shift p) ≈B β *B eval β p eval-shift β p = begin ⟦ A0# ⟧ +B β *B eval β p ≈⟨ B.+-congʳ (MonHomo.ε-homo (+-monoidHom f)) ⟩ From 89785face3d73480466c041b863b3614b9f5636d Mon Sep 17 00:00:00 2001 From: Sam Park Date: Thu, 1 Oct 2026 11:59:35 +0100 Subject: [PATCH 8/8] First edit --- src/Algebra/Polynomial/Morphism/Morphism.agda | 2 -- src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda | 2 +- src/Algebra/Polynomial/Poly/Base/Ring.agda | 2 +- src/Algebra/Polynomial/Poly/Properties/Ring.agda | 2 +- 4 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Algebra/Polynomial/Morphism/Morphism.agda b/src/Algebra/Polynomial/Morphism/Morphism.agda index 0f5304c56e..5be3bedf0f 100644 --- a/src/Algebra/Polynomial/Morphism/Morphism.agda +++ b/src/Algebra/Polynomial/Morphism/Morphism.agda @@ -1,5 +1,3 @@ --- Polynomial Morphisms --- open import Algebra.Bundles using (CommutativeRing) open import Algebra.Bundles renaming (CommutativeRing to CR) diff --git a/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda b/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda index 3f6d16b3fa..a67c5f8d9c 100644 --- a/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda +++ b/src/Algebra/Polynomial/Poly/Base/CommutativeRing.agda @@ -4,7 +4,7 @@ module Algebra.Polynomial.Poly.Base.CommutativeRing {ℓ₁ ℓ₂} (R : CommutativeRing ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Properties.Ring (CommutativeRing.ring R) public +open import Algebra.Polynomial.Poly.Base.Ring (CommutativeRing.ring R) public module CR = CommutativeRing R diff --git a/src/Algebra/Polynomial/Poly/Base/Ring.agda b/src/Algebra/Polynomial/Poly/Base/Ring.agda index 9cbc70c9a5..0720faab12 100644 --- a/src/Algebra/Polynomial/Poly/Base/Ring.agda +++ b/src/Algebra/Polynomial/Poly/Base/Ring.agda @@ -4,7 +4,7 @@ module Algebra.Polynomial.Poly.Base.Ring {ℓ₁ ℓ₂} (R : Ring ℓ₁ ℓ₂) where -open import Algebra.Polynomial.Poly.Properties.Semiring (Ring.semiring R) public +open import Algebra.Polynomial.Poly.Base.Semiring (Ring.semiring R) public open import Data.List.Base as List using (List; []; _∷_) module R = Ring R diff --git a/src/Algebra/Polynomial/Poly/Properties/Ring.agda b/src/Algebra/Polynomial/Poly/Properties/Ring.agda index 5199c0512e..75e26e0bbc 100644 --- a/src/Algebra/Polynomial/Poly/Properties/Ring.agda +++ b/src/Algebra/Polynomial/Poly/Properties/Ring.agda @@ -98,7 +98,7 @@ p+[-p]IsZero {p = a ∷ p} = R.-‿inverseʳ a ∷ p+[-p]IsZero --------------------------------------------------------------- -- Additive bundles -rawRing : Algebra.Bundles.Raw.RawRing _ _ +rawRing : RawRing _ _ rawRing = record { Carrier = Poly ; _≈_ = _≈_