more general solution with rlambda
This commit is contained in:
parent
2ce2ca18f6
commit
c78fe13247
2 changed files with 17 additions and 6 deletions
10
decons.lisp
10
decons.lisp
|
@ -65,13 +65,19 @@
|
|||
(defun rapply (op &rest args)
|
||||
(if (null (cadr args))
|
||||
(rcall op (car args))
|
||||
(apply #'rapply (lambda (x) (funcall op (car args) x)) (cdr args))
|
||||
;(apply #'rapply (lambda (x) (funcall op (car args) x)) (cdr args))
|
||||
(apply #'rapply (rlambda op (car args)) (cdr args))
|
||||
))
|
||||
|
||||
(defgeneric rcall (op arg)
|
||||
(:method (op arg) (funcall op arg))
|
||||
(:method (op (arg list))
|
||||
(mapcar (lambda (x) (rcall op x)) arg)))
|
||||
(mapcar (lambda (i) (rcall op i)) arg)))
|
||||
|
||||
(defgeneric rlambda (op arg)
|
||||
(:method (op arg) (lambda (j) (funcall op arg j)))
|
||||
(:method (op (arg list))
|
||||
(lambda (j) (mapcar (lambda (i) (funcall op i j)) arg))))
|
||||
|
||||
;;;; parameterized functions
|
||||
|
||||
|
|
|
@ -11,7 +11,7 @@
|
|||
(defun run ()
|
||||
(let ((t:*test-suite* (t:test-suite "decons")))
|
||||
(test-basic)
|
||||
(test-lib)
|
||||
(test-tensor)
|
||||
(test-rapply)
|
||||
(test-line)
|
||||
(t:show-result)))
|
||||
|
@ -26,7 +26,7 @@
|
|||
(== (decons:remainder 7 4) 3)
|
||||
)
|
||||
|
||||
(deftest test-lib ()
|
||||
(deftest test-tensor ()
|
||||
(== (decons:scalar-p 7) t)
|
||||
(== (decons:scalar-p '(a b)) nil)
|
||||
(let ((t1 (decons:tensor '(4) '(0 1 2 3))))
|
||||
|
@ -41,13 +41,18 @@
|
|||
(== (decons:rapply #'1+ '(2 3)) '(3 4))
|
||||
(== (decons:rapply #'+ 2 3) 5)
|
||||
(== (decons:rapply #'+ 3 '(4 5)) '(7 8))
|
||||
(== (decons:rapply #'+ '(2 3) '(4 5)) '((6 7) (7 8))) ; not '(6 8)
|
||||
(== (decons:rapply #'- '(6 7) '(4 5)) '((2 3) (1 2)))
|
||||
)
|
||||
|
||||
(deftest test-line ()
|
||||
(let ((p1 (decons:line 0.0))
|
||||
(p2 (decons:line 1.0))
|
||||
(ds1 '((decons:tensor '(4) '(2.0 1.0 4.0 3.0))
|
||||
(decons:tensor '(4) '(1.8 1.2 4.2 3.3)))))
|
||||
(ds1 '((2.0 1.0 4.0 3.0)
|
||||
(1.8 1.2 4.2 3.3)))
|
||||
ps1)
|
||||
(== (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))
|
||||
))
|
||||
|
|
Loading…
Add table
Reference in a new issue