cco/decons
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

more general solution with rlambda

Browse source
This commit is contained in:
Helmut Merz 2025-05-23 13:48:35 +02:00
parent 2ce2ca18f6
commit c78fe13247
2 changed files with 17 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
decons.lisp
View file

@ -65,13 +65,19 @@
(defun rapply (op &rest args) (defun rapply (op &rest args)
(if (null (cadr args)) (if (null (cadr args))
(rcall op (car 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) (defgeneric rcall (op arg)
(:method (op arg) (funcall op arg)) (:method (op arg) (funcall op arg))
(:method (op (arg list)) (: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 ;;;; parameterized functions

13
test-decons.lisp
View file

@ -11,7 +11,7 @@
(defun run () (defun run ()
(let ((t:*test-suite* (t:test-suite "decons"))) (let ((t:*test-suite* (t:test-suite "decons")))
(test-basic) (test-basic)
(test-lib) (test-tensor)
(test-rapply) (test-rapply)
(test-line) (test-line)
(t:show-result))) (t:show-result)))
@ -26,7 +26,7 @@
(== (decons:remainder 7 4) 3) (== (decons:remainder 7 4) 3)
) )
(deftest test-lib () (deftest test-tensor ()
(== (decons:scalar-p 7) t) (== (decons:scalar-p 7) t)
(== (decons:scalar-p '(a b)) nil) (== (decons:scalar-p '(a b)) nil)
(let ((t1 (decons:tensor '(4) '(0 1 2 3)))) (let ((t1 (decons:tensor '(4) '(0 1 2 3))))
@ -41,13 +41,18 @@
(== (decons:rapply #'1+ '(2 3)) '(3 4)) (== (decons:rapply #'1+ '(2 3)) '(3 4))
(== (decons:rapply #'+ 2 3) 5) (== (decons:rapply #'+ 2 3) 5)
(== (decons:rapply #'+ 3 '(4 5)) '(7 8)) (== (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 () (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))
(ds1 '((decons:tensor '(4) '(2.0 1.0 4.0 3.0)) (ds1 '((2.0 1.0 4.0 3.0)
(decons:tensor '(4) '(1.8 1.2 4.2 3.3))))) (1.8 1.2 4.2 3.3)))
ps1)
(== (funcall p1 '(0.5 2.0)) 2.0) (== (funcall p1 '(0.5 2.0)) 2.0)
(== (funcall p2 '(0.5 2.0)) 2.5) (== (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))
)) ))