From 25197a0520932c18f961b4d18e37cfe99d93d6dd Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 24 May 2025 19:29:45 +0200 Subject: [PATCH] now with function l2-loss --- decons.lisp | 19 ++++++++++++++----- test-decons.lisp | 6 ++++-- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/decons.lisp b/decons.lisp index 89f85dd..0018d32 100644 --- a/decons.lisp +++ b/decons.lisp @@ -7,7 +7,7 @@ #:absv #:double #:remainder #:scalar-p #:tensor #:at #:rapply #:rreduce - #:combine #:cost + #:combine #:cost #:l2-loss #:line #:lgx )) @@ -97,12 +97,21 @@ (:method (a b) (list a b)) (:method (a (b list)) (cons a b))) -;;;; cost calculation +;;;; cost / loss calculation -(defun cost (have want) +(defun cost (measured calculated) (reduce #'+ - (mapcar (lambda (p) (abs (apply #'- p))) - (combine have want)))) + (mapcar (lambda (p) (sqr (apply #'- p))) + (combine measured calculated)))) + +(defun l2-loss (target &key (norm #'sqr)) + (lambda (dataset) + (lambda (theta) + (let ((calculated (funcall (funcall target (car dataset)) theta))) + (reduce #'+ (mapcar (lambda (p) (funcall norm (apply #'- p))) + (combine (cadr dataset) calculated))))))) + +(defun sqr (x) (* x x)) ;;;; logging (printing) functions for debugging purposes diff --git a/test-decons.lisp b/test-decons.lisp index 10449a3..6fe557a 100644 --- a/test-decons.lisp +++ b/test-decons.lisp @@ -55,11 +55,13 @@ (p2 (decons:line 1.0)) (ds1 '((2.0 1.0 4.0 3.0) (1.8 1.2 4.2 3.3))) - ps1) + 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:cost (funcall ps1 '(1.0 0.0)) (cadr ds1)) 0.899999861) + (== (decons:cost (cadr ds1) (funcall ps1 '(1.0 0.0))) 0.20999993) ;0.899999861) + (setf objective (funcall (decons:l2-loss #'decons:line) ds1)) + (== (funcall objective '(0.0 0.0)) 33.21) ))