combine lists (like vectors) and calculate sum of pairwise differences (= 'cost')
This commit is contained in:
parent
b4a337ee37
commit
0172a2fd46
2 changed files with 24 additions and 1 deletions
16
decons.lisp
16
decons.lisp
|
@ -7,6 +7,7 @@
|
||||||
#:absv #:double #:remainder
|
#:absv #:double #:remainder
|
||||||
#:scalar-p #:tensor #:at
|
#:scalar-p #:tensor #:at
|
||||||
#:rapply #:rreduce
|
#:rapply #:rreduce
|
||||||
|
#:combine #:cost
|
||||||
#:line
|
#:line
|
||||||
#:lgx
|
#:lgx
|
||||||
))
|
))
|
||||||
|
@ -87,6 +88,21 @@
|
||||||
(:method (op (v list) &key (initial-value 0))
|
(:method (op (v list) &key (initial-value 0))
|
||||||
(rreduce op v :initial-value initial-value)))
|
(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
|
;;;; logging (printing) functions for debugging purposes
|
||||||
|
|
||||||
|
|
|
@ -13,6 +13,7 @@
|
||||||
(test-basic)
|
(test-basic)
|
||||||
(test-tensor)
|
(test-tensor)
|
||||||
(test-rapply)
|
(test-rapply)
|
||||||
|
(test-rreduce)
|
||||||
(test-line)
|
(test-line)
|
||||||
(t:show-result)))
|
(t:show-result)))
|
||||||
|
|
||||||
|
@ -45,6 +46,10 @@
|
||||||
(== (decons:rapply #'- '(6 7) '(4 5)) '((2 3) (1 2)))
|
(== (decons:rapply #'- '(6 7) '(4 5)) '((2 3) (1 2)))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(deftest test-rreduce ()
|
||||||
|
(== (decons:rreduce #'+ '(1 2 (3 4))) 10)
|
||||||
|
)
|
||||||
|
|
||||||
(deftest test-line ()
|
(deftest test-line ()
|
||||||
(let ((p1 (decons:line 0.0))
|
(let ((p1 (decons:line 0.0))
|
||||||
(p2 (decons:line 1.0))
|
(p2 (decons:line 1.0))
|
||||||
|
@ -55,4 +60,6 @@
|
||||||
(== (funcall p2 '(0.5 2.0)) 2.5)
|
(== (funcall p2 '(0.5 2.0)) 2.5)
|
||||||
(setf ps1 (decons:line (car ds1)))
|
(setf ps1 (decons:line (car ds1)))
|
||||||
(== (funcall ps1 '(0.5 2.0)) '(3.0 2.5 4.0 3.5))
|
(== (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)
|
||||||
))
|
))
|
||||||
|
|
Loading…
Add table
Reference in a new issue