branch: externals/dash
commit 112aa7c251a7cf3e5d024e21f205cdba79df5a33
Author: Basil L. Contovounesios <conto...@tcd.ie>
Commit: Basil L. Contovounesios <conto...@tcd.ie>
Fix clients of -compare-fn
* NEWS.md (2.19.2): Rename...
(2.20.0): ...to this. Announce changes.
* README.md:
* dash.texi: Regenerate docs.
* dash.el (-compare-fn): Clarify docstring.
(dash--member-fn, dash--hash-test-fn, dash--size+): New convenience
functions.
(dash--short-list-length): New variable.
(-distinct, -union, -intersection, -difference): Check for empty
list early. Prefer dash--member-fn over -contains? for speed.
Exclude duplicates from return value. Use a hash table for long
lists, but avoid its overhead for short lists.
(-contains?): Delegate to member if -compare-fn is either equal or
nil, not just nil. Reimplement in terms of dash--member-fn.
(-same-items?): Support multisets of different length. Use hash
tables for long lists.
* dev/examples.el (-same-items?): Move from "Predicates" to "Set
operations". Extend tests.
(-contains?, -union, -difference, -intersection, -distinct): Extend
tests.
(dash--member-fn, dash--hash-test-fn, dash--size+): New tests.
---
NEWS.md | 17 +++-
README.md | 94 +++++++++++---------
dash.el | 265 +++++++++++++++++++++++++++++++++++++-------------------
dash.texi | 114 ++++++++++++------------
dev/examples.el | 212 +++++++++++++++++++++++++++++++++++++++------
5 files changed, 492 insertions(+), 210 deletions(-)
diff --git a/NEWS.md b/NEWS.md
index 5dbb24bb26..00f240938e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -6,12 +6,27 @@ See the end of the file for license conditions.
## Change log
-### From 2.19.1 to 2.19.2
+### From 2.19.1 to 2.20.0
#### Fixes
- Fixed a regression from `2.18` in `-take` that caused it to
prematurely signal an error on improper lists (#393).
+- The functions `-union`, `-intersection`, and `-difference` now
+ return proper sets, without duplicate elements (#397).
+- The function `-same-items?` now works on multisets (lists with
+ duplicate elements and/or different lengths) (#397).
+
+ For example, the following now returns non-`nil`:
+
+ ```el
+ (-same-items? '(1 1 2 3) '(1 2 3))
+ ```
+
+#### New features
+
+- The function `-contains?` now returns the matching tail of the list
+ instead of just `t`, similarly to `member` (#397).
### From 2.19.0 to 2.19.1
diff --git a/README.md b/README.md
index 90607f65e7..ea48cd53db 100644
--- a/README.md
+++ b/README.md
@@ -222,7 +222,6 @@ Reductions of one or more lists to a boolean value.
* [`-none?`](#-none-pred-list) `(pred list)`
* [`-only-some?`](#-only-some-pred-list) `(pred list)`
* [`-contains?`](#-contains-list-element) `(list element)`
-* [`-same-items?`](#-same-items-list-list2) `(list list2)`
* [`-is-prefix?`](#-is-prefix-prefix-list) `(prefix list)`
* [`-is-suffix?`](#-is-suffix-suffix-list) `(suffix list)`
* [`-is-infix?`](#-is-infix-infix-list) `(infix list)`
@@ -266,12 +265,13 @@ related predicates.
Operations pretending lists are sets.
-* [`-union`](#-union-list-list2) `(list list2)`
-* [`-difference`](#-difference-list-list2) `(list list2)`
-* [`-intersection`](#-intersection-list-list2) `(list list2)`
+* [`-union`](#-union-list1-list2) `(list1 list2)`
+* [`-difference`](#-difference-list1-list2) `(list1 list2)`
+* [`-intersection`](#-intersection-list1-list2) `(list1 list2)`
* [`-powerset`](#-powerset-list) `(list)`
* [`-permutations`](#-permutations-list) `(list)`
* [`-distinct`](#-distinct-list) `(list)`
+* [`-same-items?`](#-same-items-list1-list2) `(list1 list2)`
### Other list operations
@@ -1380,28 +1380,15 @@ Alias: `-only-some-p`
Return non-`nil` if `list` contains `element`.
The test for equality is done with `equal`, or with `-compare-fn`
-if that's non-`nil`.
+if that is non-`nil`. As with `member`, the return value is
+actually the tail of `list` whose car is `element`.
-Alias: `-contains-p`
+Alias: `-contains-p`.
```el
-(-contains? '(1 2 3) 1) ;; => t
-(-contains? '(1 2 3) 2) ;; => t
-(-contains? '(1 2 3) 4) ;; => nil
-```
-
-#### -same-items? `(list list2)`
-
-Return true if `list` and `list2` has the same items.
-
-The order of the elements in the lists does not matter.
-
-Alias: `-same-items-p`
-
-```el
-(-same-items? '(1 2 3) '(1 2 3)) ;; => t
-(-same-items? '(1 2 3) '(3 2 1)) ;; => t
-(-same-items? '(1 2 3) '(1 2 3 4)) ;; => nil
+(-contains? '(1 2 3) 1) ;; => (1 2 3)
+(-contains? '(1 2 3) 2) ;; => (2 3)
+(-contains? '(1 2 3) 4) ;; => ()
```
#### -is-prefix? `(prefix list)`
@@ -1774,23 +1761,25 @@ permutation to `list` sorts it in descending order.
Operations pretending lists are sets.
-#### -union `(list list2)`
+#### -union `(list1 list2)`
+
+Return a new list of distinct elements appearing in either `list1` or `list2`.
-Return a new list of all elements appearing in either `list1` or `list2`.
-Equality is defined by the value of `-compare-fn` if non-`nil`;
-otherwise `equal`.
+The test for equality is done with `equal`, or with `-compare-fn`
+if that is non-`nil`.
```el
(-union '(1 2 3) '(3 4 5)) ;; => (1 2 3 4 5)
-(-union '(1 2 3 4) ()) ;; => (1 2 3 4)
-(-union '(1 1 2 2) '(3 2 1)) ;; => (1 1 2 2 3)
+(-union '(1 2 2 4) ()) ;; => (1 2 4)
+(-union '(1 1 2 2) '(4 4 3 2 1)) ;; => (1 2 4 3)
```
-#### -difference `(list list2)`
+#### -difference `(list1 list2)`
+
+Return a new list with the distinct members of `list1` that are not in `list2`.
-Return a new list with only the members of `list` that are not in `list2`.
-The test for equality is done with `equal`,
-or with `-compare-fn` if that's non-`nil`.
+The test for equality is done with `equal`, or with `-compare-fn`
+if that is non-`nil`.
```el
(-difference () ()) ;; => ()
@@ -1798,16 +1787,17 @@ or with `-compare-fn` if that's non-`nil`.
(-difference '(1 2 3 4) '(3 4 5 6)) ;; => (1 2)
```
-#### -intersection `(list list2)`
+#### -intersection `(list1 list2)`
-Return a new list of the elements appearing in both `list1` and `list2`.
-Equality is defined by the value of `-compare-fn` if non-`nil`;
-otherwise `equal`.
+Return a new list of distinct elements appearing in both `list1` and `list2`.
+
+The test for equality is done with `equal`, or with `-compare-fn`
+if that is non-`nil`.
```el
(-intersection () ()) ;; => ()
(-intersection '(1 2 3) '(4 5 6)) ;; => ()
-(-intersection '(1 2 3 4) '(3 4 5 6)) ;; => (3 4)
+(-intersection '(1 2 2 3) '(4 3 3 2)) ;; => (2 3)
```
#### -powerset `(list)`
@@ -1831,18 +1821,36 @@ Return the permutations of `list`.
#### -distinct `(list)`
-Return a new list with all duplicates removed.
-The test for equality is done with `equal`,
-or with `-compare-fn` if that's non-`nil`.
+Return a copy of `list` with all duplicate elements removed.
+
+The test for equality is done with `equal`, or with `-compare-fn`
+if that is non-`nil`.
-Alias: `-uniq`
+Alias: `-uniq`.
```el
(-distinct ()) ;; => ()
-(-distinct '(1 2 2 4)) ;; => (1 2 4)
+(-distinct '(1 1 2 3 3)) ;; => (1 2 3)
(-distinct '(t t t)) ;; => (t)
```
+#### -same-items? `(list1 list2)`
+
+Return non-`nil` if `list1` and `list2` have the same distinct elements.
+
+The order of the elements in the lists does not matter. The
+lists may be of different lengths, i.e., contain duplicate
+elements. The test for equality is done with `equal`, or with
+`-compare-fn` if that is non-`nil`.
+
+Alias: `-same-items-p`.
+
+```el
+(-same-items? '(1 2 3) '(1 2 3)) ;; => t
+(-same-items? '(1 1 2 3) '(3 3 2 1)) ;; => t
+(-same-items? '(1 2 3) '(1 2 3 4)) ;; => nil
+```
+
## Other list operations
Other list functions not fit to be classified elsewhere.
diff --git a/dash.el b/dash.el
index 7a90e7ba25..739e4864ae 100644
--- a/dash.el
+++ b/dash.el
@@ -2690,67 +2690,146 @@ execute body."
(indent 1))
`(--if-let ,val (progn ,@body)))
+;; TODO: Get rid of this dynamic variable, passing it as an argument
+;; instead?
(defvar -compare-fn nil
- "Tests for equality use this function or `equal' if this is nil.
-It should only be set using dynamic scope with a let, like:
-
- (let ((-compare-fn #\\='=)) (-union numbers1 numbers2 numbers3)")
+ "Tests for equality use this function, or `equal' if this is nil.
+
+As a dynamic variable, this should be temporarily bound around
+the relevant operation, rather than permanently modified. For
+example:
+
+ (let ((-compare-fn #\\='=))
+ (-union \\='(1 2 3) \\='(2 3 4)))")
+
+(defun dash--member-fn ()
+ "Return the flavor of `member' that goes best with `-compare-fn'."
+ (declare (side-effect-free error-free))
+ (let ((cmp -compare-fn))
+ (cond ((memq cmp '(nil equal)) #'member)
+ ((eq cmp #'eq) #'memq)
+ ((eq cmp #'eql) #'memql)
+ ((lambda (elt list)
+ (while (and list (not (funcall cmp elt (car list))))
+ (pop list))
+ list)))))
+
+(defun dash--hash-test-fn ()
+ "Return the hash table test function corresponding to `-compare-fn'.
+Return nil if `-compare-fn' is not a known test function."
+ (declare (side-effect-free error-free))
+ ;; In theory this could also recognize values that are custom
+ ;; `hash-table-test's, but too often the :test name is different
+ ;; from the equality function, so it doesn't seem worthwile.
+ (car (memq (or -compare-fn #'equal) '(equal eq eql))))
+
+(defvar dash--short-list-length 32
+ "Maximum list length considered short, for optimizations.
+For example, the speedup afforded by hash table lookup may start
+to outweigh its runtime and memory overhead for problem sizes
+greater than this value. See also the discussion in PR #305.")
(defun -distinct (list)
- "Return a new list with all duplicates removed.
-The test for equality is done with `equal',
-or with `-compare-fn' if that's non-nil.
-
-Alias: `-uniq'"
- ;; Implementation note: The speedup gained from hash table lookup
- ;; starts to outweigh its overhead for lists of length greater than
- ;; 32. See discussion in PR #305.
- (let* ((len (length list))
- (lut (and (> len 32)
- ;; Check that `-compare-fn' is a valid hash-table
- ;; lookup function or nil.
- (memq -compare-fn '(nil equal eq eql))
- (make-hash-table :test (or -compare-fn #'equal)
- :size len))))
- (if lut
- (--filter (unless (gethash it lut)
- (puthash it t lut))
- list)
- (--each list (unless (-contains? lut it) (!cons it lut)))
- (nreverse lut))))
-
-(defalias '-uniq '-distinct)
-
-(defun -union (list list2)
- "Return a new list of all elements appearing in either LIST1 or LIST2.
-Equality is defined by the value of `-compare-fn' if non-nil;
-otherwise `equal'."
- ;; We fall back to iteration implementation if the comparison
- ;; function isn't one of `eq', `eql' or `equal'.
- (let* ((result (reverse list))
- ;; TODO: get rid of this dynamic variable, pass it as an
- ;; argument instead.
- (-compare-fn (if (bound-and-true-p -compare-fn)
- -compare-fn
- 'equal)))
- (if (memq -compare-fn '(eq eql equal))
- (let ((ht (make-hash-table :test -compare-fn)))
- (--each list (puthash it t ht))
- (--each list2 (unless (gethash it ht) (!cons it result))))
- (--each list2 (unless (-contains? result it) (!cons it result))))
- (nreverse result)))
+ "Return a copy of LIST with all duplicate elements removed.
+
+The test for equality is done with `equal', or with `-compare-fn'
+if that is non-nil.
+
+Alias: `-uniq'."
+ (let (test len)
+ (cond ((null list) ())
+ ;; Use a hash table if `-compare-fn' is a known hash table
+ ;; test function and the list is long enough.
+ ((and (setq test (dash--hash-test-fn))
+ (> (setq len (length list)) dash--short-list-length))
+ (let ((ht (make-hash-table :test test :size len)))
+ (--filter (unless (gethash it ht) (puthash it t ht)) list)))
+ ((let ((member (dash--member-fn)) uniq)
+ (--each list (unless (funcall member it uniq) (push it uniq)))
+ (nreverse uniq))))))
+
+(defalias '-uniq #'-distinct)
+
+(defun dash--size+ (size1 size2)
+ "Return the sum of nonnegative fixnums SIZE1 and SIZE2.
+Return `most-positive-fixnum' on overflow. This ensures the
+result is a valid size, particularly for allocating hash tables,
+even in the presence of bignum support."
+ (declare (side-effect-free t))
+ (if (< size1 (- most-positive-fixnum size2))
+ (+ size1 size2)
+ most-positive-fixnum))
+
+(defun -union (list1 list2)
+ "Return a new list of distinct elements appearing in either LIST1 or LIST2.
-(defun -intersection (list list2)
- "Return a new list of the elements appearing in both LIST1 and LIST2.
-Equality is defined by the value of `-compare-fn' if non-nil;
-otherwise `equal'."
- (--filter (-contains? list2 it) list))
+The test for equality is done with `equal', or with `-compare-fn'
+if that is non-nil."
+ (let ((lists (list list1 list2)) test len union)
+ (cond ((null (or list1 list2)))
+ ;; Use a hash table if `-compare-fn' is a known hash table
+ ;; test function and the lists are long enough.
+ ((and (setq test (dash--hash-test-fn))
+ (> (setq len (dash--size+ (length list1) (length list2)))
+ dash--short-list-length))
+ (let ((ht (make-hash-table :test test :size len)))
+ (dolist (l lists)
+ (--each l (unless (gethash it ht)
+ (puthash it t ht)
+ (push it union))))))
+ ((let ((member (dash--member-fn)))
+ (dolist (l lists)
+ (--each l (unless (funcall member it union) (push it
union)))))))
+ (nreverse union)))
+
+(defun -intersection (list1 list2)
+ "Return a new list of distinct elements appearing in both LIST1 and LIST2.
+
+The test for equality is done with `equal', or with `-compare-fn'
+if that is non-nil."
+ (let (test len)
+ (cond ((null (and list1 list2)) ())
+ ;; Use a hash table if `-compare-fn' is a known hash table
+ ;; test function and either list is long enough.
+ ((and (setq test (dash--hash-test-fn))
+ (> (setq len (length list2)) dash--short-list-length))
+ (let ((ht (make-hash-table :test test :size len)))
+ (--each list2 (puthash it t ht))
+ ;; Remove visited elements to avoid duplicates.
+ (--filter (when (gethash it ht) (remhash it ht) t) list1)))
+ ((let ((member (dash--member-fn)) intersection)
+ (--each list1 (and (funcall member it list2)
+ (not (funcall member it intersection))
+ (push it intersection)))
+ (nreverse intersection))))))
+
+(defun -difference (list1 list2)
+ "Return a new list with the distinct members of LIST1 that are not in LIST2.
-(defun -difference (list list2)
- "Return a new list with only the members of LIST that are not in LIST2.
-The test for equality is done with `equal',
-or with `-compare-fn' if that's non-nil."
- (--filter (not (-contains? list2 it)) list))
+The test for equality is done with `equal', or with `-compare-fn'
+if that is non-nil."
+ (let (test len1 len2)
+ (cond ((null list1) ())
+ ((null list2) (-distinct list1))
+ ;; Use a hash table if `-compare-fn' is a known hash table
+ ;; test function and the subtrahend is long enough.
+ ((and (setq test (dash--hash-test-fn))
+ (setq len1 (length list1))
+ (setq len2 (length list2))
+ (> (max len1 len2) dash--short-list-length))
+ (let ((ht1 (make-hash-table :test test :size len1))
+ (ht2 (make-hash-table :test test :size len2)))
+ (--each list2 (puthash it t ht2))
+ ;; Avoid duplicates by tracking visited items in `ht1'.
+ (--filter (unless (or (gethash it ht2) (gethash it ht1))
+ (puthash it t ht1))
+ list1)))
+ ((let ((member (dash--member-fn)) difference)
+ (--each list1
+ (unless (or (funcall member it list2)
+ (funcall member it difference))
+ (push it difference)))
+ (nreverse difference))))))
(defun -powerset (list)
"Return the power set of LIST."
@@ -2794,37 +2873,49 @@ or with `-compare-fn' if that's non-nil."
"Return non-nil if LIST contains ELEMENT.
The test for equality is done with `equal', or with `-compare-fn'
-if that's non-nil.
-
-Alias: `-contains-p'"
- (not
- (null
- (cond
- ((null -compare-fn) (member element list))
- ((eq -compare-fn 'eq) (memq element list))
- ((eq -compare-fn 'eql) (memql element list))
- (t
- (let ((lst list))
- (while (and lst
- (not (funcall -compare-fn element (car lst))))
- (setq lst (cdr lst)))
- lst))))))
-
-(defalias '-contains-p '-contains?)
-
-(defun -same-items? (list list2)
- "Return true if LIST and LIST2 has the same items.
-
-The order of the elements in the lists does not matter.
-
-Alias: `-same-items-p'"
- (let ((length-a (length list))
- (length-b (length list2)))
- (and
- (= length-a length-b)
- (= length-a (length (-intersection list list2))))))
-
-(defalias '-same-items-p '-same-items?)
+if that is non-nil. As with `member', the return value is
+actually the tail of LIST whose car is ELEMENT.
+
+Alias: `-contains-p'."
+ (funcall (dash--member-fn) element list))
+
+(defalias '-contains-p #'-contains?)
+
+(defun -same-items? (list1 list2)
+ "Return non-nil if LIST1 and LIST2 have the same distinct elements.
+
+The order of the elements in the lists does not matter. The
+lists may be of different lengths, i.e., contain duplicate
+elements. The test for equality is done with `equal', or with
+`-compare-fn' if that is non-nil.
+
+Alias: `-same-items-p'."
+ (let (test len1 len2)
+ (cond ((null (or list1 list2)))
+ ((null (and list1 list2)) nil)
+ ;; Use a hash table if `-compare-fn' is a known hash table
+ ;; test function and either list is long enough.
+ ((and (setq test (dash--hash-test-fn))
+ (setq len1 (length list1))
+ (setq len2 (length list2))
+ (> (max len1 len2) dash--short-list-length))
+ (let ((ht1 (make-hash-table :test test :size len1))
+ (ht2 (make-hash-table :test test :size len2)))
+ (--each list1 (puthash it t ht1))
+ ;; Move visited elements from `ht1' to `ht2'. This way,
+ ;; if visiting all of `list2' leaves `ht1' empty, then
+ ;; all elements from both lists have been accounted for.
+ (and (--every (cond ((gethash it ht1)
+ (remhash it ht1)
+ (puthash it t ht2))
+ ((gethash it ht2)))
+ list2)
+ (zerop (hash-table-count ht1)))))
+ ((let ((member (dash--member-fn)))
+ (and (--all? (funcall member it list2) list1)
+ (--all? (funcall member it list1) list2)))))))
+
+(defalias '-same-items-p #'-same-items?)
(defun -is-prefix? (prefix list)
"Return non-nil if PREFIX is a prefix of LIST.
diff --git a/dash.texi b/dash.texi
index 919487b2ef..72ecbe65a8 100644
--- a/dash.texi
+++ b/dash.texi
@@ -1884,46 +1884,23 @@ Alias: @code{-only-some-p}
Return non-@code{nil} if @var{list} contains @var{element}.
The test for equality is done with @code{equal}, or with @code{-compare-fn}
-if that's non-@code{nil}.
+if that is non-@code{nil}. As with @code{member}, the return value is
+actually the tail of @var{list} whose car is @var{element}.
-Alias: @code{-contains-p}
+Alias: @code{-contains-p}.
@example
@group
(-contains? '(1 2 3) 1)
- @result{} t
+ @result{} (1 2 3)
@end group
@group
(-contains? '(1 2 3) 2)
- @result{} t
+ @result{} (2 3)
@end group
@group
(-contains? '(1 2 3) 4)
- @result{} nil
-@end group
-@end example
-@end defun
-
-@anchor{-same-items?}
-@defun -same-items? (list list2)
-Return true if @var{list} and @var{list2} has the same items.
-
-The order of the elements in the lists does not matter.
-
-Alias: @code{-same-items-p}
-
-@example
-@group
-(-same-items? '(1 2 3) '(1 2 3))
- @result{} t
-@end group
-@group
-(-same-items? '(1 2 3) '(3 2 1))
- @result{} t
-@end group
-@group
-(-same-items? '(1 2 3) '(1 2 3 4))
- @result{} nil
+ @result{} ()
@end group
@end example
@end defun
@@ -2566,10 +2543,11 @@ permutation to @var{list} sorts it in descending order.
Operations pretending lists are sets.
@anchor{-union}
-@defun -union (list list2)
-Return a new list of all elements appearing in either @var{list1} or
@var{list2}.
-Equality is defined by the value of @code{-compare-fn} if non-@code{nil};
-otherwise @code{equal}.
+@defun -union (list1 list2)
+Return a new list of distinct elements appearing in either @var{list1} or
@var{list2}.
+
+The test for equality is done with @code{equal}, or with @code{-compare-fn}
+if that is non-@code{nil}.
@example
@group
@@ -2577,21 +2555,22 @@ otherwise @code{equal}.
@result{} (1 2 3 4 5)
@end group
@group
-(-union '(1 2 3 4) ())
- @result{} (1 2 3 4)
+(-union '(1 2 2 4) ())
+ @result{} (1 2 4)
@end group
@group
-(-union '(1 1 2 2) '(3 2 1))
- @result{} (1 1 2 2 3)
+(-union '(1 1 2 2) '(4 4 3 2 1))
+ @result{} (1 2 4 3)
@end group
@end example
@end defun
@anchor{-difference}
-@defun -difference (list list2)
-Return a new list with only the members of @var{list} that are not in
@var{list2}.
-The test for equality is done with @code{equal},
-or with @code{-compare-fn} if that's non-@code{nil}.
+@defun -difference (list1 list2)
+Return a new list with the distinct members of @var{list1} that are not in
@var{list2}.
+
+The test for equality is done with @code{equal}, or with @code{-compare-fn}
+if that is non-@code{nil}.
@example
@group
@@ -2610,10 +2589,11 @@ or with @code{-compare-fn} if that's non-@code{nil}.
@end defun
@anchor{-intersection}
-@defun -intersection (list list2)
-Return a new list of the elements appearing in both @var{list1} and
@var{list2}.
-Equality is defined by the value of @code{-compare-fn} if non-@code{nil};
-otherwise @code{equal}.
+@defun -intersection (list1 list2)
+Return a new list of distinct elements appearing in both @var{list1} and
@var{list2}.
+
+The test for equality is done with @code{equal}, or with @code{-compare-fn}
+if that is non-@code{nil}.
@example
@group
@@ -2625,8 +2605,8 @@ otherwise @code{equal}.
@result{} ()
@end group
@group
-(-intersection '(1 2 3 4) '(3 4 5 6))
- @result{} (3 4)
+(-intersection '(1 2 2 3) '(4 3 3 2))
+ @result{} (2 3)
@end group
@end example
@end defun
@@ -2669,11 +2649,12 @@ Return the permutations of @var{list}.
@anchor{-distinct}
@defun -distinct (list)
-Return a new list with all duplicates removed.
-The test for equality is done with @code{equal},
-or with @code{-compare-fn} if that's non-@code{nil}.
+Return a copy of @var{list} with all duplicate elements removed.
+
+The test for equality is done with @code{equal}, or with @code{-compare-fn}
+if that is non-@code{nil}.
-Alias: @code{-uniq}
+Alias: @code{-uniq}.
@example
@group
@@ -2681,8 +2662,8 @@ Alias: @code{-uniq}
@result{} ()
@end group
@group
-(-distinct '(1 2 2 4))
- @result{} (1 2 4)
+(-distinct '(1 1 2 3 3))
+ @result{} (1 2 3)
@end group
@group
(-distinct '(t t t))
@@ -2691,6 +2672,33 @@ Alias: @code{-uniq}
@end example
@end defun
+@anchor{-same-items?}
+@defun -same-items? (list1 list2)
+Return non-@code{nil} if @var{list1} and @var{list2} have the same distinct
elements.
+
+The order of the elements in the lists does not matter. The
+lists may be of different lengths, i.e., contain duplicate
+elements. The test for equality is done with @code{equal}, or with
+@code{-compare-fn} if that is non-@code{nil}.
+
+Alias: @code{-same-items-p}.
+
+@example
+@group
+(-same-items? '(1 2 3) '(1 2 3))
+ @result{} t
+@end group
+@group
+(-same-items? '(1 1 2 3) '(3 3 2 1))
+ @result{} t
+@end group
+@group
+(-same-items? '(1 2 3) '(1 2 3 4))
+ @result{} nil
+@end group
+@end example
+@end defun
+
@node Other list operations
@section Other list operations
diff --git a/dev/examples.el b/dev/examples.el
index 9231c739c5..086dc15777 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -27,6 +27,7 @@
(require 'dash)
(require 'dash-defs "dev/dash-defs")
+(require 'ert)
(eval-when-compile
;; TODO: Emacs 24.3 first introduced `setf', so remove this when
@@ -771,18 +772,21 @@ value rather than consuming a list to produce a single
value."
(--only-some? (> it 2) '(1 2 3)) => t)
(defexamples -contains?
- (-contains? '(1 2 3) 1) => t
- (-contains? '(1 2 3) 2) => t
- (-contains? '(1 2 3) 4) => nil
- (-contains? '() 1) => nil
- (-contains? '() '()) => nil)
-
- (defexamples -same-items?
- (-same-items? '(1 2 3) '(1 2 3)) => t
- (-same-items? '(1 2 3) '(3 2 1)) => t
- (-same-items? '(1 2 3) '(1 2 3 4)) => nil
- (-same-items? '((a . 1) (b . 2)) '((a . 1) (b . 2))) => t
- (-same-items? '(1 2 3) '(2 3 1)) => t)
+ (-contains? '(1 2 3) 1) => '(1 2 3)
+ (-contains? '(1 2 3) 2) => '(2 3)
+ (-contains? '(1 2 3) 4) => '()
+ (-contains? '() 1) => '()
+ (-contains? '() '()) => '()
+ (-contains? `(,(string ?a)) "a") => '("a")
+ (-contains? '(a a) 'a) => '(a a)
+ (-contains? '(b b a a) 'a) => '(a a)
+ (-contains? '(a a b b) 'a) => '(a a b b)
+ (let ((-compare-fn #'eq)) (-contains? `(,(string ?a)) "a")) => '()
+ (let ((-compare-fn #'string=)) (-contains? '(a) 'b)) => '()
+ (let ((-compare-fn #'string=)) (-contains? '(a) "a")) => '(a)
+ (let ((-compare-fn #'string=)) (-contains? '("a") 'a)) => '("a")
+ (let ((-compare-fn #'string=)) (-contains? '(a "a") 'a)) => '(a "a")
+ (let ((-compare-fn #'string=)) (-contains? '("a" a) 'a)) => '("a" a))
(defexamples -is-prefix?
(-is-prefix? '(1 2 3) '(1 2 3 4 5)) => t
@@ -1112,18 +1116,77 @@ related predicates."
(defexamples -union
(-union '(1 2 3) '(3 4 5)) => '(1 2 3 4 5)
- (-union '(1 2 3 4) '()) => '(1 2 3 4)
- (-union '(1 1 2 2) '(3 2 1)) => '(1 1 2 2 3))
+ (-union '(1 2 2 4) '()) => '(1 2 4)
+ (-union '(1 1 2 2) '(4 4 3 2 1)) => '(1 2 4 3)
+ (-union '() '()) => '()
+ (-union '() '(a)) => '(a)
+ (-union '() '(a a)) => '(a)
+ (-union '() '(a a b)) => '(a b)
+ (-union '() '(a b a)) => '(a b)
+ (-union '() '(b a a)) => '(b a)
+ (-union '(a) '()) => '(a)
+ (-union '(a a) '()) => '(a)
+ (-union '(a a b) '()) => '(a b)
+ (-union '(a b a) '()) => '(a b)
+ (-union '(b a a) '()) => '(b a)
+ (let ((dash--short-list-length 0)) (-union '() '(a))) => '(a)
+ (let ((dash--short-list-length 0)) (-union '() '(a a))) => '(a)
+ (let ((dash--short-list-length 0)) (-union '() '(a a b))) => '(a b)
+ (let ((dash--short-list-length 0)) (-union '() '(a b a))) => '(a b)
+ (let ((dash--short-list-length 0)) (-union '() '(b a a))) => '(b a)
+ (let ((dash--short-list-length 0)) (-union '(a) '())) => '(a)
+ (let ((dash--short-list-length 0)) (-union '(a a) '())) => '(a)
+ (let ((dash--short-list-length 0)) (-union '(a a b) '())) => '(a b)
+ (let ((dash--short-list-length 0)) (-union '(a b a) '())) => '(a b)
+ (let ((dash--short-list-length 0)) (-union '(b a a) '())) => '(b a)
+ (let ((dash--short-list-length 0)) (-union '(a a b c c) '(e e d c b)))
+ => '(a b c e d)
+ (let ((-compare-fn #'string=)) (-union '(a "b") '("a" b))) => '(a "b")
+ (let ((-compare-fn #'string=)) (-union '("a" b) '(a "b"))) => '("a" b))
(defexamples -difference
(-difference '() '()) => '()
(-difference '(1 2 3) '(4 5 6)) => '(1 2 3)
- (-difference '(1 2 3 4) '(3 4 5 6)) => '(1 2))
+ (-difference '(1 2 3 4) '(3 4 5 6)) => '(1 2)
+ (-difference '() '(a)) => '()
+ (-difference '(a) '()) => '(a)
+ (-difference '(a) '(a)) => '()
+ (-difference '(a a) '()) => '(a)
+ (-difference '(a a) '(a)) => '()
+ (-difference '(a a) '(a a)) => '()
+ (-difference '(a a) '(b)) => '(a)
+ (-difference '(a b c c d a) '(c c b)) => '(a d)
+ (let ((dash--short-list-length 0)) (-difference '(a) '(a))) => '()
+ (let ((dash--short-list-length 0)) (-difference '(a a) '(a))) => '()
+ (let ((dash--short-list-length 0)) (-difference '(a a) '(a a))) => '()
+ (let ((dash--short-list-length 0)) (-difference '(a a) '(b))) => '(a)
+ (let ((dash--short-list-length 0)) (-difference '(a b c c d a) '(c c b)))
+ => '(a d)
+ (let ((-compare-fn #'string=)) (-difference '(a) '("a"))) => '()
+ (let ((-compare-fn #'string=)) (-difference '("a") '(a))) => '()
+ (let ((-compare-fn #'string=)) (-difference '(a "a") '(a))) => '()
+ (let ((-compare-fn #'string=)) (-difference '(a "a") '(b))) => '(a)
+ (let ((-compare-fn #'string=)) (-difference '("a") '(a a))) => '())
(defexamples -intersection
(-intersection '() '()) => '()
(-intersection '(1 2 3) '(4 5 6)) => '()
- (-intersection '(1 2 3 4) '(3 4 5 6)) => '(3 4))
+ (-intersection '(1 2 2 3) '(4 3 3 2)) => '(2 3)
+ (-intersection '() '(a)) => '()
+ (-intersection '(a) '()) => '()
+ (-intersection '(a) '(a)) => '(a)
+ (-intersection '(a a b) '(b a)) => '(a b)
+ (-intersection '(a b) '(b a a)) => '(a b)
+ (let ((dash--short-list-length 0)) (-intersection '(a) '(b))) => '()
+ (let ((dash--short-list-length 0)) (-intersection '(a) '(a))) => '(a)
+ (let ((dash--short-list-length 0)) (-intersection '(a a b) '(b b a)))
+ => '(a b)
+ (let ((dash--short-list-length 0)) (-intersection '(a a b) '(b a)))
+ => '(a b)
+ (let ((dash--short-list-length 0)) (-intersection '(a b) '(b a a)))
+ => '(a b)
+ (let ((-compare-fn #'string=)) (-intersection '(a) '("a")) => '(a))
+ (let ((-compare-fn #'string=)) (-intersection '("a") '(a)) => '("a")))
(defexamples -powerset
(-powerset '()) => '(nil)
@@ -1136,19 +1199,73 @@ related predicates."
(defexamples -distinct
(-distinct '()) => '()
- (-distinct '(1 2 2 4)) => '(1 2 4)
+ (-distinct '(1 1 2 3 3)) => '(1 2 3)
(-distinct '(t t t)) => '(t)
(-distinct '(nil nil nil)) => '(nil)
- (let ((-compare-fn nil))
- (-distinct '((1) (2) (1) (1)))) => '((1) (2))
- (let ((-compare-fn #'eq))
- (-distinct '((1) (2) (1) (1)))) => '((1) (2) (1) (1))
- (let ((-compare-fn #'eq))
- (-distinct '(:a :b :a :a))) => '(:a :b)
- (let ((-compare-fn #'eql))
- (-distinct '(2.1 3.1 2.1 2.1))) => '(2.1 3.1)
+ (-uniq '((1) (2) (1) (1))) => '((1) (2))
+ (let ((-compare-fn #'eq)) (-uniq '((1) (2) (1) (1)))) => '((1) (2) (1) (1))
+ (let ((-compare-fn #'eq)) (-uniq '(:a :b :a :a))) => '(:a :b)
+ (let ((-compare-fn #'eql)) (-uniq '(2.1 3.1 2.1 2.1))) => '(2.1 3.1)
(let ((-compare-fn #'string=))
- (-distinct '(dash "dash" "ash" "cash" "bash"))) => '(dash "ash" "cash"
"bash")))
+ (-uniq '(dash "dash" "ash" "cash" "bash")))
+ => '(dash "ash" "cash" "bash")
+ (let ((-compare-fn #'string=)) (-uniq '(a))) => '(a)
+ (let ((-compare-fn #'string=)) (-uniq '(a a))) => '(a)
+ (let ((-compare-fn #'string=)) (-uniq '(a b))) => '(a b)
+ (let ((-compare-fn #'string=)) (-uniq '(b a))) => '(b a)
+ (let ((-compare-fn #'string=)) (-uniq '(a "a"))) => '(a)
+ (let ((-compare-fn #'string=)) (-uniq '("a" a))) => '("a")
+ (let ((dash--short-list-length 0)) (-uniq '(a))) => '(a)
+ (let ((dash--short-list-length 0)) (-uniq '(a b))) => '(a b)
+ (let ((dash--short-list-length 0)) (-uniq '(b a))) => '(b a)
+ (let ((dash--short-list-length 0)) (-uniq '(a a))) => '(a)
+ (let ((dash--short-list-length 0)) (-uniq '(a a b))) => '(a b)
+ (let ((dash--short-list-length 0)) (-uniq '(a b a))) => '(a b)
+ (let ((dash--short-list-length 0)) (-uniq '(b a a))) => '(b a)
+ (let ((dash--short-list-length 0)
+ (-compare-fn #'eq))
+ (-uniq (list (string ?a) (string ?a))))
+ => '("a" "a")
+ (let ((dash--short-list-length 0)
+ (-compare-fn #'eq)
+ (a (string ?a)))
+ (-uniq (list a a)))
+ => '("a"))
+
+ (defexamples -same-items?
+ (-same-items? '(1 2 3) '(1 2 3)) => t
+ (-same-items? '(1 1 2 3) '(3 3 2 1)) => t
+ (-same-items? '(1 2 3) '(1 2 3 4)) => nil
+ (-same-items? '((a . 1) (b . 2)) '((a . 1) (b . 2))) => t
+ (-same-items? '() '()) => t
+ (-same-items? '() '(a)) => nil
+ (-same-items? '(a) '()) => nil
+ (-same-items? '(a) '(a)) => t
+ (-same-items? '(a) '(b)) => nil
+ (-same-items? '(a) '(a a)) => t
+ (-same-items? '(b) '(a a)) => nil
+ (-same-items? '(a) '(a b)) => nil
+ (-same-items? '(a a) '(a)) => t
+ (-same-items? '(a a) '(b)) => nil
+ (-same-items? '(a a) '(a b)) => nil
+ (-same-items? '(a b) '(a)) => nil
+ (-same-items? '(a b) '(a a)) => nil
+ (-same-items? '(a a) '(a a)) => t
+ (-same-items? '(a a b) '(b b a a)) => t
+ (-same-items? '(b b a a) '(a a b)) => t
+ (let ((dash--short-list-length 0)) (-same-items? '(a) '(a))) => t
+ (let ((dash--short-list-length 0)) (-same-items? '(a) '(b))) => nil
+ (let ((dash--short-list-length 0)) (-same-items? '(a) '(a a))) => t
+ (let ((dash--short-list-length 0)) (-same-items? '(b) '(a a))) => nil
+ (let ((dash--short-list-length 0)) (-same-items? '(a) '(a b))) => nil
+ (let ((dash--short-list-length 0)) (-same-items? '(a a) '(a))) => t
+ (let ((dash--short-list-length 0)) (-same-items? '(a a) '(b))) => nil
+ (let ((dash--short-list-length 0)) (-same-items? '(a a) '(a b))) => nil
+ (let ((dash--short-list-length 0)) (-same-items? '(a b) '(a))) => nil
+ (let ((dash--short-list-length 0)) (-same-items? '(a b) '(a a))) => nil
+ (let ((dash--short-list-length 0)) (-same-items? '(a a) '(a a))) => t
+ (let ((dash--short-list-length 0)) (-same-items? '(a a b) '(b b a a))) => t
+ (let ((dash--short-list-length 0)) (-same-items? '(b b a a) '(a a b))) =>
t))
(def-example-group "Other list operations"
"Other list functions not fit to be classified elsewhere."
@@ -2137,4 +2254,47 @@ or readability."
(equal (funcall (-compose (-prodfn f g) (-prodfn ff gg)) input3)
(funcall (-prodfn (-compose f ff) (-compose g gg))
input3)))) => t))
+(ert-deftest dash--member-fn ()
+ "Test `dash--member-fn'."
+ (dolist (cmp '(nil equal))
+ (let ((-compare-fn cmp))
+ (should (eq (dash--member-fn) #'member))))
+ (let ((-compare-fn #'eq))
+ (should (eq (dash--member-fn) #'memq)))
+ (let ((-compare-fn #'eql))
+ (should (eq (dash--member-fn) #'memql)))
+ (let* ((-compare-fn #'string=)
+ (member (dash--member-fn)))
+ (should-not (memq member '(member memq memql)))
+ (should-not (funcall member "foo" ()))
+ (should-not (funcall member "foo" '(bar)))
+ (should (equal (funcall member "foo" '(foo bar)) '(foo bar)))
+ (should (equal (funcall member "foo" '(bar foo)) '(foo)))))
+
+(ert-deftest dash--hash-test-fn ()
+ "Test `dash--hash-test-fn'."
+ (let ((-compare-fn nil))
+ (should (eq (dash--hash-test-fn) #'equal)))
+ (dolist (cmp '(equal eq eql))
+ (let ((-compare-fn cmp))
+ (should (eq (dash--hash-test-fn) cmp))))
+ (let ((-compare-fn #'string=))
+ (should-not (dash--hash-test-fn))))
+
+(ert-deftest dash--size+ ()
+ "Test `dash--size+'."
+ (dotimes (a 3)
+ (dotimes (b 3)
+ (should (= (dash--size+ a b) (+ a b)))))
+ (should (= (dash--size+ (- most-positive-fixnum 10) 5)
+ (- most-positive-fixnum 5)))
+ (should (= (dash--size+ (1- most-positive-fixnum) 0)
+ (1- most-positive-fixnum)))
+ (dotimes (i 2)
+ (should (= (dash--size+ (1- most-positive-fixnum) (1+ i))
+ most-positive-fixnum)))
+ (dotimes (i 3)
+ (should (= (dash--size+ most-positive-fixnum i)
+ most-positive-fixnum))))
+
;;; examples.el ends here
