(defun equivalent-sets (set &key (test #'eql) (key #'identity)) (equivalent-sets-aux (mapcar #'list set) test key)) (defun equivalent-sets-aux (esets test key) (cond ((null esets) nil) ((eset-intersection-p (car esets) (cdr esets) test key) (equivalent-sets-aux (merge-equivalent-sets (car esets) (cdr esets) test key) test key)) (t (cons (car esets) (equivalent-sets-aux (cdr esets) test key))))) (defun eset-intersection-p (eset esets test key) (cond ((null esets) nil) ((intersection eset (car esets) :test test :key key) t) (t (eset-intersection-p eset (cdr esets) test key)))) (defun merge-equivalent-sets (eset esets test key) (cond ((null esets) nil) ((intersection eset (car esets) :test test :key key) (cons (append eset (car esets)) (cdr esets))) (t (cons (car esets) (merge-equivalent-sets eset (cdr esets) test key)))))testは同値関係を表す関数を渡すための引数です. 実行例は,以下のようになります.
> a (1 2 -2 -3 -1 3) > (equivalent-sets a :test #'(lambda (a b) (= (abs a) (abs b)))) ((2 -2) (1 -1) (-3 3)) > (equivalent-sets a :test #'= :key #'abs) ((2 -2) (1 -1) (-3 3)) > (setq b '(-3 -2 -1 0 1 2 3 2 1 0 -1 -2 -3)) (-3 -2 -1 0 1 2 3 2 1 0 ...) > (equivalent-sets b :test #'(lambda (a b) (= (abs a) (abs b)))) ((0 0) (-1 1 1 -1) (-2 2 2 -2) (-3 3 -3))たとえば,数の集合があり,奇数と偶数に分けるような手続きは,
> (setq c '(-3 -2 -1 0 1 2 3)) (-3 -2 -1 0 1 2 3) > (equivalent-sets c :test #'(lambda (a b) (= (abs (- a b)) 2))) ((2 0 -2) (3 1 -1 -3))というように,できます. たとえば,次のように差が1の関係にあるもの同士を 集めると全体がひとつの集合になり, 差が3のものの集合に分けると3つの集合にわかれることがわかります.
> (equivalent-sets c :test #'(lambda (a b) (= (abs (- a b)) 1))) ((3 2 1 0 -1 -2 -3)) > (equivalent-sets c :test #'(lambda (a b) (= (abs (- a b)) 3))) ((2 -1) (1 -2) (3 0 -3))同様に,以下のようにするとある数を法とした数の集合にわかれることが わかります.
> (equivalent-sets c :test #'(lambda (a b) (= (abs (- a b)) 4))) ((0) (3 -1) (2 -2) (1 -3)) > (equivalent-sets c :test #'(lambda (a b) (= (abs (- a b)) 5))) ((1) (0) (-1) (3 -2) (2 -3)) > (equivalent-sets c :test #'(lambda (a b) (= (abs (- a b)) 6))) ((2) (1) (0) (-1) (-2) (3 -3))testに対して,全く同じという関係ではなくて,ある範囲内で 同じというような指示をするために, 下のような nearという関数を定義してequivalent-setsを呼ぶと,
(defun near (threshold) #'(lambda (a b) (< (abs (- a b)) threshold))) > a (1 2 6 5) > (equivalent-sets a :test (near 1)) ((1) (2) (6) (5)) > (equivalent-sets a :test (near 2)) ((1 2) (6 5)) > (equivalent-sets a :test (near 5)) ((1 2 6 5))というように,範囲を変えれば同値類の結果も 変わる.