Support set/{reduce,intersection,equal?,distinct?}
Adds additional functions for the set.el module. See the function documentation and tests for more information.
This commit is contained in:
parent
d5cd2719e7
commit
50f99976e0
1 changed files with 66 additions and 16 deletions
|
@ -23,6 +23,9 @@
|
|||
|
||||
(cl-defstruct set xs)
|
||||
|
||||
(defconst set/enable-testing? t
|
||||
"Run tests when t.")
|
||||
|
||||
(defun set/from-list (xs)
|
||||
"Create a new set from the list XS."
|
||||
(make-set :xs (->> xs
|
||||
|
@ -45,10 +48,26 @@
|
|||
xs
|
||||
(lambda (table)
|
||||
(let ((table-copy (ht-copy table)))
|
||||
(ht-set table-copy x 10)
|
||||
(ht-set table-copy x nil)
|
||||
table-copy))
|
||||
xs))
|
||||
|
||||
;; TODO: Ensure all `*/reduce' functions share the same API.
|
||||
(defun set/reduce (acc f xs)
|
||||
"Return a new set by calling F on each element of XS and ACC."
|
||||
(->> xs
|
||||
set/to-list
|
||||
(list/reduce acc f)))
|
||||
|
||||
(defun set/intersection (a b)
|
||||
"Return the set intersection between sets A and B."
|
||||
(set/reduce (set/new)
|
||||
(lambda (x acc)
|
||||
(if (set/contains? x b)
|
||||
(set/add x acc)
|
||||
acc))
|
||||
a))
|
||||
|
||||
(defun set/count (xs)
|
||||
"Return the number of elements in XS."
|
||||
(->> xs
|
||||
|
@ -67,26 +86,57 @@
|
|||
"Return t if set XS has X."
|
||||
(ht-contains? (set-xs xs) x))
|
||||
|
||||
;; TODO: Prefer using `ht.el' functions for this.
|
||||
(defun set/equal? (a b)
|
||||
"Return t if A and B share the name members."
|
||||
(ht-equal? (set-xs a)
|
||||
(set-xs b)))
|
||||
|
||||
(defun set/distinct? (a b)
|
||||
"Return t if sets A and B have no shared members."
|
||||
(set/empty? (set/intersection a b)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defconst set/enable-testing? t
|
||||
"Run tests when t.")
|
||||
|
||||
(when set/enable-testing?
|
||||
(progn
|
||||
;; {from,to}-list
|
||||
(prelude/assert (equal '(1 2 3)
|
||||
(->> '(1 1 2 2 3 3)
|
||||
set/from-list
|
||||
set/to-list)))
|
||||
;; empty?
|
||||
(prelude/assert (set/empty? (set/new)))
|
||||
(prelude/refute (set/empty? (set/new 1 2 3)))
|
||||
;; count
|
||||
(prelude/assert (= 0 (set/count (set/new))))
|
||||
(prelude/assert (= 2 (set/count (set/new 1 1 2 2))))))
|
||||
;; set/distinct?
|
||||
(prelude/assert
|
||||
(set/distinct? (set/new 'one 'two 'three)
|
||||
(set/new 'a 'b 'c)))
|
||||
(prelude/refute
|
||||
(set/distinct? (set/new 1 2 3)
|
||||
(set/new 3 4 5)))
|
||||
(prelude/refute
|
||||
(set/distinct? (set/new 1 2 3)
|
||||
(set/new 1 2 3)))
|
||||
;; set/equal?
|
||||
(prelude/refute
|
||||
(set/equal? (set/new 'a 'b 'c)
|
||||
(set/new 'x 'y 'z)))
|
||||
(prelude/refute
|
||||
(set/equal? (set/new 'a 'b 'c)
|
||||
(set/new 'a 'b)))
|
||||
(prelude/assert
|
||||
(set/equal? (set/new 'a 'b 'c)
|
||||
(set/new 'a 'b 'c)))
|
||||
;; set/intersection
|
||||
(prelude/assert
|
||||
(set/equal? (set/new 2 3)
|
||||
(set/intersection (set/new 1 2 3)
|
||||
(set/new 2 3 4))))
|
||||
;; set/{from,to}-list
|
||||
(prelude/assert (equal '(1 2 3)
|
||||
(->> '(1 1 2 2 3 3)
|
||||
set/from-list
|
||||
set/to-list)))
|
||||
;; set/empty?
|
||||
(prelude/assert (set/empty? (set/new)))
|
||||
(prelude/refute (set/empty? (set/new 1 2 3)))
|
||||
;; set/count
|
||||
(prelude/assert (= 0 (set/count (set/new))))
|
||||
(prelude/assert (= 2 (set/count (set/new 1 1 2 2)))))
|
||||
|
||||
(provide 'set)
|
||||
;;; set.el ends here
|
||||
|
|
Loading…
Reference in a new issue