From 11e8ff59e463de24a9aa9f8de0768e73a6f5c3e6 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Tue, 27 May 2025 15:33:12 +0200 Subject: [PATCH] gradient calculation basically working --- decons.lisp | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/decons.lisp b/decons.lisp index 99a6e73..0a427b7 100644 --- a/decons.lisp +++ b/decons.lisp @@ -68,13 +68,13 @@ (shape:print-slots tr stream 'theta 'loss)) (defun gradient (target dataset) - (let ((expect (funcall (l2-loss target) dataset))) + (let ((obj (funcall (l2-loss target) dataset))) (lambda (theta) - ))) + (nabla-xp obj theta)))) (defun nabla-xp (fn args) "Determine gradients by experiment: vary args and record changes." - (let ((base (apply fn args)) + (let ((base (funcall fn args)) (vargs (apply #'vector args)) (res nil)) (dotimes (ix (length vargs)) @@ -85,12 +85,10 @@ (let* ((vx 0.01) argsx r+ r-) (setf argsx (copy-seq vargs)) (setf (svref argsx ix) (+ (svref vargs ix) vx)) - (print argsx) - (setf r+ (/ (- (apply fn (map 'list #'identity argsx)) base) vx)) + (setf r+ (/ (- (funcall fn (map 'list #'identity argsx)) base) vx)) (setf (svref argsx ix) (- (svref vargs ix) vx)) - (print argsx) - (setf r- (/ (- base (apply fn (map 'list #'identity argsx))) vx)) - (format t "~a ~a ~a~&" base r+ r-) + (setf r- (/ (- base (funcall fn (map 'list #'identity argsx))) vx)) + ;(util:lgi base r+ r-) (/ (+ r+ r-) 2))) ;;;; parameterized target functions