disjoint-set
Description
An imperative implementation of Disjoint Sets based on Scheme vectors and their indexes. The elements of the Universe set are the indexes of the vector rather than defined explicitly by the user. A higher-level, more generic and dynamic implementation shouldn't be hard to implement based on this library.
A functional implementation should also be easy to create simply by replacing the Scheme vectors by functional arrays.
Author
siiky
Repository
https://git.sr.ht/~siiky/disjoint-set.git
Requirements
This egg has no dependencies.
API
Disjoint set
[procedure] (make-disjoint-set nelems) -> dsCreates a disjoint set object with a Universe set of nelems elements.
[procedure] (disjoint-set? obj) -> booleanReturns #t if obj is a disjoint set, and #f otherwise.
Disjoint set objects are not of a disjoint Scheme type, so other type predicates may return #t for disjoint set objects.
[procedure] (disjoint-set-size ds) -> fixnumReturns the number of subsets in ds.
[procedure] (disjoint-set-find! ds xi) -> (values ri r ds)Finds the root element of the subset xi belongs to. Returns three values, ri, r, and ds, which are the index of the root, the root itself, and the mutated ds, respectively.
This procedure may mutate ds if it's not already at its optimal state.
It is an error if (> xi nelems), with nelems the number of elements of the Universe set of ds.
[procedure] (disjoint-set-unite! ds xi yi) -> dsUnites the subsets that xi and yi belong to in ds.
This procedure may mutate ds if it's not already at its optimal state, and (not (= xi yi)).
It is an error if (> xi nelems) or (> yi nelems), with nelems the number of elements of the Universe set of ds.
[procedure] (disjoint-set-ref ds xi) -> xFetches the element of ds at index xi.
It is an error if (> xi nelems), with nelems the number of elements of the Universe set of ds.
[procedure] (disjoint-set-set! ds xi x) -> dsSets the element of index xi to x, and returns the ds
It is an error if (> xi nelems), with nelems the number of elements of the Universe set of ds.
Use with care! It is an error to use this procedure in such a way that the mutated ds object has fewer subsets than the original ds object without also updating the size field with disjoint-set-size-set!.
[procedure] (disjoint-set-size-set! ds size) -> dsSets the size of ds to size.
Use with care! This procedure should generally only be used along with a disjoint-set-set! (or in case of bugs in the library).
Elements
[procedure] (make-disjoint-set-root rank) -> rootCreates a root object. rank is a fixnum.
When uniting two subsets, the root of higher rank will be the chosen as the root of the union. A root loses its rank when it is "demoted" to a normal because it's no longer necessary.
[procedure] (make-disjoint-set-node parenti) -> nodeCreates a node object. parenti is the index of a parent node.
It is an error if (> parenti nelems), with nelems the number of elements of the Universe set of the disjoint set object this node will be used with.
[procedure] (disjoint-set-root? obj) -> boolean[procedure] (disjoint-set-node? obj) -> boolean
Returns #t if obj is a root/node, and #f otherwise.
Root/Node objects are not of a disjoint Scheme type, so other type predicates may return #t for root/node objects.
[procedure] (disjoint-set-root-rank root) -> fixnumReturns root's rank.
It is an error if root is not a root object.
[procedure] (disjoint-set-node-parenti node) -> fixnumReturns the index of node's parent.
It is an error if node is not a node object.
Examples
To check if two elements belong to the same subset just compare their roots:
(= (disjoint-set-find! ds xi) (disjoint-set-find! ds yi))
A more complete example, stolen and adapted from this Snow library:
(import (srfi 1) (chicken sort) disjoint-set) (define (kruskal graph) (let ((result '()) (nelems (length (delete-duplicates (append (map car graph) (map cadr graph)) eq?)))) (print nelems) (let ((ds (make-disjoint-set nelems))) (print "Initial disjoint-set: " ds) (let loop ((links (sort graph (lambda (a b) (< (caddr a) (caddr b)))))) (when (and (not (null? links)) (> (disjoint-set-size ds) 1)) (let ((link (car links))) (unless (= (disjoint-set-find! ds (car link)) (disjoint-set-find! ds (cadr link))) (set! result (cons link result)) (disjoint-set-unite! ds (car link) (cadr link)))) (loop (cdr links)))) (print "Final disjoint-set: " ds)) (reverse result))) (let* ((graph '((0 1 3) (0 4 1) (1 2 5) (1 4 4) (2 3 2) (2 4 6) (3 4 7))) (res (kruskal graph))) (print "MST has " (length res)" links") (for-each (cute print " : " <>) res) (print "Total length: " (fold + 0 (map caddr res)))) ; Prints to stdout: ;> 5 ;> Initial disjoint-set: #(disjoint-set 5 #((0) (0) (0) (0) (0))) ;> Final disjoint-set: #(disjoint-set 1 #((2) 0 0 2 0)) ;> MST has 4 links ;> : (0 4 1) ;> : (2 3 2) ;> : (0 1 3) ;> : (1 2 5) ;> Total length: 11
License
This is free and unencumbered software released into the public domain. Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software, either in source code form or as a compiled binary, for any purpose, commercial or non-commercial, and by any means. In jurisdictions that recognize copyright laws, the author or authors of this software dedicate any and all copyright interest in the software to the public domain. We make this dedication for the benefit of the public at large and to the detriment of our heirs and successors. We intend this dedication to be an overt act of relinquishment in perpetuity of all present and future rights to this software under copyright law. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. For more information, please refer to <http://unlicense.org>
Version History
0.1.0 (2023/02/25)
- Initial release.