2019-10-09 13:13:56 +02:00
|
|
|
;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*-
|
2020-09-01 11:17:43 +02:00
|
|
|
|
2019-10-09 13:13:56 +02:00
|
|
|
;; Author: William Carroll <wpcarro@gmail.com>
|
2020-09-01 11:17:43 +02:00
|
|
|
;; Version: 0.0.1
|
|
|
|
;; Package-Requires: ((emacs "24.3"))
|
2019-10-09 13:13:56 +02:00
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
;; The set data structure is a collection that deduplicates its elements.
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
2022-07-29 05:29:07 +02:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Dependencies
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(require 'cl-lib)
|
|
|
|
(require 'dash)
|
2019-10-09 13:13:56 +02:00
|
|
|
(require 'ht) ;; friendlier API for hash-tables
|
2020-01-08 16:25:00 +01:00
|
|
|
(require 'struct)
|
2019-10-09 13:13:56 +02:00
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; 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)
|
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-from-list (xs)
|
2019-10-09 13:13:56 +02:00
|
|
|
"Create a new set from the list XS."
|
|
|
|
(make-set :xs (->> xs
|
2022-07-29 05:29:07 +02:00
|
|
|
(-map (lambda (x) (cons x nil)))
|
2019-10-09 13:13:56 +02:00
|
|
|
ht-from-alist)))
|
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-new (&rest args)
|
2019-10-09 13:13:56 +02:00
|
|
|
"Create a new set from ARGS."
|
2020-09-01 11:17:43 +02:00
|
|
|
(set-from-list args))
|
2019-10-09 13:13:56 +02:00
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-to-list (xs)
|
2019-10-09 13:13:56 +02:00
|
|
|
"Map set XS into a list."
|
|
|
|
(->> xs
|
|
|
|
set-xs
|
|
|
|
ht-keys))
|
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-add (x xs)
|
2019-10-09 13:13:56 +02:00
|
|
|
"Add X to set XS."
|
2020-09-01 00:28:47 +02:00
|
|
|
(struct-update set
|
2019-10-09 13:13:56 +02:00
|
|
|
xs
|
|
|
|
(lambda (table)
|
|
|
|
(let ((table-copy (ht-copy table)))
|
2019-12-24 13:31:12 +01:00
|
|
|
(ht-set table-copy x nil)
|
2019-10-09 13:13:56 +02:00
|
|
|
table-copy))
|
|
|
|
xs))
|
|
|
|
|
2019-12-24 13:31:12 +01:00
|
|
|
;; TODO: Ensure all `*/reduce' functions share the same API.
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-reduce (acc f xs)
|
2019-12-24 13:31:12 +01:00
|
|
|
"Return a new set by calling F on each element of XS and ACC."
|
|
|
|
(->> xs
|
2020-09-01 11:17:43 +02:00
|
|
|
set-to-list
|
2022-07-29 05:29:07 +02:00
|
|
|
(-reduce-from (lambda (acc x) (funcall f x acc)) acc)))
|
2019-12-24 13:31:12 +01:00
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-intersection (a b)
|
2020-09-01 17:27:42 +02:00
|
|
|
"Return the set intersection between A and B."
|
2020-09-01 11:17:43 +02:00
|
|
|
(set-reduce (set-new)
|
2019-12-24 13:31:12 +01:00
|
|
|
(lambda (x acc)
|
2020-09-01 11:17:43 +02:00
|
|
|
(if (set-contains? x b)
|
|
|
|
(set-add x acc)
|
2019-12-24 13:31:12 +01:00
|
|
|
acc))
|
|
|
|
a))
|
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-count (xs)
|
2019-10-09 13:13:56 +02:00
|
|
|
"Return the number of elements in XS."
|
|
|
|
(->> xs
|
|
|
|
set-xs
|
|
|
|
ht-size))
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Predicates
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-empty? (xs)
|
2019-10-09 13:13:56 +02:00
|
|
|
"Return t if XS has no elements in it."
|
2020-09-01 11:17:43 +02:00
|
|
|
(= 0 (set-count xs)))
|
2019-10-09 13:13:56 +02:00
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-contains? (x xs)
|
2019-10-09 13:13:56 +02:00
|
|
|
"Return t if set XS has X."
|
|
|
|
(ht-contains? (set-xs xs) x))
|
|
|
|
|
2019-12-24 13:31:12 +01:00
|
|
|
;; TODO: Prefer using `ht.el' functions for this.
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-equal? (a b)
|
2019-12-24 13:31:12 +01:00
|
|
|
"Return t if A and B share the name members."
|
|
|
|
(ht-equal? (set-xs a)
|
|
|
|
(set-xs b)))
|
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-distinct? (a b)
|
2020-09-01 17:27:42 +02:00
|
|
|
"Return t if A and B have no shared members."
|
2020-09-01 11:17:43 +02:00
|
|
|
(set-empty? (set-intersection a b)))
|
2019-12-24 13:31:12 +01:00
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-superset? (a b)
|
2020-09-01 17:27:42 +02:00
|
|
|
"Return t if A has all of the members of B."
|
2020-01-23 15:51:50 +01:00
|
|
|
(->> b
|
2020-09-01 11:17:43 +02:00
|
|
|
set-to-list
|
2022-07-29 05:29:07 +02:00
|
|
|
(-all? (lambda (x) (set-contains? x a)))))
|
2020-01-23 15:51:50 +01:00
|
|
|
|
2020-09-01 11:17:43 +02:00
|
|
|
(defun set-subset? (a b)
|
2020-01-23 15:51:50 +01:00
|
|
|
"Return t if each member of set A is present in set B."
|
2020-09-01 11:17:43 +02:00
|
|
|
(set-superset? b a))
|
2020-01-23 15:51:50 +01:00
|
|
|
|
2019-10-09 13:13:56 +02:00
|
|
|
(provide 'set)
|
|
|
|
;;; set.el ends here
|