From 0172a2fd4645253a8c7074ed2976ac23772423ec Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 24 May 2025 17:14:03 +0200 Subject: [PATCH] combine lists (like vectors) and calculate sum of pairwise differences (= 'cost') --- decons.lisp | 16 ++++++++++++++++ test-decons.lisp | 9 ++++++++- 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/decons.lisp b/decons.lisp index 529c756..89f85dd 100644 --- a/decons.lisp +++ b/decons.lisp @@ -7,6 +7,7 @@ #:absv #:double #:remainder #:scalar-p #:tensor #:at #:rapply #:rreduce + #:combine #:cost #:line #:lgx )) @@ -87,6 +88,21 @@ (:method (op (v list) &key (initial-value 0)) (rreduce op v :initial-value initial-value))) +;;;; 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))) + +;;;; cost calculation + +(defun cost (have want) + (reduce #'+ + (mapcar (lambda (p) (abs (apply #'- p))) + (combine have want)))) ;;;; logging (printing) functions for debugging purposes diff --git a/test-decons.lisp b/test-decons.lisp index e27bbb8..10449a3 100644 --- a/test-decons.lisp +++ b/test-decons.lisp @@ -13,6 +13,7 @@ (test-basic) (test-tensor) (test-rapply) + (test-rreduce) (test-line) (t:show-result))) @@ -34,7 +35,7 @@ (setf (decons:at t1 0) 5) (== (decons:at t1 0) 5) (== (decons:scalar-p t1) nil) - )) +)) (deftest test-rapply () (== (decons:rapply #'1+ 7) 8) @@ -45,6 +46,10 @@ (== (decons:rapply #'- '(6 7) '(4 5)) '((2 3) (1 2))) ) +(deftest test-rreduce () + (== (decons:rreduce #'+ '(1 2 (3 4))) 10) +) + (deftest test-line () (let ((p1 (decons:line 0.0)) (p2 (decons:line 1.0)) @@ -55,4 +60,6 @@ (== (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) ))