87 lines
2.3 KiB
Common Lisp
87 lines
2.3 KiB
Common Lisp
;;;; decons
|
|
|
|
(defpackage :decons
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:util :scopes/util))
|
|
(:export #:rapply #:rreduce #:radd #:rmul #:rsub #:rdiv
|
|
#:combine #:default-deviation #:l2-loss
|
|
#:line
|
|
#:lgx
|
|
#:obj
|
|
))
|
|
|
|
(in-package :decons)
|
|
|
|
;;;; rapply, rreduce - recursive application of operations
|
|
|
|
(defun rapply (op arg1 &optional arg2)
|
|
(if arg2
|
|
(rcall (rcurry op arg1) arg2)
|
|
(rcall op arg1)))
|
|
|
|
(defgeneric rcall (op arg)
|
|
(:method (op arg) (funcall op arg))
|
|
(:method (op (arg list))
|
|
(mapcar (lambda (i) (rcall op i)) arg)))
|
|
|
|
(defgeneric rcurry (op arg)
|
|
(:method (op arg) (lambda (j) (funcall op arg j)))
|
|
(:method (op (arg list))
|
|
(lambda (j) (mapcar (lambda (i) (rapply op i j)) arg))))
|
|
|
|
(defun rreduce (op arg &key (initial-value 0))
|
|
(reduce op arg :initial-value initial-value
|
|
:key (lambda (v) (relement op v :initial-value initial-value))))
|
|
|
|
(defgeneric relement (op v &key initial-value)
|
|
(:method (op v &key (initial-value 0)) v)
|
|
(:method (op (v list) &key (initial-value 0))
|
|
(rreduce op v :initial-value initial-value)))
|
|
|
|
(defun radd (a b) (rapply #'+ a b))
|
|
(defun rmul (a b) (rapply #'* a b))
|
|
(defun rsub (a b) (rapply #'- a b))
|
|
(defun rdiv (a b) (rapply #'/ a b))
|
|
|
|
;;;; combine
|
|
|
|
(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 sum (data) (reduce #'+ data))
|
|
|
|
(defun default-deviation (observed calculated &key (norm #'sqr))
|
|
(sum (mapcar (lambda (p) (funcall norm (apply #'- p)))
|
|
(combine observed calculated))))
|
|
|
|
(defun l2-loss (target &key (deviation #'default-deviation))
|
|
(lambda (dataset) ; expectant function
|
|
(lambda (theta) ; objective function
|
|
(let* ((objective (funcall target (car dataset)))
|
|
(calculated (funcall objective theta)))
|
|
(funcall deviation (cadr dataset) calculated)))))
|
|
|
|
;;;; logging (printing) functions for debugging purposes
|
|
|
|
(defun lgx (op)
|
|
(lambda (&rest args)
|
|
(let ((r (apply op args)))
|
|
(format t "~&(~a ~a) = ~a~%" op args r)
|
|
r)))
|
|
|
|
;;;; parameterized target functions
|
|
|
|
(defun line (x)
|
|
#'(lambda (theta) (radd (cadr theta) (rmul (car theta) x))))
|
|
|
|
;;;; working area
|
|
|
|
(defparameter obj nil)
|