;;########################################################################
;; regmob.lsp
;; OLS, Robust & Monotonic Regression ViSta model object
;; Contains code for morals-model-object-proto
;; Copyright (c) 1995-6 by Carla M. Bann
;;########################################################################
(load (strcat *vista-dir-name* "regress.lsp"))

(defun regression-analysis 
  (&key 
   (data current-data)  
   (title "Multiple Regression Analysis")
   (name nil)
   (dialog nil)
   (iterations 10)
   (method "OLS") ;robust monotonic ols
   (max-rsq 1)
   (min-rsq-improve .00001)
   (response nil)
   (predictors nil)
   )
  (if (or (not response) (not predictors)) (setf dialog t))
  (if (not (eq current-object data)) (setcd data))
  (if (not name) 
      (setf name (strcat "REG-" (send current-data :name))))
  (if (not (listp response)) (setf response (list response)))
  (send morals-model-object-proto 
        :new response predictors method iterations max-rsq min-rsq-improve
        7 data title name dialog))

(defproto morals-model-object-proto 
  '(morals-model data-object iv dv weights intercept iter max-RSq min-RSq-improve varlist spreadplot-supervisor method vif-list lin-reg-model robust-model predictors response simple-reg prev-vis) ()
  mv-model-object-proto)

(defmeth morals-model-object-proto :morals-model
  (&optional (object-id nil set))
  (if set (setf (slot-value 'morals-model) object-id))
  (slot-value 'morals-model))

(defmeth morals-model-object-proto :robust-model
  (&optional (object-id nil set))
  (if set (setf (slot-value 'robust-model) object-id))
  (slot-value 'robust-model))

(defmeth morals-model-object-proto :lin-reg-model
  (&optional (object-id nil set))
  (if set (setf (slot-value 'lin-reg-model) object-id))
  (slot-value 'lin-reg-model))

(defmeth morals-model-object-proto :data-object
  (&optional (object-id nil set))
  (if set (setf (slot-value 'data-object) object-id))
  (slot-value 'data-object)) 

(defmeth morals-model-object-proto :iv
  (&optional (iv nil set))
  (if set (setf (slot-value 'iv) iv))
  (slot-value 'iv))

(defmeth morals-model-object-proto :dv
  (&optional (dv nil set))
  (if set (setf (slot-value 'dv) dv))
  (slot-value 'dv))

(defmeth morals-model-object-proto :weights
  (&optional (weights nil set))
  (if set (setf (slot-value 'weights) weights))
  (slot-value 'weights))

(defmeth morals-model-object-proto :intercept
  (&optional (intercept nil set))
  (if set (setf (slot-value 'intercept) intercept))
  (slot-value 'intercept))

(defmeth morals-model-object-proto :simple-reg
  (&optional (simple-reg nil set))
  (if set (setf (slot-value 'simple-reg) simple-reg))
  (slot-value 'simple-reg))
 
(defmeth morals-model-object-proto :iter
  (&optional (iter nil set))
  (if set (setf (slot-value 'iter) iter))
  (slot-value 'iter))

(defmeth morals-model-object-proto :max-RSq
  (&optional (max-RSq nil set))
  (if set (setf (slot-value 'max-RSq) max-RSq))
  (slot-value 'max-RSq))

(defmeth morals-model-object-proto :min-RSq-improve
  (&optional (min-RSq-improve nil set))
  (if set (setf (slot-value 'min-RSq-improve) min-RSq-improve))
  (slot-value 'min-RSq-improve))

(defmeth morals-model-object-proto :method
  (&optional (list1 nil set))
  (if set (setf (slot-value 'method) list1))
  (slot-value 'method))

(defmeth morals-model-object-proto :vif-list
  (&optional (list1 nil set))
  (if set (setf (slot-value 'vif-list) list1))
  (slot-value 'vif-list))

(defmeth morals-model-object-proto :predictors
  (&optional (object-id nil set))
  (if set (setf (slot-value 'predictors) object-id))
  (slot-value 'predictors))

(defmeth morals-model-object-proto :response
  (&optional (object-id nil set))
  (if set (setf (slot-value 'response) object-id))
  (slot-value 'response))

(defmeth morals-model-object-proto :prev-vis
  (&optional (prev-vis nil set))
  (if set (setf (slot-value 'prev-vis) prev-vis))
  (slot-value 'prev-vis))

(defmeth morals-model-object-proto :analysis () 
  (let* ((data-mat (send self :data-matrix))
         (nobs (send self :nobs))
         (ivar-mat (select data-mat (iseq nobs) (send self :iv)))
         (dvar (combine (select data-mat (iseq nobs) (send self :dv))))
         (iter (send self :iter))
         (max-RSq (send self :max-RSq))
         (min-RSq-improve (send self :min-RSq-improve))
         (dial nil)
         (object nil)
         (method "OLS")
         (vif-list nil))
    (setf object (optimal-regression-model ivar-mat dvar
                  :iterations iter :maximum-RSq max-RSq 
                  :minimum-RSq-improve min-RSq-improve
                  :vista-object self :method method :vif-list vif-list))  
    (send self :morals-model object) 
    (send self :robust-model (robust-regression-model ivar-mat dvar))
    (send self :lin-reg-model 
          (regression-model ivar-mat dvar :display nil :print nil))
    (send (send self :robust-model) :vista-object self)
;next lines moved here by fwy from :isnew oct 2 96 and rewritten feb 11 97
    (when (or (equalp (send self :method) "Robust")
              (equalp (send self :method) "Monotonic"))
          (vista-message "Please wait until iterations finish.")
          (send self :create-spreadplot "no")
          (if (equalp (send self :method) "Monotonic")
              (send (send self :spreadplot-supervisor) :iterate2 iter "no")
              (send (send self :spreadplot-supervisor) :iterate3 iter "no"))
          (vista-message "Iterations are finished."))
    object))

#|(when (equalp (send self :method) "Robust")
          (format t "~%Please wait until iterations finish.~%")
          (send self :create-spreadplot "no"))
    (when (equalp (send self :method) "Monotonic")
          (format t "~%Please wait until iterations finish.~%")
          (send self :create-spreadplot "no"))
    (send (send self :spreadplot-supervisor) :iterate2 iter "no")|#

(defmeth morals-model-object-proto :save-model-template (data-object)
"Args: (data-object)
DATA-OBJECT is the object-identification information of a data object. 
The method contains a template for saving the model-object." 
  (let* ((dv (send (send self :morals-model) :y))
         (iv (send (send self :morals-model) :x))
         (data (combine (bind-columns dv iv)))
         (response (select (send self :variables) (send self :dv)))
         (predictors (select (send self :variables) (send self :iv)))
         (variables  (combine response predictors))
         )
  `(regression-analysis    
    :title           ,(strcat (send self :method) 
                              " Univariate " 
                              (send self :title))
    :name            ,(send self :name) 
    :dialog           nil
    :method          ,(send self :method)
    :iterations      ,(send self :iter)
    :max-rsq         ,(send self :max-rsq)
    :min-rsq-improve ,(send self :min-rsq-improve)
    :response        ,response
    :predictors     ',predictors
    :data             (data ,(send data-object :name)
                            :title      ,(send data-object :title)
                            :variables ',variables
                            :labels    ',(send self :labels)
                            :data      ',data))
    ))

(defmeth morals-model-object-proto :create-data 
  (&key (dialog nil))
  (if (not (eq current-object self)) (setcm self))
  (let* ((morals-model (send self :morals-model))
         (residuals (send morals-model :print-residuals))
         (leverages (send morals-model :print-leverages))
         (nobs (send self :nobs))
         (weights (send (send self :robust-model) :weights))
         (data-mat nil)
         )
    (setf residuals (select residuals (iseq nobs) (list 1 2 4 5 6)))
    (setf leverages (select leverages (iseq nobs) (list 1 2)))
    (setf data-mat (bind-columns residuals leverages (send self :dffits)))
    (when weights (setf data-mat (bind-columns data-mat weights)))
    (setf vars 
          (if weights
              '("Response" "Fit Values" "Residuals" 
                           "Studt.Resid" "Ext.Studt.Resid" "Leverages" 
                           "CooksDist" "DFFITS" "Weights")
              '("Response" "Fit Values" "Residuals" 
                       "Studt.Resid" "Ext.Studt.Resid" "Leverages" 
                       "CooksDist" "DFFITS")))
    (when (equal (send current-model :method) "Monotonic")
          (setf data-mat (bind-columns 
                          (send morals-model :yraw) data-mat))
          (setf (select vars 0) "Monotone")
          (setf vars (combine "Response" vars)))
    (data (concatenate 'string "Output-" (send self :name))
          :created (send *workmap* :selected-icon)
          :creator-object self
          :title (concatenate 'string "Regression Output for " 
                              (send self :title))
          :data (combine data-mat)
          :variables vars
          :labels (send self :labels))
    ))

(defmeth morals-model-object-proto :options ()
"Args: none
Constructs and displays the options dialog window for regression models.
Returns nil or a four element list.  Returns nil when dialog canceled or when no response or predictor variables selected, returns four element list otherwise.  The first element of the list is a list of response variable indices.  The second element is a list of predictor variable indices. The third element is the index of the weight variable, or nil for unweighted analysis.  The fourth element is T for intercept models, nil for non-intercept models."
  (when (not (send self :dialog))
        (send self :iv ($position (send self :predictors)
                                  (send self :variables)))
        (send self :dv ($position (send self :response)
                                  (send self :variables))))
  (when (send self :dialog)
  (let* (
         (box-text-item (send text-item-proto :new 
                              "Multiple Regression Analysis"
                              :location (list 50 5)))
         (select-toggle (send choice-item-proto :new (list
                              "Select Response"
                              "Select Predictors") 
                              :value 0))
         (method-toggle (send choice-item-proto :new (list "OLS Regression" 
                              "Monotonic Regression" "Robust Regression")
                              :value 0))
 
         (var-text-item (send text-item-proto :new "Selectable Variables"))
         (rsp-var-text (send text-item-proto :new "Selected Response  "))
         (prd-text-item (send text-item-proto :new "Selected Predictors"))
         (var-list (send self :variables))
         (prd-list (repeat " " (length var-list)))
         (rsp-num nil)
         (prd-nums nil)
         (var-list-item (send list-item-proto :new var-list
                              :action #'(lambda () (move-vars &optional dc))
                            ;  :size (list 150 150)
                              ))
         (rsp-var (send list-item-proto :new (list " ")
                            ;   :size (list 150 18)
                               ))
         (prd-list-item (send list-item-proto :new prd-list
                            ;  :size (list 150 150)
                              ))
         (ok        (send modal-button-proto :new "OK" 
                          :action #'(lambda ()
                       (let ((dialog (send ok :dialog))
                             (method (send method-toggle :value))
                             ) 
                         (send self :iv prd-nums)
                         (send self :dv rsp-num)
                         (when (= method 1)
                            (send self :method "Monotonic"))
                         (when (= method 2)
                            (send self :method "Robust"))
                         (cond 
                           ((or (> 1 (length prd-nums))
                                (equalp rsp-num nil))
                            (error-message "You must select at least one response and one predictor variable.")
                            (send dialog :modal-dialog-return nil)
                            )
                           ((and (= 1 (length prd-nums)) (> method 0))
                            (error-message 
                             "Monotonic and Robust Simple Regression (i.e., one predictor) are not supported.")
                            (send dialog :modal-dialog-return nil)
                            )
                           (t (send dialog :modal-dialog-return t)))
                         ))))
                         
         (cancel    (send modal-button-proto :new "Cancel"
                          :action #'(lambda ()
                            (let ((dialog (send cancel :dialog)))
                              (send dialog :modal-dialog-return nil)))))
    
         (reg-dialog (send modal-dialog-proto :new
                     (list box-text-item
                           (list select-toggle method-toggle)
                           (list rsp-var-text rsp-var)
                           (list var-text-item prd-text-item)
                           (list var-list-item prd-list-item)
                           (list ok cancel))
                           :default-button ok))
         )
    (defmeth var-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (s (select (send self :slot-value 'list-data) n))
             (m nil))
        (when (and n (not (equal s " ")))
              (send self :set-text n " ") 
              (when (and rsp-num (= 0 (send select-toggle :value)))
                    (send var-list-item :set-text n s))
              (when (and (not rsp-num) (= 0 (send select-toggle :value)))
                    (send rsp-var :set-text 0 s)
                    (setf rsp-num n))
              (when (= 1 (send select-toggle :value))
                    (setf m (position " " (send prd-list-item :slot-value 'list-data)
                                      :test 'equal))
                    (send prd-list-item :set-text m s)
                    (setf prd-nums (concatenate 'list prd-nums (list n))))
              (send self :selection nil))))

    (defmeth rsp-var :do-action (&optional dbl-clk)
      (let* ((s (select (send self :slot-value 'list-data) 0)))
        (when (not (equal s " "))
              (send self :set-text 0 " ")
              (send var-list-item :set-text rsp-num s)
              (send self :selection nil)
              (setf rsp-num nil))))

    (defmeth prd-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length prd-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (when (> L n)
                    (setf m (select prd-nums n))
                    (when (< n (1- L))
                          (dolist (i (iseq n (- L 2)))
                                  (send self :set-text i
                                        (select (send self :slot-value 'list-data) (1+ i)))))
                    (send self :set-text (1- L) " ")
                    (send var-list-item :set-text m s)
                    (send self :selection nil)
                    (setf prd-nums (remove m prd-nums))))))

    (if (send reg-dialog :modal-dialog)
        (list rsp-num prd-nums)
        nil))))

(defmeth morals-model-object-proto :report (&key (dialog nil))
  (send (send self :morals-model) :morals-display :dialog dialog))

(defmeth morals-model-object-proto :visualize ()
  (cond 
    ((send self :prev-vis)
     (vista-message "You cannot re-visualize the regression model. You must compute a new model by using the Analysis menu, and then visualize it."))
    (t
     (send self :prev-vis t)
     (send self :create-spreadplot))))

(defmeth morals-model-object-proto :vif ()
  (let* ((iv (select (send self :variables) (send self :iv)))
         (i 0)
         (mod (send self :morals-model))
         (nobs (send self :nobs))
         (vif nil)
         (vif-list nil)
         )
  (dotimes (i (length (send self :iv)))
           (let* ((vif nil)) 
             (setf vif (/ 1 (- 1 
                (send (regression-model (select (send mod :x)
                (iseq nobs) (remove i (iseq (length (send self :iv)))))
                            (combine (select (send mod :x) (iseq nobs)
                            (select (iseq (length (send self :iv))) i)))
                                        :print nil)
                      :r-squared))))
             (if (= i 0) (setf vif-list vif) (setf vif-list (combine vif-list vif)))
             ))
(send self :vif-list vif-list)))

(defmeth morals-model-object-proto :dffits ()
  (let* ((dffits nil)
         (model nil))
    (if (equalp (send self :method) "Robust") (setf model (send self :robust-model)) (setf model (send self :morals-model)))
    (setf dffits (* (sqrt (/ (send model :leverages)
                             (- 1 (send model :leverages))))
                    (send model :externally-studentized-residuals)))
    dffits))


(defun correlation (x y)
  (let* ((corr nil))
  (setf corr (/ (/ (sum (* (- x (mean x)) (- y (mean y))))
       (- (length x) 1))
       (* (sqrt (/ (sum (* (- x (mean x)) (- x (mean x)))) (- (length x) 1)))
          (sqrt (/ (sum (* (- y (mean y)) (- y (mean y)))) (- (length y) 1))))))
  corr))


(defmeth morals-model-object-proto :autocorr () 
  (let* ((autocorr nil)
         (model nil))
    (if (equalp (send self :method) "Robust") (setf model (send self :robust-model)) (setf model (send self :morals-model)))
    (setf autocorr 
          (correlation (select (send model :raw-residuals) 
                         (iseq (1- (send self :nobs))))
                       (select (send model :raw-residuals)
                         (+ 1 (iseq (1- (send self :nobs)))))))
    autocorr))

(defmeth morals-model-object-proto :isnew 
              (response predictors method iterations max-rsq min-rsq-improve 
                        &rest args)
  (send *model-menu* :enabled nil)
  (send self :predictors predictors)
  (send self :response response)
  (send self :method method)
  (send self :data-object current-data)
  (send self :model-abbrev "REG")
  (send self :iter iterations)
  (send self :max-rsq max-rsq)
  (send self :min-rsq-improve min-rsq-improve)
  (apply #'call-next-method args)
#|
  (when (equalp (send self :method) "Robust")
        (send self :create-spreadplot "no")
        (send (send self :spreadplot-supervisor) :iterate3 iterations "no"))
  (when (equalp (send self :method) "Monotonic")
        (send self :create-spreadplot "no")
        (send (send self :spreadplot-supervisor) :iterate2 iterations "no"))
|#
  (send *model-menu* :enabled t))


(defun morals (&key (data current-data) 
                    (title "MORALS") 
                    (dialog t)
                    (name nil))
  (if (not (eq (current-object data)) (setcd data)))
  (if (not name) (strcat "REG-" (send current-data :name)))
  (send morals-model-object-proto :new 1 data title name dialog))

  
(defun morals 
  (&key 
   (data current-data)  
   (title "Morals")
   (name nil)
   (dialog t)
   (iter 20)
   (max-rsq 1)
   (min-rsq-improve 0)
   )
  (if (not (eq current-object data)) (setcd data))
  (if (not name) 
      (setf name (strcat "REG-" (send current-data :name))))
  (send morals-model-object-proto 
          :new iter max-rsq min-rsq-improve 7 data title name dialog))

(load (strcat *vista-dir-name* "robust.lsp"))
(load (strcat *vista-dir-name* "regvis1.lsp"))
(load (strcat *vista-dir-name* "regvis2.lsp"))
(load (strcat *vista-dir-name* "regvis3.lsp"))
(load (strcat *vista-dir-name* "regvis4.lsp"))
(load (strcat *vista-dir-name* "regvis5.lsp"))
(load (strcat *vista-dir-name* "regvis6.lsp"))
(load (strcat *vista-dir-name* "regvhelp.lsp"))