--- a/DOCUMENTATION.markdown Tue Nov 22 21:40:35 2016 +0000
+++ b/DOCUMENTATION.markdown Thu Dec 08 13:16:21 2016 -0500
@@ -504,6 +504,177 @@
+## Package `LOSH.HASH-SETS`
+
+Simple hash set implementation.
+
+### `COPY-HASH-SET` (function)
+
+ (COPY-HASH-SET INSTANCE)
+
+### `HASH-SET` (struct)
+
+Slots: `STORAGE`
+
+### `HSET-CLEAR!` (function)
+
+ (HSET-CLEAR! HSET)
+
+Remove all elements from `hset`.
+
+ Returns nothing.
+
+
+
+### `HSET-CONTAINS-P` (function)
+
+ (HSET-CONTAINS-P HSET ELEMENT)
+
+Return whether `hset` contains `element`.
+
+### `HSET-COUNT` (function)
+
+ (HSET-COUNT HSET)
+
+Return the number of elements in `hset`.
+
+### `HSET-DIFFERENCE` (function)
+
+ (HSET-DIFFERENCE HSET &REST OTHERS)
+
+Return a fresh hash set containing the difference of the given hash sets.
+
+### `HSET-DIFFERENCE!` (function)
+
+ (HSET-DIFFERENCE! HSET &REST OTHERS)
+
+Destructively update `hset` to contain the difference of itself with `others`.
+
+### `HSET-ELEMENTS` (function)
+
+ (HSET-ELEMENTS HSET)
+
+Return a fresh list containing the elements of `hset`.
+
+### `HSET-EMPTY-P` (function)
+
+ (HSET-EMPTY-P HSET)
+
+Return whether `hset` is empty.
+
+### `HSET-FILTER` (function)
+
+ (HSET-FILTER HSET PREDICATE)
+
+Return a fresh hash set containing elements of `hset` satisfying `predicate`.
+
+### `HSET-FILTER!` (function)
+
+ (HSET-FILTER! HSET PREDICATE)
+
+Destructively update `hset` to contain only elements satisfying `predicate`.
+
+### `HSET-INSERT!` (function)
+
+ (HSET-INSERT! HSET &REST ELEMENTS)
+
+Insert each element in `elements` into `hset`.
+
+ Returns nothing.
+
+
+
+### `HSET-INTERSECTION` (function)
+
+ (HSET-INTERSECTION HSET &REST OTHERS)
+
+Return a fresh hash set containing the intersection of the given hash sets.
+
+### `HSET-INTERSECTION!` (function)
+
+ (HSET-INTERSECTION! HSET &REST OTHERS)
+
+Destructively update `hset` to contain the intersection of itself with `others`.
+
+### `HSET-MAP` (function)
+
+ (HSET-MAP HSET FUNCTION &KEY NEW-TEST)
+
+Return a fresh hash set containing the results of calling `function` on elements of `hset`.
+
+ If `new-test` is given, the new hash set will use this as it's `test`.
+
+
+
+### `HSET-MAP!` (function)
+
+ (HSET-MAP! HSET FUNCTION &KEY NEW-TEST)
+
+Destructively update `hset` by calling `function` on each element.
+
+ If `new-test` is given the hash set's `test` will be updated.
+
+
+
+### `HSET-POP!` (function)
+
+ (HSET-POP! HSET)
+
+Remove and return an arbitrarily-chosen element from `hset`.
+
+ An error will be signaled if the hash set is empty.
+
+
+
+### `HSET-REMOVE!` (function)
+
+ (HSET-REMOVE! HSET &REST ELEMENTS)
+
+Remove each element in `elements` from `hset`.
+
+ If an element is not in `hset`, it will be ignored.
+
+ Returns nothing.
+
+
+
+### `HSET-UNION` (function)
+
+ (HSET-UNION HSET &REST OTHERS)
+
+Return a fresh hash set containing the union of the given hash sets.
+
+### `HSET-UNION!` (function)
+
+ (HSET-UNION! HSET &REST OTHERS)
+
+Destructively update `hset` to contain the union of itself with `others`.
+
+### `HSET=` (function)
+
+ (HSET= HSET &REST OTHERS)
+
+Return whether all the given hash sets contain exactly the same elements.
+
+ All the hash sets are assumed to use the same `test` -- the consequences are
+ undefined if this is not the case.
+
+
+
+### `MAKE-HASH-SET` (function)
+
+ (MAKE-HASH-SET &KEY (TEST 'EQL) (SIZE 16) (INITIAL-CONTENTS 'NIL))
+
+Create a fresh hash set.
+
+ `size` should be a hint as to how many elements this set is expected to
+ contain.
+
+ `initial-contents` should be a sequence of initial elements for the set
+ (duplicates are fine).
+
+
+
## Package `LOSH.HASH-TABLES`
Utilities for operating on hash tables.
--- a/losh.lisp Tue Nov 22 21:40:35 2016 +0000
+++ b/losh.lisp Thu Dec 08 13:16:21 2016 -0500
@@ -47,6 +47,11 @@
(defconstant 7/8tau (* tau 7/8))
+(defun-inline not= (number &rest more-numbers)
+ "Return `nil` if all arguments are numerically equal, `t` otherwise."
+ (not (apply #'= number more-numbers)))
+
+
(defun-inline degrees (radians)
"Convert `radians` into degrees.
@@ -1499,6 +1504,7 @@
Handy for block-commenting multiple expressions.
"
+ (declare (ignore body))
nil)
@@ -1604,7 +1610,7 @@
(defun stop-profiling (&optional (filename "lisp.prof"))
"Stop profiling performance and dump a report to `filename`. SBCL only."
(sb-sprof::stop-profiling)
- (dump-profile))
+ (dump-profile filename))
;;;; Weightlists --------------------------------------------------------------
@@ -1633,6 +1639,223 @@
(finding item :such-that (< n weight))))
+;;;; Hash Sets ----------------------------------------------------------------
+(defstruct (hash-set (:constructor make-hash-set%))
+ (storage (error "Required") :type hash-table :read-only t))
+
+(defmethod print-object ((hset hash-set) stream)
+ (print-unreadable-object (hset stream :type t :identity t)
+ (format stream "~:S" (hset-elements hset))))
+
+
+(defun make-hash-set (&key (test 'eql) (size 16) (initial-contents '()))
+ "Create a fresh hash set.
+
+ `size` should be a hint as to how many elements this set is expected to
+ contain.
+
+ `initial-contents` should be a sequence of initial elements for the set
+ (duplicates are fine).
+
+ "
+ (let* ((result (make-hash-set% :storage (make-hash-table :test test
+ :size size))))
+ (map nil (curry #'hset-insert! result) initial-contents)
+ result))
+
+(defun copy-hash-set (hset)
+ "Create a (shallow) copy of the given hash set.
+
+ Only the storage for the hash set itself will be copied -- the elements
+ themselves will not be copied.
+
+ "
+ (make-hash-set% :storage (copy-hash-table (hash-set-storage hset))))
+
+
+(defmacro define-hset-op (name arglist &body body)
+ (let* ((has-docstring (stringp (first body)))
+ (docstring (if has-docstring
+ (first body)
+ ""))
+ (body (if has-docstring
+ (rest body)
+ body)))
+ `(defun ,name ,arglist
+ ,docstring
+ (with-slots (storage) ,(first arglist)
+ ,@body))))
+
+
+(define-hset-op hset-empty-p (hset)
+ "Return whether `hset` is empty."
+ (zerop (hash-table-count storage)))
+
+(define-hset-op hset-contains-p (hset element)
+ "Return whether `hset` contains `element`."
+ (values (gethash element storage)))
+
+(define-hset-op hset-count (hset)
+ "Return the number of elements in `hset`."
+ (hash-table-count storage))
+
+(define-hset-op hset-insert! (hset &rest elements)
+ "Insert each element in `elements` into `hset`.
+
+ Returns nothing.
+
+ "
+ (dolist (element elements)
+ (setf (gethash element storage) t))
+ (values))
+
+(define-hset-op hset-remove! (hset &rest elements)
+ "Remove each element in `elements` from `hset`.
+
+ If an element is not in `hset`, it will be ignored.
+
+ Returns nothing.
+
+ "
+ (dolist (element elements)
+ (remhash element storage))
+ (values))
+
+(define-hset-op hset-pop! (hset)
+ "Remove and return an arbitrarily-chosen element from `hset`.
+
+ An error will be signaled if the hash set is empty.
+
+ "
+ (assert (not (hset-empty-p hset))
+ (hset)
+ "Cannot pop from empty hash set ~S"
+ hset)
+ (iterate (for (k nil) :in-hashtable storage)
+ (remhash k storage)
+ (return k)))
+
+(define-hset-op hset-clear! (hset)
+ "Remove all elements from `hset`.
+
+ Returns nothing.
+
+ "
+ (clrhash storage)
+ (values))
+
+
+(define-hset-op hset=% (hset other)
+ (iterate (for (k nil) :in-hashtable storage)
+ (when (not (hset-contains-p other k))
+ (return nil))
+ (finally (return t))))
+
+(define-hset-op hset= (hset &rest others)
+ "Return whether all the given hash sets contain exactly the same elements.
+
+ All the hash sets are assumed to use the same `test` -- the consequences are
+ undefined if this is not the case.
+
+ "
+ (if (apply #'not= (hset-count hset) (mapcar #'hset-count others))
+ nil
+ (iterate (for other :in others)
+ (when (not (hset=% hset other))
+ (return nil))
+ (finally (return t)))))
+
+
+(define-hset-op hset-union!% (hset other)
+ (iterate (for (k nil) :in-hashtable (hash-set-storage other))
+ (hset-insert! hset k))
+ hset)
+
+(define-hset-op hset-union! (hset &rest others)
+ "Destructively update `hset` to contain the union of itself with `others`."
+ (reduce #'hset-union!% others :initial-value hset))
+
+(define-hset-op hset-union (hset &rest others)
+ "Return a fresh hash set containing the union of the given hash sets."
+ (apply #'hset-union! (copy-hash-set hset) others))
+
+
+(define-hset-op hset-intersection!% (hset other)
+ (iterate (for (k nil) :in-hashtable storage)
+ (when (not (hset-contains-p other k))
+ (remhash k storage)))
+ hset)
+
+(define-hset-op hset-intersection! (hset &rest others)
+ "Destructively update `hset` to contain the intersection of itself with `others`."
+ (reduce #'hset-intersection!% others :initial-value hset))
+
+(define-hset-op hset-intersection (hset &rest others)
+ "Return a fresh hash set containing the intersection of the given hash sets."
+ (apply #'hset-intersection! (copy-hash-set hset) others))
+
+
+(define-hset-op hset-difference!% (hset other)
+ (iterate (for (k nil) :in-hashtable (hash-set-storage other))
+ (remhash k storage))
+ hset)
+
+(define-hset-op hset-difference! (hset &rest others)
+ "Destructively update `hset` to contain the difference of itself with `others`."
+ (reduce #'hset-difference!% others :initial-value hset))
+
+(define-hset-op hset-difference (hset &rest others)
+ "Return a fresh hash set containing the difference of the given hash sets."
+ (apply #'hset-difference! (copy-hash-set hset) others))
+
+
+(define-hset-op hset-filter! (hset predicate)
+ "Destructively update `hset` to contain only elements satisfying `predicate`."
+ (iterate (for (k nil) :in-hashtable storage)
+ (when (funcall predicate k)
+ (remhash k storage))))
+
+(define-hset-op hset-filter (hset predicate)
+ "Return a fresh hash set containing elements of `hset` satisfying `predicate`."
+ (let ((new (copy-hash-set hset)))
+ (hset-filter! new predicate)
+ new))
+
+
+(define-hset-op hset-map! (hset function &key new-test)
+ "Destructively update `hset` by calling `function` on each element.
+
+ If `new-test` is given the hash set's `test` will be updated.
+
+ "
+ (let ((results (iterate (for (k nil) :in-hashtable storage)
+ (collect (funcall function k)))))
+ (if new-test
+ ;; Rebuild the underlying hash table if we have a new test.
+ (setf storage (make-hash-table :test new-test
+ :size (hash-table-count storage)))
+ ;; Otherwise just clear and reuse the existing one.
+ (clrhash storage))
+ (dolist (k results)
+ (hset-insert! hset k))
+ nil))
+
+(define-hset-op hset-map (hset function &key new-test)
+ "Return a fresh hash set containing the results of calling `function` on elements of `hset`.
+
+ If `new-test` is given, the new hash set will use this as it's `test`.
+
+ "
+ (let ((new (copy-hash-set hset)))
+ (hset-map! new function :new-test new-test)
+ new))
+
+
+(define-hset-op hset-elements (hset)
+ "Return a fresh list containing the elements of `hset`."
+ (hash-table-keys storage))
+
+
;;;; Bit Sets -----------------------------------------------------------------
;;; Implementation of the sets-as-integers idea in the Common Lisp Recipes book.
(deftype bset () '(integer 0))
--- a/make-docs.lisp Tue Nov 22 21:40:35 2016 +0000
+++ b/make-docs.lisp Thu Dec 08 13:16:21 2016 -0500
@@ -8,6 +8,7 @@
"LOSH.DEBUGGING"
"LOSH.ELDRITCH-HORRORS"
"LOSH.FUNCTIONS"
+ "LOSH.HASH-SETS"
"LOSH.HASH-TABLES"
"LOSH.ITERATE"
"LOSH.LICENSING"
--- a/package.lisp Tue Nov 22 21:40:35 2016 +0000
+++ b/package.lisp Thu Dec 08 13:16:21 2016 -0500
@@ -150,6 +150,36 @@
(:export
:mutate-hash-values))
+(defpackage :losh.hash-sets
+ (:documentation "Simple hash set implementation.")
+ (:export
+ :hash-set
+ :make-hash-set
+ :copy-hash-set
+
+ :hset-empty-p
+ :hset-contains-p
+ :hset-elements
+ :hset-count
+
+ :hset-insert!
+ :hset-remove!
+ :hset-pop!
+ :hset-clear!
+
+ :hset=
+
+ :hset-union
+ :hset-union!
+ :hset-intersection
+ :hset-intersection!
+ :hset-difference
+ :hset-difference!
+ :hset-filter
+ :hset-filter!
+ :hset-map
+ :hset-map!))
+
(defpackage :losh.sequences
(:documentation "Utilities for operating on sequences.")
(:export
@@ -203,6 +233,7 @@
:losh.debugging
:losh.eldritch-horrors
:losh.functions
+ :losh.hash-sets
:losh.hash-tables
:losh.iterate
:losh.licensing
--- a/vendor/make-quickutils.lisp Tue Nov 22 21:40:35 2016 +0000
+++ b/vendor/make-quickutils.lisp Thu Dec 08 13:16:21 2016 -0500
@@ -5,6 +5,7 @@
:utilities '(
:compose
+ :copy-hash-table
:curry
:emptyp
:ensure-keyword
--- a/vendor/quickutils.lisp Tue Nov 22 21:40:35 2016 +0000
+++ b/vendor/quickutils.lisp Thu Dec 08 13:16:21 2016 -0500
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "LOSH.QUICKUTILS")
@@ -14,13 +14,13 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :COMPOSE :CURRY :NON-ZERO-P :EMPTYP
- :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN
- :MAPHASH-KEYS :HASH-TABLE-KEYS
- :MAPHASH-VALUES :HASH-TABLE-VALUES
- :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY
- :SYMB :WEAVE :STRING-DESIGNATOR
- :WITH-GENSYMS))))
+ :COMPOSE :COPY-HASH-TABLE :CURRY
+ :NON-ZERO-P :EMPTYP :ENSURE-KEYWORD
+ :ENSURE-LIST :FLATTEN :MAPHASH-KEYS
+ :HASH-TABLE-KEYS :MAPHASH-VALUES
+ :HASH-TABLE-VALUES :MAP-TREE :MKSTR
+ :ONCE-ONLY :RCURRY :SYMB :WEAVE
+ :STRING-DESIGNATOR :WITH-GENSYMS))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-gensym-list (length &optional (x "G"))
"Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -74,6 +74,29 @@
,(compose-1 funs))))))
+ (defun copy-hash-table (table &key key test size
+ rehash-size rehash-threshold)
+ "Returns a copy of hash table `table`, with the same keys and values
+as the `table`. The copy has the same properties as the original, unless
+overridden by the keyword arguments.
+
+Before each of the original values is set into the new hash-table, `key`
+is invoked on the value. As `key` defaults to `cl:identity`, a shallow
+copy is returned by default."
+ (setf key (or key 'identity))
+ (setf test (or test (hash-table-test table)))
+ (setf size (or size (hash-table-size table)))
+ (setf rehash-size (or rehash-size (hash-table-rehash-size table)))
+ (setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
+ (let ((copy (make-hash-table :test test :size size
+ :rehash-size rehash-size
+ :rehash-threshold rehash-threshold)))
+ (maphash (lambda (k v)
+ (setf (gethash k copy) (funcall key v)))
+ table)
+ copy))
+
+
(defun curry (function &rest arguments)
"Returns a function that applies `arguments` and the arguments
it is called with to `function`."
@@ -294,8 +317,8 @@
`(with-gensyms ,names ,@forms))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(compose curry emptyp ensure-keyword ensure-list flatten
- hash-table-keys hash-table-values map-tree mkstr once-only rcurry
- symb weave with-gensyms with-unique-names)))
+ (export '(compose copy-hash-table curry emptyp ensure-keyword ensure-list
+ flatten hash-table-keys hash-table-values map-tree mkstr once-only
+ rcurry symb weave with-gensyms with-unique-names)))
;;;; END OF quickutils.lisp ;;;;