4.3 集合から同値類を作る関数

Next: 5 リストを変形する操作 Up: 4 例題：同値類の計算 Previous: 4.2 同値類の生成

4.3 集合から同値類を作る関数

集合に対して同値関係を与えて同値類を作る関数 equivalent-sets を考えます．


(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))

というように，できます．たとえば，次のように差が１の関係にあるもの同士を集めると全体がひとつの集合になり，差が３のものの集合に分けると３つの集合にわかれることがわかります．


> (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))

というように，範囲を変えれば同値類の結果も変わる．

generated through LaTeX2HTML. M.Inaba 平成18年5月6日