From 4b20e4ef0c2162137bf4dc620ed9f9e127efde7e Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Wed, 28 May 2025 08:35:14 +0200 Subject: [PATCH] nabla-xp: improvements, + test --- decons.lisp | 22 ++++++++++++++++------ test-decons.lisp | 1 + 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/decons.lisp b/decons.lisp index 0a427b7..0915117 100644 --- a/decons.lisp +++ b/decons.lisp @@ -72,6 +72,15 @@ (lambda (theta) (nabla-xp obj theta)))) +;;;; optimization by revision (= gradient descent) + +(defvar *revisions* 10) +(defvar *alpha* 0.01) + +;;;; experimental differentiation + +(defvar *diff-variation* 0.01) + (defun nabla-xp (fn args) "Determine gradients by experiment: vary args and record changes." (let ((base (funcall fn args)) @@ -82,12 +91,13 @@ (reverse res))) (defun diff (fn vargs ix base) - (let* ((vx 0.01) argsx r+ r-) - (setf argsx (copy-seq vargs)) - (setf (svref argsx ix) (+ (svref vargs ix) vx)) - (setf r+ (/ (- (funcall fn (map 'list #'identity argsx)) base) vx)) - (setf (svref argsx ix) (- (svref vargs ix) vx)) - (setf r- (/ (- base (funcall fn (map 'list #'identity argsx))) vx)) + (let* ((vdiff *diff-variation*) + (val (svref vargs ix)) + (argsx (copy-seq vargs)) r+ r-) + (setf (svref argsx ix) (+ val vdiff)) + (setf r+ (/ (- (funcall fn (map 'list #'identity argsx)) base) vdiff)) + (setf (svref argsx ix) (- val vdiff)) + (setf r- (/ (- base (funcall fn (map 'list #'identity argsx))) vdiff)) ;(util:lgi base r+ r-) (/ (+ r+ r-) 2))) diff --git a/test-decons.lisp b/test-decons.lisp index 24bb9b7..ca52b5e 100644 --- a/test-decons.lisp +++ b/test-decons.lisp @@ -71,4 +71,5 @@ (setf decons:*trials* nil) (decons:try objective '(0.0 0.0)) (decons:try objective '(0.0099 0.0)) + (== (decons:nabla-xp objective '(0.0 0.0)) '(-62.999725 -21.0001)) ))