(defun graph-equal (g1 g2 &key (test #'eql)) (let ((elist1 (graph-edge-list g1)) (elist2 (graph-edge-list g2))) (set-equal elist1 elist2 :test (edge-equal-function test)))) (defun edge-equal-function (&optional (test #'eql)) #'(lambda (e1 e2) (set-equal e1 e2 :test (vertex-equal-function test)))) (defun vertex-equal-function (&optional (test #'eql)) #'(lambda (v1 v2) (funcall test v1 v2)))この定義では,頂点がシンボルで表現されているものだけでなくて,行列や文 字列などのデータであってもよいように:testキーワードを使えるように配慮 してあります. 頂点の等号,辺の等号を調べる関数をそれぞれ:testキーワードで 渡される関数から作ります.
<cl> (setq g1 '(elist ((a b) (b c) (c a)))) (ELIST ((A B) (B C) (C A))) <cl> (setq g2 '(alist (a b c) (b c a) (c a b))) (ALIST (A B C) (B C A) (C A B)) <cl> (setq g3 '(elist ((a b) (b c) (c d)))) (ELIST ((A B) (B C) (C D))) <cl> (graph-equal g1 g2) T <cl> (graph-equal g3 g1) NIL
<cl> (setq g1 '(elist (("a" "b") ("b" "c") ("c" "a")))) (ELIST (("a" "b") ("b" "c") ("c" "a"))) <cl> (setq g2 '(alist ("a" "b" "c") ("b" "a" "c") ("c" "a" "b"))) (ALIST ("a" "b" "c") ("b" "a" "c") ("c" "a" "b")) <cl> (graph-equal g1 g2) NIL <cl> (graph-equal g1 g2 :test #'string-equal) T:testに渡す関数は,上のようにこれまでに調べてきた, データの等号を調べる関数のどれでもよいわけです. これは,グラフのグラフでもよいということになるので, たとえば,
<cl> (setq g1 '(elist ((a b) (b c) (c a)))) (ELIST ((A B) (B C) (C A))) <cl> (setq g2 '(alist (a b c) (b c a) (c a b))) (ALIST (A B C) (B C A) (C A B)) <cl> (setq g3 '(amatrix #2a((nil t t) (t nil t) (t t nil)) (a b c))) (AMATRIX #2a((NIL T T) (T NIL T) (T T NIL)) (A B C)) <cl> (setq g4 '(elist ((c a) (b a) (c b)))) (ELIST ((C A) (B A) (C B))) <cl> (graph-equal g1 g4) Tというように同じグラフg1,g2,g3,g4を定義しておいて, これらのグラフのグラフgg1,gg2の等号を調べてみます.
<cl> (setq gg1 `(elist ((,g1 ,g2) (,g4 ,g2) (,g2 ,g3)))) (ELIST (((ELIST (# # #)) (ALIST (A B C) (B C A) (C A B))) ((ELIST (# # #)) (ALIST (A B C) (B C A) (C A B))) ((ALIST (A B C) (B C A) (C A B)) (AMATRIX #2a(# # #) (A B C))))) <cl> (setq gg2 `(alist (,g1 ,g2 ,g3) (,g2 ,g1 ,g3) (,g3 ,g1 ,g2))) (ALIST ((ELIST ((A B) (B C) (C A))) (ALIST (A B C) (B C A) (C A B)) (AMATRIX #2a((NIL T T) (T NIL T) (T T NIL)) (A B C))) ((ALIST (A B C) (B C A) (C A B)) (ELIST ((A B) (B C) (C A))) (AMATRIX #2a((NIL T T) (T NIL T) (T T NIL)) (A B C))) ((AMATRIX #2a((NIL T T) (T NIL T) (T T NIL)) (A B C)) (ELIST ((A B) (B C) (C A))) (ALIST (A B C) (B C A) (C A B)))) <cl> (graph-equal gg1 gg2) NIL <cl> (graph-equal gg1 gg2 :test #'equalp) NIL <cl> (graph-equal gg1 gg2 :test #'graph-equal) Tというように,:testにgraph-equalを渡すことで, グラフを要素とするグラフの等号チェックも可能となります. ここでgg1,gg2の定義にバッククオートを使いました. この定義は,以下の定義をわかりやすいように簡略化した表現です.
<cl> (setq gg1 (list 'elist (list (list g1 g2) (list g4 g2) (list g2 g3)))) <cl> (setq gg2 (list 'alist (list g1 g2 g3) (list g2 g1 g3) (list g3 g1 g2)))