shinu/snek/run-test.lisp

#!/usr/bin/sbcl --script

(load "src/load")

(setf *print-pretty* t)
;(setf *random-state* (make-random-state t))


(defmacro do-test (a &optional (b nil))
  (with-gensyms (aname bname)
    `(let ((,aname ,a)
           (,bname ,b))
      (if (funcall #'equalp ,aname ,bname)
        (format t "~%~a ~%--> ok" ',a)
        (format t "~%~a ~%--> not ok. ~%--  wanted: ~% ~a ~%--  got: ~% ~a"
                ',a
                ',b
                ,aname))
      (format t "~%---------------------------~%"))))


(defun test-utils ()
  (do-test
    (lnorm '(3 0))
    '(1.0 0.0))

  (do-test
    (lsub '(1 2) '(2 3))
    '(-1 -1))

  (do-test
    (ladd '(1 2) '(2 3))
      '(3 5))

  (do-test
    (lnsub '(1 2) '(2 10))
    '(-0.12403473 -0.99227786))

  (do-test
    (llenn '(1 2))
    5)

  (do-test
    (llen '(1 2))
    2.236068)

  (do-test
    (ldst '(1 2) '(1 3))
    1.0)

  (do-test
    (lget '(0 2) '((1 2) (3 4) (5 6)))
    '((1 2) (5 6))))


(defun test-bin ()
  (let ((edges (make-array
        (list 10 2)
        :adjustable nil
        :initial-contents
          '((1 0) (1 2) (1 5) (3 4) (10 3) (0 0) (0 0) (0 0) (0 0) (0 0)))))

    (do-test
      (-binary-edge-insert-search edges '(3 4) 5)
      4)

    (do-test
      (-binary-edge-insert-search edges '(0 0) 5)
      0)

    (do-test
      (-binary-edge-insert-search edges '(1 6) 5)
      3)

    (-insert-edge edges '(11 1) 5 5)
    (-insert-edge edges '(11 0) 5 6)

    (-remove-edge edges 0 7)

    (do-test
      edges
      (make-array
        (list 10 2)
        :adjustable nil
        :initial-contents
          '((1 2) (1 5) (3 4) (10 3) (11 0) (11 1) (0 0) (0 0) (0 0) (0 0)
            )))))


(defun test-snek (s)
  (do-test
    (insert-vert '(0 0) into s)
    0)

  (do-test
    (insert-vert '(10 0) into s)
    1)

  (do-test
    (insert-vert '(3 3) into s)
    2)

  (do-test
    (insert-vert '(4 3) into s)
    3)

  (do-test
    (insert-edge '(0 0) into s)
    nil)

  (do-test
    (insert-edge '(0 2) into s)
    '(0 2))

  (do-test
    (insert-edge '(0 1) into s)
    '(0 1))

  (do-test
    (insert-edge '(5 0) into s)
    '(0 5))

  (do-test
    (insert-edge '(1 0) into s)
    nil)

  (do-test
    (insert-edge '(5 0) into s)
    nil)

  (do-test
    (insert-edge '(0 2) into s)
    nil)

  (do-test
    (insert-edge '(5 2) into s)
    '(2 5))

  (do-test
    (insert-edge '(4 1) into s)
    '(1 4))

  (do-test
    (insert-edge '(4 0) into s)
    '(0 4))

  (do-test
    (insert-edge '(5 1) into s)
    '(1 5))

  (do-test
    (insert-edge '(100 100) into s)
    nil)

  (do-test
    (insert-edge '(3 100) into s)
    '(3 100))

  (do-test
    (insert-edge '(0 1) into s)
    nil)

  (do-test
    (insert-edge '(0 4) into s)
    nil)

  (do-test
    (insert-edge '(100 99) into s)
    '(99 100))

  (do-test
    (get-vert 2 from s)
    '(3.0 3.0))

  (do-test
    (insert-vert '(0 1) into s)
    4)

  (do-test
    (insert-edge '(0 1) into s)
    nil)

  (do-test
    (insert-vert '(0 7) into s)
    5)

  (do-test
    (get-one-ring of 5 from s)
    '((5 0) (5 1) (5 2)))

  (do-test
    (get-one-ring of 0 from s)
    '((0 1) (0 2) (0 4) (0 5)))

  (do-test
    (edge-length s '(0 4))
    1.0)

  (do-test
    (edge-length s '(2 5))
    5.0)

  (do-test
    (edge-length s '(1 2))
    7.615773))


(defun test-snek-2 (s)
  (do-test
    (insert-vert '(0 0) into s)
    0)

  (do-test
    (insert-vert '(20 20) into s)
    1)

  (do-test
    (insert-vert '(30 30) into s)
    2)

  (do-test
    (insert-vert '(40 40) into s)
    3)

  (do-test
    (insert-edge '(0 1) into s)
    '(0 1))

  (do-test
    (insert-edge '(1 2) into s)
    '(1 2))

  (do-test
    (insert-edge '(2 3) into s)
    '(2 3))

  (do-test
    (-binary-edge-insert-search (snek-edges s) '(1 2) 2)
    2)

  (do-test
    (get-one-ring of 0 from s)
    '((0 1)))

  (do-test
    (get-one-ring of 1 from s)
    '((1 0) (1 2)))

  (do-test
    (remove-edge '(0 1) from s)
    2)

  (do-test
    (remove-edge '(0 1) from s)
    0)

  (do-test
    (remove-edge '(3 2) from s)
    2)

  (do-test
    (remove-edge '(1 2) from s)
    2)

  (do-test
    (snek-num-edges s)
    0)

  (do-test
    (snek-num-verts s)
    4))


(defun test-snek-3 (s)
  (do-test
    (insert-vert '(10 10) into s)
    0)
  (do-test
    (insert-vert '(20 10) into s)
    1)

  (do-test
    (insert-vert '(30 10) into s)
    2)

  (do-test
    (insert-vert '(40 10) into s)
    3)

  (do-test
    (insert-edge '(0 1) into s)
    '(0 1))
  (do-test
    (insert-edge '(1 2) into s)
    '(1 2))
  (do-test
    (insert-edge '(2 3) into s)
    '(2 3))
  (do-test
    (insert-edge '(2 3) into s)
    nil)

  (do-test
    (-binary-edge-search
      (snek-edges s)
      '(2 3)
      (snek-num-edges s))
    4)

  (do-test
    (-binary-edge-search
      (snek-edges s)
      '(0 1)
      (snek-num-edges s))
    0)

  (do-test
    (-binary-edge-search
      (snek-edges s)
      '(10 1)
      (snek-num-edges s))
    nil))

(defun init-snek ()
  (let ((s (snek* 16)))
    (insert-vert '(0 2) into s)
    (insert-vert '(2 3) into s)
    (insert-vert '(3 4) into s)
    (insert-vert '(4 7) into s)
    (insert-vert '(5 4) into s)
    (insert-vert '(0 6) into s)
    (insert-vert '(-1 7) into s)
    (insert-vert '(0 8) into s)
    (insert-vert '(0 9) into s)
    (insert-vert '(10 1) into s)

    (insert-edge '(1 2) into s)
    (insert-edge '(0 1) into s)
    (insert-edge '(3 1) into s)
    (insert-edge '(5 6) into s)
    (insert-edge '(7 3) into s)
    s))

(defun test-snek-move ()
  (let ((s (init-snek)))
    (with-snek (s)
      (move-vert 0 '(3 3))
      (move-vert 1 '(1 3))
      (move-vert 3 '(2 3) :rel nil)
      (move-vert 2 '(3 4)))

    (do-test
      (get-vert 0 from s)
      '(3 5))

    (do-test
      (get-vert 1 from s)
      '(3 6))

    (do-test
      (get-vert 3 from s)
      '(2 3))

    (do-test
      (get-vert 2 from s)
      '(6 8))))

(defun test-snek-join ()
  (let ((s (init-snek)))
    (with-snek (s)
      (join-verts 3 3)
      (join-verts 3 3)
      (join-verts 3 6)
      (join-verts 7 1))

  (do-test
    (snek-num-edges s)
    14)

  (do-test
    (snek-edges s)
    (make-array
      (list 16 2)
      :adjustable nil
      :initial-contents
        '((0 1) (1 0) (1 2) (1 3) (1 7) (2 1) (3 1) (3 6)
          (3 7) (5 6) (6 3) (6 5) (7 1) (7 3) (0 0) (0 0))))))


(defun test-snek-append ()
  (let ((s (init-snek)))
    (with-snek (s)
      (append-edge 3 '(3 4))
      (append-edge 3 '(8 5) :rel nil)
      (append-edge 7 '(1 2)))

  (do-test
    (snek-num-edges s)
    16)

  (do-test
    (snek-num-verts s)
    13)

  (do-test
    (snek-edges s)
    (make-array
      (list 16 2)
      :adjustable nil
      :initial-contents
        '((0 1) (1 0) (1 2) (1 3) (2 1) (3 1) (3 7) (3 10)
          (3 11) (5 6) (6 5) (7 3) (7 12) (10 3) (11 3) (12 7))))

  (do-test
    (snek-verts s)
    (make-array
      (list 16 2)
      :adjustable nil
      :initial-contents
        '((0.0 2.0) (2.0 3.0) (3.0 4.0) (4.0 7.0) (5.0 4.0) (0.0 6.0)
          (-1.0 7.0) (0.0 8.0) (0.0 9.0) (10.0 1.0) (7.0 11.0) (8.0 5.0)
          (1.0 10.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))))))


(defun test-snek-split ()
  (let ((s (init-snek)))
    (with-snek (s)
      (split-edge '(1 2))
      (split-edge '(1 2))
      (split-edge '(5 6)))

  (do-test
    (snek-num-edges s)
    14)

  (do-test
    (snek-num-verts s)
    12)

  (do-test
    (snek-edges s)
    (make-array
      (list 16 2)
      :adjustable nil
      :initial-contents
        '((0 1) (1 0) (1 3) (1 10) (2 10) (3 1) (3 7) (5 11) (6 11)
          (7 3) (10 1) (10 2) (11 5) (11 6) (0 0) (0 0))))

  (do-test
    (snek-verts s)
    (make-array
      (list 16 2)
      :adjustable nil
      :initial-contents
        '((0.0 2.0) (2.0 3.0) (3.0 4.0) (4.0 7.0) (5.0 4.0) (0.0 6.0)
          (-1.0 7.0) (0.0 8.0) (0.0 9.0) (10.0 1.0) (2.5 3.5) (-0.5 6.5)
          (0.0 0.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))))))


(defun test-snek-withs ()
  (let ((s (init-snek)))
    (with-snek (s)
      (with-rnd-vert (s v)
        (append-edge v (list 3 2))
        (move-vert v (list 2 2))))

    (do-test
      (snek-num-edges s)
      12)

    (do-test
      (snek-num-verts s)
      11)

    (with-snek (s)
      (with-all-verts (s v)
        (move-vert v (list 2 2))))

    (with-snek (s)
      (with-rnd-edge (s e)
        (split-edge e)))

    (do-test
      (snek-num-edges s)
      14)

    (do-test
      (snek-num-verts s)
      12)))


(defun main ()

  (format t "~%~%~%--------------------------------------- test utils")
  (test-utils)

  (format t "~%~%~%--------------------------------------- test bin")
  (test-bin)

  (format t "~%~%~%--------------------------------------- snek 1")
  (test-snek (snek*))

  (format t "~%~%~%--------------------------------------- snek 2")
  (test-snek-2 (snek*))

  (format t "~%~%~%--------------------------------------- snek 3")
  (test-snek-3 (snek*))

  (format t "~%~%~%--------------------------------------- snek move")
  (test-snek-move)

  (format t "~%~%~%--------------------------------------- snek join")
  (test-snek-join)

  (format t "~%~%~%--------------------------------------- snek append")
  (test-snek-append)

  (format t "~%~%~%--------------------------------------- snek split")
  (test-snek-split)

  (format t "~%~%~%--------------------------------------- snek with")
  (test-snek-withs))

(main)