Add unit tests for lib.functions.rev-map
This commit is contained in:
@@ -37,11 +37,11 @@ each member is STEP distance apart."
|
||||
(subseq lst n)))
|
||||
|
||||
(fn rev-map (indicator lst &key (key-eq #'eq))
|
||||
(-> (function list &key (:key-eq function)) list)
|
||||
(-> (function sequence &key (:key-eq function)) list)
|
||||
"Given LST and INDICATOR: LST -> A, return an association list A -> 2^LST
|
||||
where key x in A has associations {y in LST : INDICATOR(y) = x}."
|
||||
(loop :with assoc-list := nil
|
||||
:for element :in lst
|
||||
:for element :in (coerce lst 'list)
|
||||
:for key := (funcall indicator element)
|
||||
:if (assoc key assoc-list :test key-eq)
|
||||
:do (->> (alist-val key assoc-list)
|
||||
|
||||
@@ -63,3 +63,33 @@
|
||||
(is-values (split 5 "Hello World")
|
||||
(string= "Hello")
|
||||
(string= " World")))
|
||||
|
||||
(define-test (function-test rev-map)
|
||||
:depends-on (range)
|
||||
:compile-at :execute
|
||||
(fail (rev-map nil nil))
|
||||
(fail (rev-map "a string" "another string" :key-eq "not a function"))
|
||||
(true (->> nil (rev-map #'identity) null))
|
||||
(let ((res (rev-map #'evenp (range 1 7))))
|
||||
(false (null res))
|
||||
(is equal 2 (length res))
|
||||
(is equal 3 (->> (assoc t res) cdr length))
|
||||
(is equal 3 (->> (assoc nil res) cdr length))
|
||||
(true (->> (assoc t res) cdr (every #'evenp)))
|
||||
(true (->> (assoc nil res) cdr (every #'oddp))))
|
||||
(let* ((mod* (lambda (n) (mod n 3)))
|
||||
(res (rev-map mod* (range 1 12))))
|
||||
(false (null res))
|
||||
(is equal 3 (length res))
|
||||
(is equal 3 (->> (assoc 0 res) cdr length))
|
||||
(is equal 4 (->> (assoc 1 res) cdr length))
|
||||
(is equal 4 (->> (assoc 2 res) cdr length))
|
||||
(true (->> (assoc 0 res) cdr (every (lambda (x) (= (mod x 3) 0)))))
|
||||
(true (->> (assoc 1 res) cdr (every (lambda (x) (= (mod x 3) 1)))))
|
||||
(true (->> (assoc 2 res) cdr (every (lambda (x) (= (mod x 3) 2))))))
|
||||
(let ((res (rev-map #'identity "lots of letters")))
|
||||
(false (null res))
|
||||
(is equal 2 (->> (assoc #\l res) cdr length))
|
||||
(is equal 3 (->> (assoc #\t res) cdr length))
|
||||
(is equal 2 (->> (assoc #\space res) cdr length))
|
||||
(is equal 2 (->> (assoc #\s res) cdr length))))
|
||||
|
||||
Reference in New Issue
Block a user