test/tests.lisp @ 5be8c89f99ce

(in-package :digraph.test)


;;;; Utils --------------------------------------------------------------------
(defmacro define-test (name &body body)
  `(test ,(symb 'test- name)
    (let ((*package* ,*package*))
      ,@body)))


(defun same (a b)
  (null (set-exclusive-or a b :test #'equal)))

(defun run-tests ()
  (1am:run))


;;;; Tests --------------------------------------------------------------------
(define-test make-digraph
  (let ((g (make-digraph)))
    (is (zerop (count-vertices g)))
    (is (same () (vertices g)))
    (is (same () (edges g)))
    (is (emptyp g)))
  (let ((g (make-digraph :initial-vertices '(a b c))))
    (is (= 3 (count-vertices g)))
    (is (same '(a b c) (vertices g)))
    (is (same () (edges g)))
    (is (not (emptyp g))))
  (let ((g (make-digraph :initial-vertices '(a b a c a a))))
    (is (= 3 (count-vertices g)))
    (is (same '(a b c) (vertices g)))
    (is (same () (edges g)))
    (is (not (emptyp g)))))

(define-test copy-digraph
  (let ((g (make-digraph :initial-vertices '(a b c)))
        (h nil))
    (insert-edge g 'a 'b)
    (is (same '(a b c) (vertices g)))
    (is (same '((a . b)) (edges g)))
    (setf h (copy-digraph g))
    (is (same '(a b c) (vertices h)))
    (is (same '((a . b)) (edges h)))
    (remove-edge h 'a 'b)
    (remove-vertex h 'c)
    (is (same '(a b) (vertices h)))
    (is (same '() (edges h)))
    ;; make sure the original didn't change
    (is (same '(a b c) (vertices g)))
    (is (same '((a . b)) (edges g)))))


(define-test roots-and-leafs
  (let ((g (make-digraph)))
    (is (same () (roots g)))
    (is (same () (leafs g)))
    (insert-vertex g 'a)
    (insert-vertex g 'b)
    (is (same '(a b) (roots g)))
    (is (same '(a b) (leafs g)))
    (insert-edge g 'a 'b)
    (is (same '(a) (roots g)))
    (is (same '(b) (leafs g)))
    (insert-edge g 'b 'a)
    (is (same () (roots g)))
    (is (same () (leafs g)))))


(define-test insert-vertex
  (let ((g (make-digraph)))
    (is (= 0 (count-vertices g)))
    (is (same '() (vertices g)))

    (insert-vertex g 'a)
    (is (= 1 (count-vertices g)))
    (is (same '(a) (vertices g)))

    (insert-vertex g 'b)
    (is (= 2 (count-vertices g)))
    (is (same '(a b) (vertices g)))

    (insert-vertex g 'a) ; dup
    (is (= 2 (count-vertices g)))
    (is (same '(a b) (vertices g)))))

(define-test insert-edge
  (let ((g (make-digraph :initial-vertices '(a b c))))
    (insert-edge g 'a 'b)
    (is (same '((a . b))
              (edges g)))

    (insert-edge g 'b 'c)
    (is (same '((a . b) (b . c))
              (edges g)))))


(define-test remove-vertex
  (let ((g (make-digraph :initial-vertices '(a b c))))
    (insert-edge g 'a 'b)
    (insert-edge g 'b 'c)
    (is (same '(a b c) (vertices g)))
    (is (same '((a . b) (b . c)) (edges g)))

    (remove-vertex g 'c)
    (is (same '(a b) (vertices g)))
    (is (same '((a . b)) (edges g)))

    (remove-vertex g 'c)
    (is (same '(a b) (vertices g)))
    (is (same '((a . b)) (edges g)))

    (remove-vertex g 'b)
    (is (same '(a) (vertices g)))
    (is (same '() (edges g)))))

(define-test remove-edge
  (let ((g (make-digraph :initial-vertices '(a b c))))
    (insert-edge g 'a 'b)
    (insert-edge g 'b 'c)
    (is (same '((a . b) (b . c)) (edges g)))

    (remove-edge g 'a 'b)
    (is (same '((b . c)) (edges g)))

    (remove-edge g 'a 'b)
    (is (same '((b . c)) (edges g)))

    (remove-edge g 'b 'c)
    (is (same '() (edges g)))))


(defun make-simple-digraph ()
  ;; a ---->  middle  ----> z <-+     orphan
  ;; ^          ^           |   |
  ;; |          |           +---+
  ;; b ---------+
  (let ((g (make-digraph :initial-vertices '(a b middle z orphan))))
    (insert-edge g 'a 'middle)
    (insert-edge g 'b 'middle)
    (insert-edge g 'b 'a)
    (insert-edge g 'middle 'z)
    (insert-edge g 'z 'z)
    g))


(define-test neighbors
  (let ((g (make-simple-digraph)))
    (is (same '(b middle) (neighbors g 'a)))
    (is (same '(a middle) (neighbors g 'b)))
    (is (same '(a b z) (neighbors g 'middle)))
    (is (same '(middle z) (neighbors g 'z)))
    (is (same '() (neighbors g 'orphan)))))

(define-test predecessors
  (let ((g (make-simple-digraph)))
    (is (same '(b) (predecessors g 'a)))
    (is (same '() (predecessors g 'b)))
    (is (same '(a b) (predecessors g 'middle)))
    (is (same '(middle z) (predecessors g 'z)))
    (is (same '() (predecessors g 'orphan)))))

(define-test successors
  (let ((g (make-simple-digraph)))
    (is (same '(middle) (successors g 'a)))
    (is (same '(a middle) (successors g 'b)))
    (is (same '(z) (successors g 'middle)))
    (is (same '(z) (successors g 'z)))
    (is (same '() (successors g 'orphan)))))


(define-test contains-vertex-p ()
  (let ((g (make-digraph :initial-vertices '(a b c))))
    (is (contains-vertex-p g 'a))
    (is (contains-vertex-p g 'b))
    (is (contains-vertex-p g 'c))

    (is (null (contains-vertex-p g 'd)))
    (insert-vertex g 'd)
    (is (contains-vertex-p g 'd))
    (remove-vertex g 'd)
    (is (null (contains-vertex-p g 'd)))))

(define-test contains-edge-p ()
  (let ((g (make-digraph :initial-vertices '(a b c))))
    (is (null (contains-edge-p g 'a 'b)))
    (is (null (contains-edge-p g 'c 'c)))

    (insert-edge g 'a 'b)
    (is (contains-edge-p g 'a 'b))
    (is (null (contains-edge-p g 'c 'c)))

    (insert-edge g 'c 'c)
    (is (contains-edge-p g 'a 'b))
    (is (contains-edge-p g 'c 'c))

    (remove-edge g 'a 'b)
    (is (null (contains-edge-p g 'a 'b)))
    (is (contains-edge-p g 'c 'c))

    (remove-edge g 'c 'c)
    (is (null (contains-edge-p g 'a 'b)))
    (is (null (contains-edge-p g 'c 'c)))))


(define-test degree
  (let ((g (make-simple-digraph)))
    (is (= 2 (degree g 'a)))
    (is (= 2 (degree g 'b)))
    (is (= 3 (degree g 'middle)))
    (is (= 2 (degree g 'z)))
    (is (= 0 (degree g 'orphan)))))

(define-test degree-in
  (let ((g (make-simple-digraph)))
    (is (= 1 (degree-in g 'a)))
    (is (= 0 (degree-in g 'b)))
    (is (= 2 (degree-in g 'middle)))
    (is (= 2 (degree-in g 'z)))
    (is (= 0 (degree g 'orphan)))))

(define-test degree-out
  (let ((g (make-simple-digraph)))
    (is (= 1 (degree-out g 'a)))
    (is (= 2 (degree-out g 'b)))
    (is (= 1 (degree-out g 'middle)))
    (is (= 1 (degree-out g 'z)))
    (is (= 0 (degree g 'orphan)))))


(define-test reachablep
  (let ((g (make-simple-digraph)))
    (is (reachablep g 'orphan 'orphan))
    (is (reachablep g 'b 'a))
    (is (reachablep g 'b 'z))
    (is (not (reachablep g 'a 'b)))
    (is (not (reachablep g 'z 'orphan)))))


(define-test abitrary-vertex
  (let ((g (make-simple-digraph)))
    (is (member (arbitrary-vertex g) '(a b middle z orphan)))
    (remove-vertex g 'b)
    (is (member (arbitrary-vertex g) '(a middle z orphan)))
    (remove-vertex g 'middle)
    (is (member (arbitrary-vertex g) '(a z orphan)))
    (remove-vertex g 'z)
    (is (member (arbitrary-vertex g) '(a orphan)))
    (remove-vertex g 'a)
    (is (member (arbitrary-vertex g) '(orphan)))
    (remove-vertex g 'orphan)
    (is (null (arbitrary-vertex g)))
    (insert-vertex g 'new)
    (is (member (arbitrary-vertex g) '(new)))))