CommonLispでUnion-Find-Treeを実装する

GWの前半は「プログラミングコンテストチャレンジブック」に捧げたのでその時の知見をブログにまとめていこうと思う。(2記事目)


問題分は以下:

動物がN匹いて、1..Nの番号が振られている.
動物はA,B,Cの3種に分けられ、A->B->C->Aの強弱関係。
次の2種類の情報が順番にk個与えられる。
xはy同じ種類
xはyを食べる
逐次処理したとき矛盾する情報はいくつ出てくるか。
ただし矛盾した情報はその場で捨て、以降考慮しないで良い。

POJ 1182 食物連鎖


Union-Find木とは,グループ分けを木構造で管理するデータ構造のこと.同じグループに属する=同じ木に属するという木構造でグループ分けをする際,以下の二点を高速で行うことができるのがメリット.

Union-Find木の解説と例題

Union-Find-TreeのCommonLisp実装:

(defparameter *N* 100)

(defparameter *parent* (make-array *N* :fill-pointer 0))
(defparameter *rank* (make-array *N* :fill-pointer 0))

(defun uftree-init ()
    (dotimes (i *N*)
        (setf (aref *parent* i) i)))

(defun uftree-root (x)
    (if (equalp x (aref *parent* x))
        x
        (setf (aref *parent* x) (uftree-root (car (aref *parent* x))))))

(defun uftree-unite (x y)
    (let ((uf-x (uftree-root x))
             (uf-y (uftree-root y)))
        (cond
            ((equalp uf-x uf-y) nil)
            ((< (aref *rank* uf-x) (aref *rank*) (setf (aref *parent* uf-x) uf-y)))
            (t (progn
                   (setf (aref *parent* uf-y) uf-x)
                   (if (equalp (aref *rank* uf-x) (aref *rank* uf-y))
                       (setf (aref *rank* uf-x) (1+ (aref *rank* uf-x))))))
            )))

(defun uftree-same (x y)
    (equalp (uftree-root x) (uftree-root y)))

実際のコード:

(defparameter *N* 100)

(defmacro info-type (info)
    `(car ,info))

(defmacro info-x (info)
    `(cadr ,info))

(defmacro info-y (info)
    `(caddr ,info))

(defmacro is-valid (info)
    `(or (< (info-x ,info) 0)
         (< *number* (info-x ,info))
         (< (info-y ,info) 0)
         (< *number* (info-y ,info))))

(defmacro is-type-1 (info)
    `(equalp (info-type ,info) 1))

(defun type-1 (accum info)
    (if (or (uftree-same (info-x info) (+ (info-y info) *number*))
            (uftree-same (info-x info) (+ (info-y info) (* 2 *number*))))
        (1+ accum)
        (progn
            (uftree-unite (info-x info) (info-y info))
            (uftree-unite (+ (info-x info) *number*) (+ (info-y info) (* 2 *number*)))
            (uftree-unite (+ (info-x info) (* 2 *number*)) (info-y info))
            accum)))

(defun type-2 (accum info)
    (if (or (uftree-same (info-x info) (info-y info))
            (uftree-same (info-x info) (+ (info-y info) (* 2 *number*))))
            (1+ accum)
            (progn
                (uftree-unite (info-x info) (+ *number* (info-y info)))
                (uftree-unite (+ (info-x info) *number*) (+ (info-y info) (* 2 *number*)))
                (uftree-unite (+ (info-x info) (* 2 *number*)) (info-y info))
                accum)))

(defun calc (accum info)
    (cond ((is-valid info) (1+ accum))
        ((is-type-1 info) (type-1 accum info))
        (t (type-2 accum info))))

(defun solve ()
    (uftree-init)
    (let ((answer (reduce #'calc *infomations* :initial-value 0)))
        (print answer)))

雑すぎるのでいつかちゃんとライブラリ化したい