mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Support set/{reduce,intersection,equal?,distinct?}

Browse source 
Adds additional functions for the set.el module. See the function documentation
and tests for more information.
This commit is contained in:
William Carroll 2019-12-24 12:31:12 +00:00
parent d5cd2719e7
commit 50f99976e0
1 changed files with 66 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

82
configs/shared/.emacs.d/wpc/set.el
View file

@ -23,6 +23,9 @@
(cl-defstruct set xs) (cl-defstruct set xs)
(defconst set/enable-testing? t
"Run tests when t.")
(defun set/from-list (xs) (defun set/from-list (xs)
"Create a new set from the list XS." "Create a new set from the list XS."
(make-set :xs (->> xs (make-set :xs (->> xs
@ -45,10 +48,26 @@
xs xs
(lambda (table) (lambda (table)
(let ((table-copy (ht-copy table))) (let ((table-copy (ht-copy table)))
(ht-set table-copy x 10) (ht-set table-copy x nil)
table-copy)) table-copy))
xs)) 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) (defun set/count (xs)
"Return the number of elements in XS." "Return the number of elements in XS."
(->> xs (->> xs
@ -67,26 +86,57 @@
"Return t if set XS has X." "Return t if set XS has X."
(ht-contains? (set-xs xs) 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 ;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst set/enable-testing? t
"Run tests when t.")
(when set/enable-testing? (when set/enable-testing?
(progn ;; set/distinct?
;; {from,to}-list (prelude/assert
(prelude/assert (equal '(1 2 3) (set/distinct? (set/new 'one 'two 'three)
(->> '(1 1 2 2 3 3) (set/new 'a 'b 'c)))
set/from-list (prelude/refute
set/to-list))) (set/distinct? (set/new 1 2 3)
;; empty? (set/new 3 4 5)))
(prelude/assert (set/empty? (set/new))) (prelude/refute
(prelude/refute (set/empty? (set/new 1 2 3))) (set/distinct? (set/new 1 2 3)
;; count (set/new 1 2 3)))
(prelude/assert (= 0 (set/count (set/new)))) ;; set/equal?
(prelude/assert (= 2 (set/count (set/new 1 1 2 2)))))) (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) (provide 'set)
;;; set.el ends here ;;; set.el ends here