move trivial exploration stuff (including tensor operations) to new file xplore.lisp

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"))))
 

decons.lisp

@@ -3,65 +3,15 @@
 (defpackage :decons
   (:use :common-lisp)
   (:local-nicknames (:util :scopes/util))
-  (:export #:+pi+ #:area #:circle
+  (:export #:rapply #:rreduce #:radd #:rmul #:rsub #:rdiv
-           #:absv #:double #:remainder
-           #:scalar-p #:tensor #:at
-           #: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)

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)
+  (== xplore:+pi+ 3.14159)
-  (let ((c (make-instance 'decons:circle :radius 2.0)))
+  (let ((c (make-instance 'xplore:circle :radius 2.0)))
-    (== (decons:area c) 12.56636))
+    (== (xplore:area c) 12.56636))
-  (== (funcall (decons:double #'1+) 7) 16)
+  (== (funcall (xplore:double #'1+) 7) 16)
-  (== (decons:absv 7) 7)
+  (== (xplore:absv 7) 7)
-  (== (decons:absv -7) 7)
+  (== (xplore:absv -7) 7)
-  (== (decons:remainder 7 4) 3)
+  (== (xplore:remainder 7 4) 3)
 )
 
 (deftest test-tensor ()
-  (== (decons:scalar-p 7) t)
+  (== (xplore:scalar-p 7) t)
-  (== (decons:scalar-p '(a b)) nil)
+  (== (xplore:scalar-p '(a b)) nil)
-  (let ((t1 (decons:tensor '(4) '(0 1 2 3))))
+  (let ((t1 (xplore:tensor '(4) '(0 1 2 3))))
-    (== (decons:at t1 0) 0)
+    (== (xplore:at t1 0) 0)
-    (setf (decons:at t1 0) 5)
+    (setf (xplore:at t1 0) 5)
-    (== (decons:at t1 0) 5)
+    (== (xplore:at t1 0) 5)
-    (== (decons:scalar-p t1) nil)
+    (== (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)
 ))

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)))