cco/decons
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

clean-up: code improvements, remove obsolete stuff

Browse source
This commit is contained in:
Helmut Merz 2025-05-25 20:19:11 +02:00
parent cff6311103
commit fc83700642
1 changed files with 10 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
decons.lisp
View file

@ -5,12 +5,10 @@
(:local-nicknames (:shape :scopes/shape) (:local-nicknames (:shape :scopes/shape)
(:util :scopes/util)) (:util :scopes/util))
(:export #:rapply #:rreduce #:radd #:rmul #:rsub #:rdiv (:export #:rapply #:rreduce #:radd #:rmul #:rsub #:rdiv
#:combine #:default-deviation #:l2-loss #:default-deviation #:l2-loss #:trial
#:*trials* #:trial #:try
#:line #:line
#:lgx #:lgx
#:*obj* #:*obj* #:*trials* #:try))
))
(in-package :decons) (in-package :decons)
@ -45,24 +43,15 @@
(defun rsub (a b) (rapply #'- a b)) (defun rsub (a b) (rapply #'- a b))
(defun rdiv (a b) (rapply #'/ a b)) (defun rdiv (a b) (rapply #'/ a b))
;;;; combine ;;;; loss calculation, collect trial data (parameters, resulting loss)
(defun combine (l1 l2)
(mapcar (lambda (x) (scons (pop l1) x)) l2))
(defgeneric scons (a b)
(:method (a b) (list a b))
(:method (a (b list)) (cons a b)))
;;;; loss calculation
(defun sqr (x) (* x x)) (defun sqr (x) (* x x))
(defun sum (data) (reduce #'+ data)) (defun sum (data) (reduce #'+ data))
(defun default-deviation (observed calculated &key (norm #'sqr)) (defun default-deviation (observed calculated &key (norm #'sqr))
(sum (mapcar (lambda (p) (funcall norm (apply #'- p))) (sum (mapcar (lambda (a b) (funcall norm (- a b)))
(combine observed calculated)))) observed calculated)))
(defun l2-loss (target &key (deviation #'default-deviation)) (defun l2-loss (target &key (deviation #'default-deviation))
(lambda (dataset) ; expectant function (lambda (dataset) ; expectant function
@ -71,8 +60,6 @@
(calculated (funcall objective theta))) (calculated (funcall objective theta)))
(funcall deviation (cadr dataset) calculated))))) (funcall deviation (cadr dataset) calculated)))))
(defvar *trials* nil)
(defclass trial () (defclass trial ()
((theta :reader theta :initarg :theta) ((theta :reader theta :initarg :theta)
(loss :reader loss :initarg :loss))) (loss :reader loss :initarg :loss)))
@ -80,9 +67,6 @@
(defmethod print-object ((tr trial) stream) (defmethod print-object ((tr trial) stream)
(shape:print-slots tr stream 'theta 'loss)) (shape:print-slots tr stream 'theta 'loss))
(defun try (obj theta)
(push (make-instance 'trial :theta theta :loss (funcall obj theta)) *trials*))
;;;; logging (printing) functions for debugging purposes ;;;; logging (printing) functions for debugging purposes
(defun lgx (op) (defun lgx (op)
@ -99,3 +83,8 @@
;;;; working area ;;;; working area
(defvar *obj* nil) (defvar *obj* nil)
(defvar *trials* nil)
(defun try (obj theta)
(push (make-instance 'trial :theta theta :loss (funcall obj theta)) *trials*))