dev/test-connected-components.lisp

   1 (in-package metabang.graph)
   2
   3 (deftestsuite test-connected-component ()
   4   ())
   5
   6 ;;; ---------------------------------------------------------------------------
   7
   8 (defun make-connected-component-graph-1 ()
   9   (let ((g (make-container 'graph-container)))
  10     (loop for label in '(wk-6-0 wp-5-1 wp-1-2 wp-2-3 wb-1-1
  11                          wp-4-4 bp-5-6 bk-6-5 bb-5-7 bp-2-4
  12                          bp-2-6 bp-1-5) do
  13           (add-vertex g label))
  14     (loop for (source target) in '((wk-6-0 wp-5-1)
  15                                    (wp-1-2 wp-2-3)
  16                                    (wb-1-1 wp-4-4)
  17                                    (bp-5-6 bk-6-5)
  18                                    (bk-6-5 bb-5-7)
  19                                    (bb-5-7 bp-2-4)
  20                                    (bp-2-6 bp-1-5)
  21                                    (bp-1-5 bp-2-4)) do
  22           (add-edge-between-vertexes g source target :edge-type :directed
  23                                      :value :defend))
  24     (loop for (source target) in '((bk-6-5 wp-4-4)) do
  25           (add-edge-between-vertexes g source target :edge-type :directed
  26                                      :value :attack))
  27     (loop for (source target) in '((wp-2-3 bp-2-4)) do
  28           (add-edge-between-vertexes g source target :edge-type :undirected))
  29     g))
  30
  31 ;;; ---------------------------------------------------------------------------
  32
  33 (addtest (test-connected-component)
  34   test-1
  35   (let ((g (make-connected-component-graph-1)))
  36     (ensure-same
  37      (mapcar #'size (find-connected-components g)) '(2 10) :test 'set-equal)))
  38
  39 ;;; ---------------------------------------------------------------------------
  40
  41 (addtest (test-connected-component)
  42   test-connected-component-count-1
  43   (let ((g (make-connected-component-graph-1)))
  44     (ensure-same (connected-component-count g) 2 :test '=)))