46 lines
1.6 KiB
Common Lisp
46 lines
1.6 KiB
Common Lisp
;;;; decons/recurse - recursive calculations
|
|
|
|
(defpackage :decons/recurse
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:util :scopes/util))
|
|
(:export #:call #:call2 #:reduce-all #:reduce-1 #:add #:mul #:sub #:div #:sqr))
|
|
|
|
(in-package :decons/recurse)
|
|
|
|
;;;; recursive application of operations
|
|
|
|
(defgeneric call (op arg)
|
|
(:method (op arg) (funcall op arg))
|
|
(:method (op (arg list))
|
|
(mapcar (lambda (i) (call op i)) arg)))
|
|
|
|
(defgeneric call2 (op a1 a2)
|
|
(:method (op a1 a2) (funcall op a1 a2))
|
|
(:method (op (a1 list) a2)
|
|
(mapcar (lambda (i) (call2 op i a2)) a1))
|
|
(:method (op a1 (a2 list))
|
|
(mapcar (lambda (j) (call2 op a1 j)) a2))
|
|
(:method (op (a1 list) (a2 list))
|
|
(mapcar (lambda (i j) (call2 op i j)) a1 a2)))
|
|
|
|
(defun reduce-all (op arg &key (initial-value 0))
|
|
(reduce op arg :initial-value initial-value
|
|
:key (lambda (v) (element op v :initial-value initial-value))))
|
|
|
|
(defgeneric element (op v &key initial-value)
|
|
(:method (op v &key (initial-value 0)) v)
|
|
(:method (op (v list) &key (initial-value 0))
|
|
(reduce-all op v :initial-value initial-value)))
|
|
|
|
(defgeneric reduce-1 (op arg &key initial-value)
|
|
(:method (op arg &key (initial-value 0)) arg)
|
|
(:method (op (arg list) &key (initial-value 0))
|
|
(if (some #'consp arg)
|
|
(mapcar (lambda (x) (reduce-1 op x :initial-value initial-value)) arg)
|
|
(reduce op arg :initial-value initial-value))))
|
|
|
|
(defun add (a b) (call2 #'+ a b))
|
|
(defun mul (a b) (call2 #'* a b))
|
|
(defun sub (a b) (call2 #'- a b))
|
|
(defun div (a b) (call2 #'/ a b))
|
|
(defun sqr (a) (call (lambda (x) (* x x)) a))
|