From dbc3a7c5d41a7b392cdcd51a90f3a419dbaed179 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Sun, 16 Jun 2024 15:31:16 +0900 Subject: Add number (product, sum) implementations --- algebraic-structures.egg | 12 ++++ algebraic-structures.number.product.group.scm | 3 + algebraic-structures.number.product.monoid.scm | 3 + algebraic-structures.number.product.semigroup.scm | 3 + algebraic-structures.number.sum.group.scm | 3 + algebraic-structures.number.sum.monoid.scm | 3 + algebraic-structures.number.sum.semigroup.scm | 3 + algebraic-structures.private.number.product.scm | 8 +++ algebraic-structures.private.number.sum.scm | 8 +++ tests/run.scm | 88 ++++++++++++++--------- 10 files changed, 100 insertions(+), 34 deletions(-) create mode 100644 algebraic-structures.number.product.group.scm create mode 100644 algebraic-structures.number.product.monoid.scm create mode 100644 algebraic-structures.number.product.semigroup.scm create mode 100644 algebraic-structures.number.sum.group.scm create mode 100644 algebraic-structures.number.sum.monoid.scm create mode 100644 algebraic-structures.number.sum.semigroup.scm create mode 100644 algebraic-structures.private.number.product.scm create mode 100644 algebraic-structures.private.number.sum.scm diff --git a/algebraic-structures.egg b/algebraic-structures.egg index 7325c7e..0cba2ef 100644 --- a/algebraic-structures.egg +++ b/algebraic-structures.egg @@ -20,6 +20,18 @@ (extension algebraic-structures.monad) (extension algebraic-structures.alternative) + ;; Number (Product) + (extension algebraic-structures.private.number.product) + (extension algebraic-structures.number.product.semigroup) + (extension algebraic-structures.number.product.monoid) + (extension algebraic-structures.number.product.group) + + ;; Number (Sum) + (extension algebraic-structures.private.number.sum) + (extension algebraic-structures.number.sum.semigroup) + (extension algebraic-structures.number.sum.monoid) + (extension algebraic-structures.number.sum.group) + ;; List (extension algebraic-structures.private.list) (extension algebraic-structures.list.semigroup) diff --git a/algebraic-structures.number.product.group.scm b/algebraic-structures.number.product.group.scm new file mode 100644 index 0000000..6723097 --- /dev/null +++ b/algebraic-structures.number.product.group.scm @@ -0,0 +1,3 @@ +(import (algebraic-structures group) + (only (algebraic-structures private number product))) +(module (algebraic-structures number product group) = ((algebraic-structures group) (algebraic-structures private number product))) diff --git a/algebraic-structures.number.product.monoid.scm b/algebraic-structures.number.product.monoid.scm new file mode 100644 index 0000000..6f39c71 --- /dev/null +++ b/algebraic-structures.number.product.monoid.scm @@ -0,0 +1,3 @@ +(import (algebraic-structures monoid) + (only (algebraic-structures private number product))) +(module (algebraic-structures number product monoid) = ((algebraic-structures monoid) (algebraic-structures private number product))) diff --git a/algebraic-structures.number.product.semigroup.scm b/algebraic-structures.number.product.semigroup.scm new file mode 100644 index 0000000..0155f8b --- /dev/null +++ b/algebraic-structures.number.product.semigroup.scm @@ -0,0 +1,3 @@ +(import (algebraic-structures semigroup) + (only (algebraic-structures private number product))) +(module (algebraic-structures number product semigroup) = ((algebraic-structures semigroup) (algebraic-structures private number product))) diff --git a/algebraic-structures.number.sum.group.scm b/algebraic-structures.number.sum.group.scm new file mode 100644 index 0000000..004bb39 --- /dev/null +++ b/algebraic-structures.number.sum.group.scm @@ -0,0 +1,3 @@ +(import (algebraic-structures group) + (only (algebraic-structures private number sum))) +(module (algebraic-structures number sum group) = ((algebraic-structures group) (algebraic-structures private number sum))) diff --git a/algebraic-structures.number.sum.monoid.scm b/algebraic-structures.number.sum.monoid.scm new file mode 100644 index 0000000..6ded322 --- /dev/null +++ b/algebraic-structures.number.sum.monoid.scm @@ -0,0 +1,3 @@ +(import (algebraic-structures monoid) + (only (algebraic-structures private number sum))) +(module (algebraic-structures number sum monoid) = ((algebraic-structures monoid) (algebraic-structures private number sum))) diff --git a/algebraic-structures.number.sum.semigroup.scm b/algebraic-structures.number.sum.semigroup.scm new file mode 100644 index 0000000..4c38ef2 --- /dev/null +++ b/algebraic-structures.number.sum.semigroup.scm @@ -0,0 +1,3 @@ +(import (algebraic-structures semigroup) + (only (algebraic-structures private number sum))) +(module (algebraic-structures number sum semigroup) = ((algebraic-structures semigroup) (algebraic-structures private number sum))) diff --git a/algebraic-structures.private.number.product.scm b/algebraic-structures.private.number.product.scm new file mode 100644 index 0000000..0136b80 --- /dev/null +++ b/algebraic-structures.private.number.product.scm @@ -0,0 +1,8 @@ +(module (algebraic-structures private number product) (<> unit inv) + (import scheme) + + (define (<> x y) (* x y)) + + (define unit 1) + + (define (inv x) (/ x))) diff --git a/algebraic-structures.private.number.sum.scm b/algebraic-structures.private.number.sum.scm new file mode 100644 index 0000000..c0db226 --- /dev/null +++ b/algebraic-structures.private.number.sum.scm @@ -0,0 +1,8 @@ +(module (algebraic-structures private number sum) (<> unit inv) + (import scheme) + + (define (<> x y) (+ x y)) + + (define unit 0) + + (define (inv x) (- x))) diff --git a/tests/run.scm b/tests/run.scm index bcebd31..adf0fc6 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -25,6 +25,22 @@ (test 5 (mod7:<> 3 4)) +(test-begin "number.product") + +(import (prefix (algebraic-structures number product semigroup) product:)) + +(test 12 (product:<> 3 4)) + +(test-end "number.product") + +(test-begin "number.sum") + +(import (prefix (algebraic-structures number sum semigroup) sum:)) + +(test 7 (sum:<> 3 4)) + +(test-end "number.sum") + (test-begin "list") (import (prefix (algebraic-structures list semigroup) list:)) @@ -66,6 +82,22 @@ (test 1 mod7:unit) +(test-begin "number.product") + +(import (prefix (algebraic-structures number product monoid) product:)) + +(test 1 (begin product:unit)) + +(test-end "number.product") + +(test-begin "number.sum") + +(import (prefix (algebraic-structures number sum monoid) sum:)) + +(test 0 (begin sum:unit)) + +(test-end "number.sum") + (test-begin "list") (import (prefix (algebraic-structures list monoid) list:)) @@ -123,6 +155,26 @@ (test (mod7:inv 4) (mod7:pow 4 -1)) +(test-begin "number.product") + +(import (prefix (algebraic-structures number product group) product:)) + +(test 1/2 (product:inv 2)) +(test 8 (product:pow 2 3)) +(test 1/8 (product:pow 2 -3)) + +(test-end "number.product") + +(test-begin "number.sum") + +(import (prefix (algebraic-structures number sum group) sum:)) + +(test -2 (sum:inv 2)) +(test 6 (sum:pow 2 3)) +(test -6 (sum:pow 2 -3)) + +(test-end "number.sum") + (test-end "group") (test-begin "foldable") @@ -242,18 +294,9 @@ (test-begin "semigroup.reducible") -(module (sum semigroup) = (algebraic-structures semigroup) - (import scheme - (chicken base) - (chicken module)) - (export <>) - - (define (<> x y) - (+ x y))) - (import (algebraic-structures semigroup reduce)) (module (sum reduce) = ((algebraic-structures semigroup reduce) - (sum semigroup) + (algebraic-structures number sum semigroup) (algebraic-structures list reducible))) (import (prefix (sum reduce) sum:)) @@ -264,34 +307,11 @@ (test-begin "monoid.fold") -(module (product semigroup) = (algebraic-structures semigroup) - (import scheme - (chicken base) - (chicken module)) - (export <>) - - (define (<> x y) - (assert (number? x)) - (assert (not (zero? x))) - (assert (number? y)) - (assert (not (zero? y))) - (* x y))) - -(module (product monoid) = (algebraic-structures monoid) - (import scheme - (chicken base) - (chicken module)) - (reexport (product semigroup)) - (export unit) - - (define unit 1)) - (import (algebraic-structures monoid fold)) (module (product fold) = ((algebraic-structures monoid fold) - (product monoid) + (algebraic-structures number product monoid) (algebraic-structures list foldable))) -(import (prefix (product monoid) product:)) (import (prefix (product fold) product:)) (test 1 (product:fold '())) -- cgit v1.2.3