;;;; 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))