;;;; decons

(defpackage :decons
  (:use :common-lisp)
  (:local-nicknames (:util :scopes/util))
  (:export #:rapply #:rreduce #:radd #:rmul #:rsub #:rdiv
           #:combine #:default-deviation #:l2-loss
           #:line
           #:lgx
           #:obj
           ))

(in-package :decons)

;;;; rapply, rreduce - recursive application of operations

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

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

(defun radd (a b) (rapply #'+ a b))
(defun rmul (a b) (rapply #'* a b))
(defun rsub (a b) (rapply #'- a b))
(defun rdiv (a b) (rapply #'/ a b))

;;;; combine

(defun combine (l1 l2)
  (mapcar (lambda (x) (scons (pop l1) x)) l2))

(defgeneric scons (a b)
  (:method (a b) (list a b))
  (:method (a (b list)) (cons a b)))

;;;; loss calculation

(defun sqr (x) (* x x))

(defun sum (data) (reduce #'+ data))

(defun default-deviation (observed calculated &key (norm #'sqr))
  (sum (mapcar (lambda (p) (funcall norm (apply #'- p))) 
               (combine observed calculated))))

(defun l2-loss (target &key (deviation #'default-deviation))
  (lambda (dataset) ; expectant function
    (lambda (theta) ; objective function
      (let* ((objective (funcall target (car dataset)))
             (calculated (funcall objective theta)))
        (funcall deviation (cadr dataset) calculated)))))

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

(defun lgx (op)
  (lambda (&rest args)
   (let ((r (apply op args)))
    (format t "~&(~a ~a) = ~a~%" op args r)
    r)))

;;;; parameterized target functions

(defun line (x)
  #'(lambda (theta) (radd (cadr theta) (rmul (car theta) x))))

;;;; working area

(defparameter obj nil)