diff --git a/decons.asd b/decons.asd index 7080818..e8340b5 100644 --- a/decons.asd +++ b/decons.asd @@ -8,7 +8,8 @@ :description "Deconstruction as a method for implementing machine intelligence." :depends-on (:alexandria :scopes :scopes/test) - :components ((:file "decons")) + :components ((:file "decons") + (:file "xplore")) :long-description "decons: The base system of the decons project." :in-order-to ((test-op (test-op "decons/test")))) diff --git a/decons.lisp b/decons.lisp index 7af7673..b0217a8 100644 --- a/decons.lisp +++ b/decons.lisp @@ -3,65 +3,15 @@ (defpackage :decons (:use :common-lisp) (:local-nicknames (:util :scopes/util)) - (:export #:+pi+ #:area #:circle - #:absv #:double #:remainder - #:scalar-p #:tensor #:at - #:rapply #:rreduce #:radd #:rmul #:rsub #:rdiv + (:export #:rapply #:rreduce #:radd #:rmul #:rsub #:rdiv #:combine #:default-deviation #:l2-loss #:line #:lgx + #:obj )) (in-package :decons) -;;;; basic explorations - -(defconstant +pi+ 3.14159) - -(defclass circle () - ;;; ! implement as closure - ((radius :accessor radius :initarg :radius :initform 1))) - -(defgeneric area (c) - (:method ((c circle)) - (* +pi+ (radius c) (radius c)))) - -(defun double (f) - #'(lambda (v) (* 2 (funcall f v)))) - -(defun absv (v) - (if (< v 0) (- v) v)) - -(defun remainder (v d) - (if (< v d) - v - (remainder (- v d) d))) - -;;;; tensor stuff - -(defgeneric scalar-p (x) - (:method (x) t) - (:method ((x list)) nil) - (:method ((x array)) nil)) - -(defun tensor (s v) - (make-array s :initial-contents v)) - -(defun at (a &rest subs) - (apply #'aref a subs)) - -(defun (setf at) (v a &rest subs) - (setf (apply #'aref a subs) v)) - -(defun traverse (op &rest args) - (if (null (cdr args)) - (car args) - (apply #'traverse op (trav2 op (car args) (cadr args)) (cddr args)))) - -(defgeneric trav2 (op a b) - (:method (op (a number) (b number)) - (funcall op a b))) - ;;;; rapply, rreduce - recursive application of operations (defun rapply (op arg1 &optional arg2) @@ -131,3 +81,7 @@ (defun line (x) #'(lambda (theta) (radd (cadr theta) (rmul (car theta) x)))) + +;;;; working area + +(defparameter obj nil) diff --git a/test-decons.lisp b/test-decons.lisp index 665176a..518a9cf 100644 --- a/test-decons.lisp +++ b/test-decons.lisp @@ -2,7 +2,8 @@ (defpackage :test-decons (:use :common-lisp) - (:local-nicknames (:t :scopes/testing)) + (:local-nicknames (:xplore :decons/xplore) + (:t :scopes/testing)) (:export #:run) (:import-from :scopes/testing #:deftest #:== #:!=)) @@ -18,23 +19,23 @@ (t:show-result))) (deftest test-basic () - (== decons:+pi+ 3.14159) - (let ((c (make-instance 'decons:circle :radius 2.0))) - (== (decons:area c) 12.56636)) - (== (funcall (decons:double #'1+) 7) 16) - (== (decons:absv 7) 7) - (== (decons:absv -7) 7) - (== (decons:remainder 7 4) 3) + (== 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 () - (== (decons:scalar-p 7) t) - (== (decons:scalar-p '(a b)) nil) - (let ((t1 (decons:tensor '(4) '(0 1 2 3)))) - (== (decons:at t1 0) 0) - (setf (decons:at t1 0) 5) - (== (decons:at t1 0) 5) - (== (decons:scalar-p t1) nil) + (== (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 () @@ -64,5 +65,6 @@ (== (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) )) diff --git a/xplore.lisp b/xplore.lisp new file mode 100644 index 0000000..e22262d --- /dev/null +++ b/xplore.lisp @@ -0,0 +1,59 @@ +;;;; decons/xplore - explorations + +(defpackage :decons/xplore + (:use :common-lisp) + (:local-nicknames (:util :scopes/util)) + (:export #:+pi+ #:area #:circle + #:absv #:double #:remainder + #:scalar-p #:tensor #:at + )) + +(in-package :decons/xplore) + +;;;; basic explorations + +(defconstant +pi+ 3.14159) + +(defclass circle () + ;;; ! implement as closure + ((radius :accessor radius :initarg :radius :initform 1))) + +(defgeneric area (c) + (:method ((c circle)) + (* +pi+ (radius c) (radius c)))) + +(defun double (f) + #'(lambda (v) (* 2 (funcall f v)))) + +(defun absv (v) + (if (< v 0) (- v) v)) + +(defun remainder (v d) + (if (< v d) + v + (remainder (- v d) d))) + +;;;; tensor stuff + +(defgeneric scalar-p (x) + (:method (x) t) + (:method ((x list)) nil) + (:method ((x array)) nil)) + +(defun tensor (s v) + (make-array s :initial-contents v)) + +(defun at (a &rest subs) + (apply #'aref a subs)) + +(defun (setf at) (v a &rest subs) + (setf (apply #'aref a subs) v)) + +(defun traverse (op &rest args) + (if (null (cdr args)) + (car args) + (apply #'traverse op (trav2 op (car args) (cadr args)) (cddr args)))) + +(defgeneric trav2 (op a b) + (:method (op (a number) (b number)) + (funcall op a b)))