;;;; An implementation of the Union Find algorithm
;;;; -- Matthew Danish <mdanish@andrew.cmu.edu>
;;;;
;;;; Implements union-by-height (aka rank) and path compression.
;;;;
;;;; Typical usage consists of creating your own graph or whatnot and
;;;; adding a slot of type EQUIV-CLASS to each node.  Then you can
;;;; COMPARE and COMBINE the EQUIV-CLASS slots as you wish.  Use
;;;; MAKE-EQUIV-CLASS to instantiate a new EQUIV-CLASS object.

(defpackage "UNION-FIND"
	    (:nicknames "CL-UF")
	    (:use "COMMON-LISP")
	    (:export "EQUIV-CLASS"
		     "MAKE-EQUIV-CLASS"
		     "COMPARE"
		     "COMBINE"))

(in-package :UNION-FIND)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defclass equiv-class ()
    ((symlink
      :reader symlink
      :writer set-symlink
      :initform nil)
     (height
      :reader height
      :writer set-height
      :initform 0))
    (:documentation
     "This class performs two functions: it represents the 'equivalence class'
an object belongs to, and if the object becomes part of another
equivalence class, it then stores the pointer to that other equivalence
class (or rather, other instance of equiv-class)")))
     


(defgeneric compress (t)
  (:documentation
   "Internal function to perform path-compression if necessary"))

(defgeneric combine (t t)
  (:documentation
   "The 'UNION' operation, between two equiv-class type objects.  Puts the
two in the same equivalence class."))

(defgeneric compare (t t)
  (:documentation
   "The 'FIND' operation, between two equiv-class objects.  Checks to see
if they are in the same equivalence class."))


(defun make-equiv-class ()
  "Create an equiv-class instance"
  (make-instance 'equiv-class))

(defmethod compress ((uf equiv-class))
  (cond
   ((symlink uf)
    (set-symlink (compress (symlink uf)) 
		 uf)
    (symlink uf))
   (t
    uf)))

(defmethod combine ((uf1 equiv-class) (uf2 equiv-class))
  (multiple-value-bind 
      (pred c1 c2) (compare uf1 uf2)
   
   (unless pred
     (cond 
      ((> (height c1) (height c2))
       (set-symlink c1 c2))
      ((< (height c1) (height c2))
       (set-symlink c2 c1))
      (t
       (set-height (1+ (height c1))
		   c2)
       (set-symlink c2 c1))))))

(defmethod compare ((uf1 equiv-class) (uf2 equiv-class))
  (let ((c1 (compress uf1))
	(c2 (compress uf2)))
    (values (eq c1 c2) c1 c2)))