;;;; decons/test-decons - basic tests. (defpackage :test-decons (:use :common-lisp) (:local-nicknames (:xplore :decons/xplore) (:t :scopes/testing)) (:export #:run) (:import-from :scopes/testing #:deftest #:== #:!=)) (in-package :test-decons) (defun run () (let ((t:*test-suite* (t:test-suite "decons"))) (test-basic) (test-tensor) (test-rapply) (test-rreduce) (test-line) (t:show-result))) (deftest test-basic () (== 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) ) (deftest test-tensor () (== (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-rapply () (== (decons:rapply #'1+ 7) 8) (== (decons:rapply #'1+ '(2 3)) '(3 4)) (== (decons:radd 2 3) 5) (== (decons:radd 3 '(4 5)) '(7 8)) (== (decons:radd '(2 3) '(4 5)) '((6 7) (7 8))) ; not '(6 8) (== (decons:rsub '(6 7) '(4 5)) '((2 3) (1 2))) ) (deftest test-rreduce () (== (decons:rreduce #'+ '(1 2 (3 4))) 10) ) (defvar *ds1* '((2.0 1.0 4.0 3.0) (1.8 1.2 4.2 3.3))) (deftest test-line () (let ((p1 (decons:line 0.0)) (p2 (decons:line 1.0)) ps1 objective) (== (funcall p1 '(0.5 2.0)) 2.0) (== (funcall p2 '(0.5 2.0)) 2.5) (setf ps1 (decons: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)) (== (decons:default-deviation (cadr *ds1*) (funcall ps1 '(1.0 0.0))) 0.20999993) ;0.899999861) (setf objective (funcall (decons:l2-loss #'decons:line) *ds1*)) (setf decons:*obj* objective) (== (funcall objective '(0.0 0.0)) 33.21) (== (decons:nabla-xp objective '(0.0 0.0)) '(-62.999725 -21.0001)) (== (decons:gradient-descent objective '(0.0 0.0)) '(1.0499986 3.6358833e-6)) ))