diff options
Diffstat (limited to 'users/wpcarro/emacs/.emacs.d/wpc/set.el')
| -rw-r--r-- | users/wpcarro/emacs/.emacs.d/wpc/set.el | 174 |
1 files changed, 174 insertions, 0 deletions
diff --git a/users/wpcarro/emacs/.emacs.d/wpc/set.el b/users/wpcarro/emacs/.emacs.d/wpc/set.el new file mode 100644 index 000000000000..778b089e156b --- /dev/null +++ b/users/wpcarro/emacs/.emacs.d/wpc/set.el @@ -0,0 +1,174 @@ +;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; The set data structure is a collection that deduplicates its elements. + +;;; Code: + +(require 'ht) ;; friendlier API for hash-tables +(require 'dotted) +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Wish List +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; - TODO: Support enum protocol for set. +;; - TODO: Prefer a different hash-table library that doesn't rely on mutative +;; code. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 + (list-map #'dotted-new) + ht-from-alist))) + +(defun set-new (&rest args) + "Create a new set from ARGS." + (set-from-list args)) + +(defun set-to-list (xs) + "Map set XS into a list." + (->> xs + set-xs + ht-keys)) + +(defun set-add (x xs) + "Add X to set XS." + (struct-update set + xs + (lambda (table) + (let ((table-copy (ht-copy table))) + (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 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 + set-xs + ht-size)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun set-empty? (xs) + "Return t if XS has no elements in it." + (= 0 (set-count xs))) + +(defun set-contains? (x xs) + "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 A and B have no shared members." + (set-empty? (set-intersection a b))) + +(defun set-superset? (a b) + "Return t if A has all of the members of B." + (->> b + set-to-list + (list-all? (lambda (x) (set-contains? x a))))) + +(defun set-subset? (a b) + "Return t if each member of set A is present in set B." + (set-superset? b a)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when set-enable-testing? + ;; 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))) + (let ((primary-colors (set-new "red" "green" "blue"))) + ;; set-subset? + (prelude-refute + (set-subset? (set-new "black" "grey") + primary-colors)) + (prelude-assert + (set-subset? (set-new "red") + primary-colors)) + ;; set-superset? + (prelude-refute + (set-superset? primary-colors + (set-new "black" "grey"))) + (prelude-assert + (set-superset? primary-colors + (set-new "red" "green" "blue"))) + (prelude-assert + (set-superset? primary-colors + (set-new "red" "blue")))) + ;; 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 |