From d3417cf94ae09173e063a0137ce52aa90c0747cd Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Fri, 23 May 2025 09:33:14 +0200 Subject: [PATCH] first try with recursive operation: traverse; start rapply + rcall --- decons.lisp | 21 ++++++++++++++++++++- test-decons.lisp | 10 +++++++--- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/decons.lisp b/decons.lisp index f6eb901..f9bdb4a 100644 --- a/decons.lisp +++ b/decons.lisp @@ -6,6 +6,7 @@ (:export #:*pi* #:area #:circle #:absv #:double #:remainder #:scalar-p #:tensor #:at + #:rapply #:line )) @@ -50,7 +51,25 @@ (defun (setf at) (v a &rest subs) (setf (apply #'aref a subs) v)) +(defun traverse (op &rest args) + (if (null (cdr args)) + (car args) + (apply #'traverse op (trav2 op (car args) (cadr args)) (cddr args)))) + +(defgeneric trav2 (op a b) + (:method (op (a number) (b number)) + (funcall op a b))) + +;;;; rapply and other recursive stuff + +(defun rapply (op &rest args) + (rcall op (car args))) + +(defgeneric rcall (op arg) + (:method (op a) (funcall op a)) + ) + ;;;; parameterized functions (defun line (x) - #'(lambda (theta) (+ (cadr theta) (* (car theta) x)))) + #'(lambda (theta) (traverse #'+ (cadr theta) (traverse #'* (car theta) x)))) diff --git a/test-decons.lisp b/test-decons.lisp index e2099f8..7924b24 100644 --- a/test-decons.lisp +++ b/test-decons.lisp @@ -12,6 +12,7 @@ (let ((t:*test-suite* (t:test-suite "decons"))) (test-basic) (test-lib) + (test-rapply) (test-line) (t:show-result))) @@ -33,14 +34,17 @@ (setf (decons:at t1 0) 5) (== (decons:at t1 0) 5) (== (decons:scalar-p t1) nil) - ) + )) + +(deftest test-rapply () + (== (decons:rapply #'1+ 7) 8) ) (deftest test-line () (let ((p1 (decons:line 0.0)) (p2 (decons:line 1.0)) - (ds1 '((2.0 1.0 4.0 3.0) - (1.8 1.2 4.2 3.3)))) + (ds1 '((decons:tensor '(4) '(2.0 1.0 4.0 3.0)) + (decons:tensor '(4) '(1.8 1.2 4.2 3.3))))) (== (funcall p1 '(0.5 2.0)) 2.0) (== (funcall p2 '(0.5 2.0)) 2.5) ))