diff --git a/disjoint-sets.lisp b/disjoint-sets.lisp index d84f5e0..80496d0 100644 --- a/disjoint-sets.lisp +++ b/disjoint-sets.lisp @@ -11,14 +11,9 @@ Said otherwise: a set is identified by the id of its root set. |# -(cl:in-package #:cl-user) +(cl:in-package #:disjoint-sets) -(defpackage #:disjoint-sets - (:use #:cl)) - -(in-package #:disjoint-sets) - -(defun make-disjoint-sets (&optional number-of-sets) +(defun make-disjoint-sets (&optional (arity 0)) "Create a set of sets represented as an array. Examples: @@ -28,17 +23,12 @@ Examples: (make-disjoint-sets 10) ;; => #(0 1 2 3 4 5 6 7 8 9) " - (let ((sets (make-array (list (or number-of-sets 0)) - :element-type 'integer - :adjustable t - :fill-pointer t))) - (when number-of-sets - (loop :for i :below number-of-sets - :do (setf (aref sets i) i))) - sets)) + (let ((sets (make-array `(,arity) :element-type 'integer + :adjustable t :fill-pointer t))) + (dotimes (i arity sets) (setf (aref sets i) i)))) (defun disjoint-sets-add (sets) - "Add a new item into its own disjoint set. Return a new id. + "Add a new item into its own disjoint set. Return the new id. Example: @@ -46,9 +36,7 @@ Example: ;; SETS is modified ...) " - (let ((new-id (length sets))) - (vector-push-extend new-id sets) - new-id)) + (vector-push-extend (length sets) sets)) (defun disjoint-sets-find (sets id) "Find the id of the set representative (the root). @@ -58,9 +46,7 @@ Example: (disjoint-sets-find sets 5) " (let ((parent (aref sets id))) - (if (= id parent) - ;; If "id" is the root, just return it. - id + (if (= id parent) id ; If `id' is the root, return it. (let ((root (disjoint-sets-find sets parent))) ;; Path compression: point directly to the root if it's not ;; already the case. @@ -68,18 +54,32 @@ Example: (setf (aref sets id) root)) root)))) -(defun disjoint-sets-union (sets id1 id2) +(defun disjoint-sets-unify (sets id1 id2) "Merge two disjoint sets. Return the set representative (the root) Example: -(disjoint-sets-union sets 1 2) -=> 4 ; SETS is modified. +(disjoint-sets-unify sets 1 2) +=> 4 ; `sets' is modified. " (let ((root1 (disjoint-sets-find sets id1)) (root2 (disjoint-sets-find sets id2))) (setf (aref sets root2) root1))) +(defun copy-disjoint-sets (sets) + "Copy a set of sets into a fresh array. + +Exmaple: +(let* ((sets (make-disjoint-sets 2)) + (copy (copy-disjoint-sets sets))) + (disjoint-sets-unify sets 0 1) + (values sets copy)) +=> #(0 0), #(0 1) +" + (make-array (length sets) :element-type 'integer + :adjustable t :fill-pointer t + :initial-contents sets)) + (defun disjoint-sets-same-set-p (sets id1 id2) "Test if 2 items are in the same set. diff --git a/package.lisp b/package.lisp index 26155ff..1059afa 100644 --- a/package.lisp +++ b/package.lisp @@ -6,5 +6,5 @@ #:make-disjoint-sets #:disjoint-sets-add #:disjoint-sets-find - #:disjoint-sets-union + #:disjoint-sets-unify #:disjoint-sets-same-set-p)) diff --git a/tests.lisp b/tests.lisp index 4a88ccf..3d4f548 100644 --- a/tests.lisp +++ b/tests.lisp @@ -31,20 +31,20 @@ (list (disjoint-sets-add sets) sets)))) -(define-test disjoint-set-union +(define-test disjoint-set-unify (is equalp #(0 1 1 3 4 5 6 7 8 1) (let ((sets (make-disjoint-sets 10))) - (disjoint-sets-union sets 1 2) - (disjoint-sets-union sets 1 9) + (disjoint-sets-unify sets 1 2) + (disjoint-sets-unify sets 1 9) sets))) (define-test disjoint-set-same-set-p (is equalp '(t t nil) (let ((sets (make-disjoint-sets 10))) - (disjoint-sets-union sets 1 2) - (disjoint-sets-union sets 1 9) + (disjoint-sets-unify sets 1 2) + (disjoint-sets-unify sets 1 9) (list (disjoint-sets-same-set-p sets 1 2) (disjoint-sets-same-set-p sets 2 9) (disjoint-sets-same-set-p sets 1 5)))))