Skip to content
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -72,10 +72,18 @@ Additions to existing modules
≟-≢ : (i≢j : i ≢ j) → (i ≟ j) ≡ no i≢j
```

* In `Data.Nat.ListAction.Properties`
```agda
*-distribˡ-sum : ∀ m ns → m * sum ns ≡ sum (map (m *_) ns)
*-distribʳ-sum : ∀ m ns → sum ns * m ≡ sum (map (_* m) ns)
^-distribʳ-product : ∀ m ns → product ns ^ m ≡ product (map (_^ m) ns)
```

* In `Data.Nat.Properties`:
```agda
≟-≢ : (m≢n : m ≢ n) → (m ≟ n) ≡ no m≢n
∸-suc : m ≤ n → suc n ∸ m ≡ suc (n ∸ m)
^-distribʳ-* : ∀ m n o → (n * o) ^ m ≡ n ^ m * o ^ m
```

* In `Data.Vec.Properties`:
Expand Down
22 changes: 18 additions & 4 deletions src/Data/Nat/ListAction/Properties.agda
Original file line number Diff line number Diff line change
Expand Up @@ -12,23 +12,25 @@
module Data.Nat.ListAction.Properties where

open import Algebra.Bundles using (CommutativeMonoid)
open import Data.List.Base using (List; []; _∷_; _++_)
open import Data.List.Base using (List; []; _∷_; _++_; map)
open import Data.List.Membership.Propositional using (_∈_)
open import Data.List.Relation.Binary.Permutation.Propositional
using (_↭_; ↭⇒↭ₛ)
open import Data.List.Relation.Binary.Permutation.Setoid.Properties
using (foldr-commMonoid)
open import Data.List.Relation.Unary.All using (All; []; _∷_)
open import Data.List.Relation.Unary.Any using (here; there)
open import Data.Nat.Base using (ℕ; _+_; _*_; NonZero; _≤_)
open import Data.Nat.Base using (ℕ; _+_; _*_; _^_; NonZero; _≤_)
open import Data.Nat.Divisibility using (_∣_; m∣m*n; ∣n⇒∣m*n)
open import Data.Nat.ListAction using (sum; product)
open import Data.Nat.Properties
using (+-assoc; *-assoc; *-identityˡ; m*n≢0; m≤m*n; m≤n⇒m≤o*n
; +-0-commutativeMonoid; *-1-commutativeMonoid)
; +-0-commutativeMonoid; *-1-commutativeMonoid
; *-zeroˡ; *-zeroʳ; *-distribˡ-+; *-distribʳ-+
; ^-zeroˡ; ^-distribʳ-*)
open import Relation.Binary.Core using (_Preserves_⟶_)
open import Relation.Binary.PropositionalEquality.Core
using (_≡_; refl; sym; cong)
using (_≡_; refl; sym; trans; cong)
open import Relation.Binary.PropositionalEquality.Properties
using (module ≡-Reasoning)

Expand All @@ -51,6 +53,14 @@ sum-++ (m ∷ ms) ns = begin
(m + sum ms) + sum ns ∎
where open ≡-Reasoning

*-distribˡ-sum : ∀ m ns → m * sum ns ≡ sum (map (m *_) ns)
*-distribˡ-sum m [] = *-zeroʳ m
*-distribˡ-sum m (n ∷ ns) = trans (*-distribˡ-+ m n (sum ns)) (cong (m * n +_) (*-distribˡ-sum m ns))

*-distribʳ-sum : ∀ m ns → sum ns * m ≡ sum (map (_* m) ns)
*-distribʳ-sum m [] = *-zeroˡ m
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I use an explicit invocation of *-zeroˡ rather than refl to keep the proofs symmetric

*-distribʳ-sum m (n ∷ ns) = trans (*-distribʳ-+ m n (sum ns)) (cong (n * m +_) (*-distribʳ-sum m ns))

sum-↭ : sum Preserves _↭_ ⟶ _≡_
sum-↭ p = foldr-commMonoid ℕ-+-0.setoid ℕ-+-0.isCommutativeMonoid (↭⇒↭ₛ p)
where module ℕ-+-0 = CommutativeMonoid +-0-commutativeMonoid
Expand Down Expand Up @@ -78,6 +88,10 @@ product≢0 (n≢0 ∷ ns≢0) = m*n≢0 _ _ {{n≢0}} {{product≢0 ns≢0}}
∈⇒≤product (n≢0 ∷ ns≢0) (here refl) = m≤m*n _ _ {{product≢0 ns≢0}}
∈⇒≤product (n≢0 ∷ ns≢0) (there n∈ns) = m≤n⇒m≤o*n _ {{n≢0}} (∈⇒≤product ns≢0 n∈ns)

^-distribʳ-product : ∀ m ns → product ns ^ m ≡ product (map (_^ m) ns)
^-distribʳ-product m [] = ^-zeroˡ m
^-distribʳ-product m (n ∷ ns) = trans (^-distribʳ-* m n (product ns)) (cong (n ^ m *_) (^-distribʳ-product m ns))

product-↭ : product Preserves _↭_ ⟶ _≡_
product-↭ p = foldr-commMonoid ℕ-*-1.setoid ℕ-*-1.isCommutativeMonoid (↭⇒↭ₛ p)
where module ℕ-*-1 = CommutativeMonoid *-1-commutativeMonoid
7 changes: 7 additions & 0 deletions src/Data/Nat/Properties.agda
Original file line number Diff line number Diff line change
Expand Up @@ -1067,6 +1067,13 @@ m<n⇒m<o*n = m≤n⇒m≤o*n
m * ((m ^ n) * (m ^ o)) ≡⟨ sym (*-assoc m _ _) ⟩
(m * (m ^ n)) * (m ^ o) ∎

^-distribʳ-* : ∀ m n o → (n * o) ^ m ≡ n ^ m * o ^ m
^-distribʳ-* zero n o = refl
^-distribʳ-* (suc m) n o = begin-equality
(n * o) * (n * o) ^ m ≡⟨ cong (n * o *_) (^-distribʳ-* m n o) ⟩
(n * o) * (n ^ m * o ^ m) ≡⟨ [m*n]*[o*p]≡[m*o]*[n*p] n o (n ^ m) (o ^ m) ⟩
n ^ suc m * o ^ suc m ∎

^-semigroup-morphism : ∀ {n} → (n ^_) Is +-semigroup -Semigroup⟶ *-semigroup
^-semigroup-morphism = record
{ ⟦⟧-cong = cong (_ ^_)
Expand Down