;;;; decons

(defpackage :decons
  (:use :common-lisp)
  (:local-nicknames (:util :scopes/util))
  (:export #:*pi* #:area #:circle
           #:absv #:double #:remainder
           #:scalar-p #:tensor #:at
           #:rapply
           #:line
           #:lg-
           ))

(in-package :decons)

;;;; basic explorations

(defconstant *pi* 3.14159)

(defclass circle ()
  ;;; ! implement as closure
  ((radius :accessor radius :initarg :radius :initform 1)))

(defgeneric area (c)
  (:method ((c circle))
    (* *pi* (radius c) (radius c))))

(defun double (f) 
  #'(lambda (v) (* 2 (funcall f v))))

(defun absv (v)
  (if (< v 0) (- v) v))

(defun remainder (v d)
  (if (< v d) 
    v
    (remainder (- v d) d)))

;;;; tensor stuff

(defgeneric scalar-p (x)
  (:method (x) t)
  (:method ((x list)) nil)
  (:method ((x array)) nil))

(defun tensor (s v)
  (make-array s :initial-contents v))

(defun at (a &rest subs)
  (apply #'aref a subs))

(defun (setf at) (v a &rest subs)
  (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 - recursive application of an operation

(defun rapply (op arg1 &optional arg2)
  (if arg2
    (rcall (rcurry op arg1) arg2)
    (rcall op arg1)))

(defgeneric rcall (op arg)
  (:method (op arg) (funcall op arg))
  (:method (op (arg list))
    (mapcar (lambda (i) (rcall op i)) arg)))

(defgeneric rcurry (op arg)
  (:method (op arg) (lambda (j) (funcall op arg j)))
  (:method (op (arg list))
    (lambda (j) (mapcar (lambda (i) (rapply op i j)) arg))))

;;;; logging (printing) functions for debugging purposes

(defun lg- (&rest args)
  (let ((r (apply #'- args)))
    (format t "~&(- ~a) = ~a~%" args r)
    r))

;;;; parameterized functions

(defun line (x)
  #'(lambda (theta) (rapply #'+ (cadr theta) (rapply #'* (car theta) x))))