82 lines
2.5 KiB
Common Lisp
82 lines
2.5 KiB
Common Lisp
;;;; decons/test-decons - basic tests.
|
|
|
|
(defpackage :decons/test-decons
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:actor :scopes/core/actor)
|
|
(:async :scopes/util/async)
|
|
(:asys :decons/asys)
|
|
(:mlx :decons/mlx)
|
|
(:r :decons/recurse)
|
|
(:xplore :decons/xplore)
|
|
(:t :scopes/testing))
|
|
(:export #:run)
|
|
(:import-from :scopes/testing #:deftest #:== #:!=))
|
|
|
|
(in-package :decons/test-decons)
|
|
|
|
(defun run ()
|
|
(let ((t:*test-suite* (t:test-suite "decons")))
|
|
(test-xplore)
|
|
(test-recursive)
|
|
(test-line)
|
|
(test-quad)
|
|
(test-asys)
|
|
(t:show-result)))
|
|
|
|
(deftest test-xplore ()
|
|
(== xplore:+pi+ 3.14159)
|
|
(let ((c (make-instance 'xplore:circle :radius 2.0)))
|
|
(== (xplore:area c) 12.56636))
|
|
(== (funcall (xplore:double #'1+) 7) 16)
|
|
(== (xplore:absv 7) 7)
|
|
(== (xplore:absv -7) 7)
|
|
(== (xplore:remainder 7 4) 3)
|
|
(== (xplore:scalar-p 7) t)
|
|
(== (xplore:scalar-p '(a b)) nil)
|
|
(let ((t1 (xplore:tensor '(4) '(0 1 2 3))))
|
|
(== (xplore:at t1 0) 0)
|
|
(setf (xplore:at t1 0) 5)
|
|
(== (xplore:at t1 0) 5)
|
|
(== (xplore:scalar-p t1) nil)
|
|
))
|
|
|
|
(deftest test-recursive ()
|
|
(== (r:reduce-all #'+ '(1 2 (3 4))) 10)
|
|
(== (r:reduce-1 #'+ '(1 2 (3 4))) '(1 2 7))
|
|
(== (r:call #'1+ 7) 8)
|
|
(== (r:call #'1+ '(2 3)) '(3 4))
|
|
(== (r:add 2 3) 5)
|
|
(== (r:add 3 '(4 5)) '(7 8))
|
|
(== (r:add '(2 3) '(4 5)) '(6 8)) ; not '((6 7) (7 8))
|
|
(== (r:sub '(6 7) '(4 5)) '(2 2)) ; not '((2 3) (1 2))
|
|
(== (r:sqr '(2 3 4)) '(4 9 16)))
|
|
|
|
(defvar *ds1* '((2.0 1.0 4.0 3.0)
|
|
(1.8 1.2 4.2 3.3)))
|
|
|
|
(deftest test-line ()
|
|
(let ((p1 (mlx:line 0.0))
|
|
(p2 (mlx:line 1.0))
|
|
ps1 objective)
|
|
(== (funcall p1 '(0.5 2.0)) 2.0)
|
|
(== (funcall p2 '(0.5 2.0)) 2.5)
|
|
(setf ps1 (mlx:line (car *ds1*)))
|
|
(== (funcall ps1 '(0.5 2.0)) '(3.0 2.5 4.0 3.5))
|
|
(== (funcall ps1 '(1.0 0.0)) '(2.0 1.0 4.0 3.0))
|
|
(== (mlx:default-deviation (cadr *ds1*) (funcall ps1 '(1.0 0.0)))
|
|
0.20999993) ;0.899999861)
|
|
(setf objective (funcall (mlx:l2-loss #'mlx:line) *ds1*))
|
|
(setf mlx:*obj* objective) ; for interactive experiments
|
|
(== (funcall objective '(0.0 0.0)) 33.21)
|
|
(== (mlx:nabla-xp objective '(0.0 0.0)) '(-62.999725 -21.0001))
|
|
(== (mlx:gradient-descent objective '(0.0 0.0)) '(1.0499986 3.6358833e-6))
|
|
))
|
|
|
|
(defvar *ds2* '((-1.0 0.0 1.0 2.0 3.0)
|
|
(2.55 2.1 4.35 10.2 18.25)))
|
|
|
|
(deftest test-quad ()
|
|
(let (ps2 objective)
|
|
(setf ps2 (mlx:quad (car *ds2*)))
|
|
(== (funcall ps2 '(1.0 0.0 0.0)) '(1.0 0.0 1.0 4.0 9.0))
|
|
))
|