From 25e08d89e3553b46e247fd91dfaa2bd6eb11ac79 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Fri, 9 Sep 2022 09:42:05 -0500 Subject: Refactor: collector functions are now defined with defun/t --- gtwiwtg-test.asd | 7 ++- gtwiwtg-test.lisp | 150 +++++++++++++----------------------------------------- gtwiwtg.asd | 8 +-- gtwiwtg.lisp | 61 ++++++++++++++++++---- package.lisp | 1 + 5 files changed, 93 insertions(+), 134 deletions(-) diff --git a/gtwiwtg-test.asd b/gtwiwtg-test.asd index 0cacf8d..cba85d5 100644 --- a/gtwiwtg-test.asd +++ b/gtwiwtg-test.asd @@ -2,9 +2,8 @@ (asdf:defsystem #:gtwiwtg-test :description "tests for gtwiwtg" - :author "Colin Okay " + :author "Colin Okay " :license "GPLv3" :version "0.1.0" - :depends-on (:gtwiwtg :prove :osicat) - :defsystem-depends-on (:prove-asdf) - :components ((:test-file "gtwiwtg-test"))) + :depends-on (:gtwiwtg) + :components ((:file "gtwiwtg-test"))) diff --git a/gtwiwtg-test.lisp b/gtwiwtg-test.lisp index 80c3c86..3fd3781 100644 --- a/gtwiwtg-test.lisp +++ b/gtwiwtg-test.lisp @@ -1,120 +1,40 @@ (defpackage :gtwiwtg-test - (:use :cl :gtwiwtg :prove)) + (:use :cl :gtwiwtg)) (in-package :gtwiwtg-test) -(defmacro autoplan (&rest test-forms) - `(progn - (plan ,(length test-forms)) - ,@test-forms - (finalize))) - -(autoplan - - (is (take 4 (range)) '(0 1 2 3)) - - - (is (collect (range :from 2 :to -1 :by -0.5)) - '(2.0 1.5 1.0 0.5 0.0 -0.5)) - - - (is (collect (range :from 2 :to -1 :by -0.5 :inclusive t)) - '(2.0 1.5 1.0 0.5 0.0 -0.5 -1.0)) - - (ok (let ((r (range))) - (take 1 r) - (gtwiwtg::stopped-p r))) - - (ok (not (gtwiwtg::stopped-p (range)))) - - (is '(4 5 6) (collect (seq '(1 2 3 4 5 6) :start 3))) - - (is (collect (filter! (complement #'alpha-char-p) (seq "1234abcd5e6f"))) - '(#\1 #\2 #\3 #\4 #\5 #\6)) - - (is '(1 2 3 5 8 13) - (take 6 (from-recurrence #'+ 1 0))) - - - (let ((s (open (asdf:system-source-file "gtwiwtg-test")))) - (size (from-input-stream s (lambda (s) (read-line s nil nil)))) - (ok (not (open-stream-p s)))) - - (let* ((file (asdf:system-source-file "gtwiwtg-test")) - (stat (osicat-posix:stat file))) - (is (osicat-posix:stat-size stat) - (1- (size (file-bytes file))))) ;; b/c NIL is returned as the last generated value - - (let* ((file (asdf:system-source-file "gtwiwtg-test")) - (stat (osicat-posix:stat file))) - (is (osicat-posix:stat-size stat) - (1- (size (file-chars file))))) - - (is (list 10 20 30 40) - (take 4 (map! (lambda (x) (* x 10)) - (range :from 1)))) - - (is (list 20 40 60 80 100) - (take 5 (map! (lambda (x) (* 10 x)) - (filter! #'evenp (range :from 1))))) - - (is (list 0 1 2 3 #\a #\b #\c -10 -20 -30) - (take 10 (concat! (times 4) - (seq "abc") - (range :from -10 :by -10)))) - - (is '(("one" 1 :one) ("two" 2 :two) ("three" 3 :three)) - (collect (zip! (seq '("one" "two" "three")) - (range :from 1) - (repeater :one :two :three)))) - -(is '(-200 -180 -160 -140 -120 -100 -80 -60 -40 -20 -20 -15 -10 -5 0 0 1 2 3 4 5 6 7 - 8 9 20 40 60 80 100 120 140 160 180 200) - (collect - (merge! #'< - (range :from -200 :by 20 :to 200 :inclusive t) - (times 10) - (range :from -20 :by 5 :to 0)))) - - -(is (collect - (merge! #'< - (times 3) - (range :from -200 :by 50 :to 200 :inclusive t) - (range :from 0 :by -5 :to -20 :inclusive t))) - '(-200 -150 -100 -50 -20 -15 -10 -5 0 0 0 1 2 50 100 150 200)) - -;; don't be fooled by the last example. Merge is only guaranteed to -;; produce sorted outputs if the inputs are all sorted the same way. -;; here is an example showing that the end result isn't always sorted -;; if the arguments are sorted in different ways: - -(is (collect - (merge! #'< - (times 3) - (range :from 200 :by -50 :to -200 :inclusive t) - (range :from 0 :by -5 :to -20 :inclusive t))) - '(0 -5 -10 -15 -20 -50 -100 -150 -200 0 0 1 2 50 100 150 200)) - -(is (collect (intersperse! (times 5) (repeater 'a 'b 'c) (range :by -10))) - '(0 A 0 1 B -10 2 C -20 3 A -30 4 B -40)) - -(is (collect (truncate! 20 (range))) - '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)) - -(is (pick-out '(4 1 1 4 2) (seq "generators")) - '(#\r #\e #\e #\r #\n)) - - - (let ((res (make-resumable! - (concat! (seq "hello") - (indexed! (filter! 'alpha-char-p (seq "a b c 1 2 3 easy as"))))))) - (take 1 res) - (setf res (resume! res)) - (is '(#\e #\l #\l #\o (0 #\a) (1 #\b) (2 #\c) (3 #\e) (4 #\a) (5 #\s) (6 #\y) - (7 #\a) (8 #\s)) - (collect res))) - - ) - +(defun gtwiwtg::test-collect () + (assert (equal '(1 2 3 4) (collect (range :from 1 :to 4 :inclusive t)))) + (assert (equal '(1 2 3 4) (collect (range :from 1 :to 5)))) + (assert (equal '((1 #\a) (2 #\b) (3 #\c)) + (collect + (zip! (range :from 1) + (seq "abc"))))) + (assert (null (collect (seq ()))))) + +(defun gtwiwtg::test-take () + (assert (null (take 100 (seq "")))) + (assert (equal '(#\a #\b #\c) (take 100 (seq "abc")))) + (assert (equal '(#\a #\b) (take 2 (seq "abcdefg"))))) + + +(defun gtwiwtg::test-pick-out () + (assert + (equal '(40 30 20) + (pick-out '(3 2 1) + (range :from 10 :by 10)))) + (assert + (equal '(101) + (pick-out '(101) + (range))))) + +(defun gtwiwtg::test-argmax () + (assert (equal '(-10 . 100) + (argmax (lambda (x) (* x x)) + (seq '(1 -10 3 4 -4)))))) + +(defun gtwiwtg::test-argmin () + (assert (equal '(1 . 1) + (argmin (lambda (x) (* x x)) + (seq '(1 -10 3 4 -4)))))) diff --git a/gtwiwtg.asd b/gtwiwtg.asd index 41f87eb..5f32536 100644 --- a/gtwiwtg.asd +++ b/gtwiwtg.asd @@ -2,11 +2,11 @@ (asdf:defsystem #:gtwiwtg :description "Lazy-ish iterators" - :author "Colin Okay " + :author "Colin Okay " :license "GPLv3" - :version "0.2.0" + :version "0.3.0" + :depends-on (:testiere) :serial t :components ((:file "package") (:file "gtwiwtg") - (:file "anaphora")) - :in-order-to ((test-op (test-op gtwiwtg-test)))) + (:file "anaphora"))) diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp index 49b7d1b..67ee209 100644 --- a/gtwiwtg.lisp +++ b/gtwiwtg.lisp @@ -188,6 +188,8 @@ E.g. If TO is NIL, then the generator produces an infinite series of values. " + :tests + :end (let ((comparator (if (plusp by) (if inclusive #'<= #'<) (if inclusive #'>= #'>)))) @@ -761,23 +763,34 @@ Example: building data (setf ,acc ,expr)) ,acc)) - -(defun collect (gen) +(defun/t collect (gen) "Consumes GEN by collecting its values into a list." + :tests + (:program test-collect) + :end (nreverse (fold (xs nil) (x gen) (cons x xs)))) -(defun take (n gen) +(defun/t take (n gen) "Consumes GEN by collecting its first N values into a list" + :tests + (:program test-take) + :end (nreverse (fold (xs nil) (x (zip! gen (times n))) (cons (car x) xs)))) -(defun pick-out (indexes gen) +(defun/t pick-out (indexes gen) "Consumes GEN by picking out certain members by their index. INDEXES is a list of non-negative integers. Returns a list of values from GEN such that each value was an element of indexes." + :tests + (:program test-pick-out) + (:fails (() (range))) ; index list cannot be null + (:fails ('(-10) (range))) ; indices cannot be negative + :end + (assert (notany #'minusp indexes)) (let ((acc (make-array (length indexes)))) (for (x idx) (zip! gen (times (1+ (apply #'max indexes)))) (when (member idx indexes) @@ -788,22 +801,42 @@ of indexes." :do (setf (aref acc i) x)))) (concatenate 'list acc))) -(defun size (gen) +(defun/t size (gen) "Consumes GEN by calculating its size." - (fold (n 0) (x gen) (1+ n))) + :tests + (= ((seq nil)) 0) + (= ((range :to 3)) 3) + :end + (fold (n 0) (x (map! (constantly 1) gen)) (+ n x))) -(defun maximum (gen) +(defun/t maximum (gen) "Consumes GEN, returning its maximum value." + :tests + (= ((range :to 5)) 4) + (= ((range :to 5 :inclusive t)) 5) + (= ((range :from -10 :to 0 :by 3)) -1) + (:fails ((seq "hey"))) + :end (fold (m nil) (x gen) (if m (max m x) x))) -(defun minimum (gen) +(defun/t minimum (gen) "Consumes GEN, returning its minimum value." + :tests + (= ((range :to 5)) 0) + (= ((range :from -10 :to 0 :by 3)) -10) + (:fails ((seq "hey"))) + :end (fold (m nil) (x gen) (if m (min m x) x))) -(defun average (gen) +(defun/t average (gen) "Consumes GEN, returning its average value." + :tests + (= ((range :from 1 :to 4 :inclusive t)) 5/2) + (:signals ((seq nil)) division-by-zero) ; empty sum signals division by zero + (:fails ((seq "foo"))) ; numeric sequences only + :end (let ((sum 0) (count 0)) (for x gen @@ -811,9 +844,12 @@ of indexes." (incf count)) (/ sum count))) -(defun argmax (fn gen) +(defun/t argmax (fn gen) "Consumes GEN. Returns a pair (X . VALUE) such that (FUNCALL FN X) is maximal among the values of GEN. VALUE is the value of (FUNCALL FN X)" + :tests + (:program test-argmax) + :end (fold (am nil) (arg gen) (let ((val (funcall fn arg))) @@ -821,9 +857,12 @@ is maximal among the values of GEN. VALUE is the value of (FUNCALL FN X)" (cons arg val) am)))) -(defun argmin (fn gen) +(defun/t argmin (fn gen) "Consumes GEN. Returns a pair (X . VALUE) such that (FUNCALL FN X) is minimal among the values of GEN. VALUE is the value of (FUNCALL FN X)" + :tests + (:program test-argmin) + :end (fold (am nil) (arg gen) (let ((val (funcall fn arg))) diff --git a/package.lisp b/package.lisp index b6efe86..c771b82 100644 --- a/package.lisp +++ b/package.lisp @@ -2,6 +2,7 @@ (defpackage #:gtwiwtg (:use #:cl) + (:import-from #:testiere #:defun/t) (:export #:range #:times #:seq -- cgit v1.2.3