rapply stuff OK, with rcall and rcurry

This commit is contained in:
Helmut Merz 2025-05-24 07:35:09 +02:00
parent 8ae0ab9271
commit fa683982b7

View file

@ -8,6 +8,7 @@
#:scalar-p #:tensor #:at #:scalar-p #:tensor #:at
#:rapply #:rapply
#:line #:line
#:lg-
)) ))
(in-package :decons) (in-package :decons)
@ -35,7 +36,7 @@
v v
(remainder (- v d) d))) (remainder (- v d) d)))
;;;; library stuff ;;;; tensor stuff
(defgeneric scalar-p (x) (defgeneric scalar-p (x)
(:method (x) t) (:method (x) t)
@ -60,32 +61,29 @@
(:method (op (a number) (b number)) (:method (op (a number) (b number))
(funcall op a b))) (funcall op a b)))
;;;; rapply and other recursive stuff ;;;; rapply - recursive application of an operation
(defun rapply (op &rest args) (defun rapply (op arg1 &optional arg2)
(if (null (cdr args)) (if arg2
(rcall op (car args)) (rcall (rcurry op arg1) arg2)
;(apply #'rapply (lambda (x) (funcall op (car args) x)) (cdr args)) (rcall op arg1)))
;(apply #'rapply (rlambda op (car args)) (cdr args))
;(funcall op (car args) (apply #'rapply op (cdr args)))
(rcall2 op (car args) (apply #'rapply op (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 (i) (rcall op i)) arg))) (mapcar (lambda (i) (rcall op i)) arg)))
(defgeneric rcall2 (op arg1 arg2) (defgeneric rcurry (op arg)
(:method (op arg1 arg2)
(rcall (lambda (j) (funcall op arg1 j)) arg2))
(:method (op (arg1 list) arg2)
(mapcar (lambda (i) (rcall (lambda (j) (funcall op i j)) arg2)) arg1)))
(defgeneric rlambda (op arg)
(:method (op arg) (lambda (j) (funcall op arg j))) (:method (op arg) (lambda (j) (funcall op arg j)))
(:method (op (arg list)) (:method (op (arg list))
(lambda (j) (mapcar (lambda (i) (funcall op i j)) arg)))) (lambda (j) (mapcar (lambda (i) (rapply op i j)) arg))))
;;;; logging (printing) functions for debugging purposes
(defun lg- (&rest args)
(let ((r (apply #'- args)))
(format t "~&(- ~a) = ~a~%" args r)
r))
;;;; parameterized functions ;;;; parameterized functions