diff --git a/decons.lisp b/decons.lisp index 259053f..529c756 100644 --- a/decons.lisp +++ b/decons.lisp @@ -3,19 +3,19 @@ (defpackage :decons (:use :common-lisp) (:local-nicknames (:util :scopes/util)) - (:export #:*pi* #:area #:circle + (:export #:+pi+ #:area #:circle #:absv #:double #:remainder #:scalar-p #:tensor #:at - #:rapply + #:rapply #:rreduce #:line - #:lg- + #:lgx )) (in-package :decons) ;;;; basic explorations -(defconstant *pi* 3.14159) +(defconstant +pi+ 3.14159) (defclass circle () ;;; ! implement as closure @@ -23,7 +23,7 @@ (defgeneric area (c) (:method ((c circle)) - (* *pi* (radius c) (radius c)))) + (* +pi+ (radius c) (radius c)))) (defun double (f) #'(lambda (v) (* 2 (funcall f v)))) @@ -61,7 +61,7 @@ (:method (op (a number) (b number)) (funcall op a b))) -;;;; rapply - recursive application of an operation +;;;; rapply, rreduce - recursive application of operations (defun rapply (op arg1 &optional arg2) (if arg2 @@ -78,12 +78,23 @@ (:method (op (arg list)) (lambda (j) (mapcar (lambda (i) (rapply op i j)) arg)))) +(defun rreduce (op arg &key (initial-value 0)) + (reduce op arg :initial-value initial-value + :key (lambda (v) (relement op v :initial-value initial-value)))) + +(defgeneric relement (op v &key initial-value) + (:method (op v &key (initial-value 0)) v) + (:method (op (v list) &key (initial-value 0)) + (rreduce op v :initial-value initial-value))) + + ;;;; logging (printing) functions for debugging purposes -(defun lg- (&rest args) - (let ((r (apply #'- args))) - (format t "~&(- ~a) = ~a~%" args r) - r)) +(defun lgx (op) + (lambda (&rest args) + (let ((r (apply op args))) + (format t "~&(~a ~a) = ~a~%" op args r) + r))) ;;;; parameterized functions diff --git a/test-decons.lisp b/test-decons.lisp index 3a07685..e27bbb8 100644 --- a/test-decons.lisp +++ b/test-decons.lisp @@ -17,7 +17,7 @@ (t:show-result))) (deftest test-basic () - (== decons:*pi* 3.14159) + (== decons:+pi+ 3.14159) (let ((c (make-instance 'decons:circle :radius 2.0))) (== (decons:area c) 12.56636)) (== (funcall (decons:double #'1+) 7) 16)