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…
	
	Add table
		Add a link
		
	
		Reference in a new issue