first try with recursive operation: traverse; start rapply + rcall
This commit is contained in:
parent
049c352ea8
commit
d3417cf94a
2 changed files with 27 additions and 4 deletions
21
decons.lisp
21
decons.lisp
|
@ -6,6 +6,7 @@
|
||||||
(:export #:*pi* #:area #:circle
|
(:export #:*pi* #:area #:circle
|
||||||
#:absv #:double #:remainder
|
#:absv #:double #:remainder
|
||||||
#:scalar-p #:tensor #:at
|
#:scalar-p #:tensor #:at
|
||||||
|
#:rapply
|
||||||
#:line
|
#:line
|
||||||
))
|
))
|
||||||
|
|
||||||
|
@ -50,7 +51,25 @@
|
||||||
(defun (setf at) (v a &rest subs)
|
(defun (setf at) (v a &rest subs)
|
||||||
(setf (apply #'aref a subs) v))
|
(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
|
;;;; parameterized functions
|
||||||
|
|
||||||
(defun line (x)
|
(defun line (x)
|
||||||
#'(lambda (theta) (+ (cadr theta) (* (car theta) x))))
|
#'(lambda (theta) (traverse #'+ (cadr theta) (traverse #'* (car theta) x))))
|
||||||
|
|
|
@ -12,6 +12,7 @@
|
||||||
(let ((t:*test-suite* (t:test-suite "decons")))
|
(let ((t:*test-suite* (t:test-suite "decons")))
|
||||||
(test-basic)
|
(test-basic)
|
||||||
(test-lib)
|
(test-lib)
|
||||||
|
(test-rapply)
|
||||||
(test-line)
|
(test-line)
|
||||||
(t:show-result)))
|
(t:show-result)))
|
||||||
|
|
||||||
|
@ -33,14 +34,17 @@
|
||||||
(setf (decons:at t1 0) 5)
|
(setf (decons:at t1 0) 5)
|
||||||
(== (decons:at t1 0) 5)
|
(== (decons:at t1 0) 5)
|
||||||
(== (decons:scalar-p t1) nil)
|
(== (decons:scalar-p t1) nil)
|
||||||
)
|
))
|
||||||
|
|
||||||
|
(deftest test-rapply ()
|
||||||
|
(== (decons:rapply #'1+ 7) 8)
|
||||||
)
|
)
|
||||||
|
|
||||||
(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 '((2.0 1.0 4.0 3.0)
|
(ds1 '((decons:tensor '(4) '(2.0 1.0 4.0 3.0))
|
||||||
(1.8 1.2 4.2 3.3))))
|
(decons:tensor '(4) '(1.8 1.2 4.2 3.3)))))
|
||||||
(== (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)
|
||||||
))
|
))
|
||||||
|
|
Loading…
Add table
Reference in a new issue