minor fixes; add rreduce: recursive reduce

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
 

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)