next up previous
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))
というように,できます. たとえば,次のように差が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))
というように,範囲を変えれば同値類の結果も 変わる.

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