;;########################################################################
;; regvis5.lsp
;; Visualization for OLS, Robust & Monotonic Regression ViSta model object
;; This file contains robust code and iteration code
;; Copyright (c) 1995-6 by Carla M. Bann
;;########################################################################

(defmeth morals-spreadplot-supervisor-proto :robust ()
  (let* ((model (send (send self :model) :robust-model)))
    (send model :robust-loop)))

(defmeth robust-proto :biweight (x)
  (^ (- 1 (^ (pmin (abs x) 1) 2)) 2))


(defmeth robust-proto :robust-weights (&optional (c 4.685))
  (let* ((vista-obj (send self :vista-object))
         (rr (send self :raw-residuals))
         (s  (/ (median (abs rr)) .6745)))
  (send self :biweight (/ rr (* c s)))))


(defmeth robust-proto :max-relative-error (x y)
  (max (/ (abs (- x y))
          (pmax (sqrt machine-epsilon)
                (abs y)))))

(defmeth robust-proto :robust-loop (&optional (epsilon .001)
                                              (limit 20)
                                              (c 4.685))
  (let* ((count 0)
        (last-beta nil)
        (beta (send self :coef-estimates))
        (rel-err 0)
        (weight-list nil))
  (if (equalp (send self :count) 0)
        (setf weight-list (list (send self :weights)))
        (setf weight-list (send self :weight-list)))
  (if (equalp (send self :count) 0)
      (send self :rsq-list (list (send self :r-squared)))) 
    (loop
     (send self :weights (send self :robust-weights c))
     (setf weight-list (remove 'nil (append weight-list (list (send self :weights)))))
     (send self :weight-list weight-list)
     (send self :count (+ (send self :count) 1))
     (setf count (+ count 1))
     (setf last-beta beta)
     (setf beta (send self :coef-estimates))
     (setf rel-err 
           (send self :max-relative-error beta last-beta))
     (send self :RSq-list (append (send self :RSq-list) 
                                    (list (send self :R-squared))))
     (when (or (< rel-err epsilon)
             (= limit count))
           (send self :compute)
           (return
            (list beta rel-err count))))))


(defmeth robust-proto :robust-bootstrap (&optional
                                         (nb 100)
                                         (epsilon .01))
  (let* ((n (send self :num-cases))
         (k (- (send self :num-coefs) 1))
         (x (send self :x))
         (y (send self :y))
         (result nil)
         (i-n (iseq n))
         (i-k (iseq k)))
    (dotimes (i nb)
       (let ((s (sample i-n n t)))
         (send self :x (select x s i-k))
         (send self :y (select y s))
         (send self :weights nil)
         (push (first (send self :robust-loop epsilon))
               result)))
    (send self :x x)
    (send self :y y)
    (send self :weights nil)
    (transpose result)))

; *****************************************************************

(defmeth morals-spreadplot-supervisor-proto :iterate ()
  (let* (
         (model (send (send self :model) :morals-model)) 
         (robmodel (send (send self :model) :robust-model))
         (method-item (send choice-item-proto :new
                            (list "Robust Regression"
                                  "Monotone Regression")
                            :value 0))
         (method-label (send text-item-proto :new "Choose a Method:"))
         (mono-text-item 
          (send text-item-proto :new "   Monotone Regression Options"))
         (min-rsq-text-item 
          (send text-item-proto :new "   Min RSQ Change: "))
         (min-rsq (send edit-text-item-proto :new "0.0001"))
         (max-rsq-text-item 
          (send text-item-proto :new "   Maximum RSquare:"))
         (max-rsq (send edit-text-item-proto :new "1.00"))
         (iter-text-item (send text-item-proto :new "Max Iterations:"))
         (iter (send edit-text-item-proto :new "1"))
         (iter1 nil)
         (cancel (send modal-button-proto :new "Cancel"
                       :action #'(lambda ()
                                   (let ((dialog (send cancel :dialog)))
                                     (send dialog :modal-dialog-return nil)))))
         (ok (send modal-button-proto :new "OK"
                   :action #'(lambda ()
                               (let ((dialog (send ok :dialog))
                                     (iter1 (with-input-from-string
                                             (s (send iter :text))
                                             (read s)) 1)
                                     (min-r (with-input-from-string
                                             (s (send min-rsq :text))
                                             (read s)) 1)
                                     (max-r (with-input-from-string
                                             (s (send max-rsq :text))
                                             (read s)) 1))
                               (setf iter2 iter1)
                               (cond ((equalp (send method-item :value) 0)
                                      (send robmodel :iterations iter2)                                                (send self :iterate3 iter2))   
                                     ((equalp (send method-item :value) 1)
                                      (send model :iterations iter2)
                                      (send model :minimum-rsq-improve min-r)
                                      (send model :maximum-rsq max-r)
                                      (send self :iterate2 iter2)))
                                      
                               (send dialog :modal-dialog-return t)))))
         (method-dialog (send modal-dialog-proto :new
                              (list method-label 
                                    (list
                                     (list method-item 
                                           (list iter-text-item iter))
                                     (list mono-text-item
                                           (list min-rsq-text-item min-rsq)
                                           (list max-rsq-text-item max-rsq)))
                                    
                                    (list ok cancel)))))
    (send method-dialog :modal-dialog)))

(defmeth morals-spreadplot-supervisor-proto :iterate2 (&optional iter1 show)
  (let* ((model (send (send self :model) :morals-model))
         (model2 (send self :model))
         (iter2 10)
         (mod (send self :model))
         (nobs (send mod :nobs))
         (pred2 (select (send mod :variables) (send mod :dv)))
         (pred (if (listp pred2) (select pred2 0) pred2)))
#|  (when (not iter1)
        (let* ( 
           (iter-text-item (send text-item-proto :new "Number of Monotone Iterations:"))
           (iter (send edit-text-item-proto :new "20" :text-length 6
                     :size (list 60 18)))
           (cancel (send modal-button-proto :new "Cancel"
                       :action #'(lambda ()
                                   (let ((dialog (send cancel :dialog)))
                                     (send dialog :modal-dialog-return nil)))))
           (ok (send modal-button-proto :new "OK"
                   :action #'(lambda ()
                               (let ((dialog (send ok :dialog))
                                     (iter1 (with-input-from-string
                                             (s (send iter :text))
                                             (read s)) 1)) 
                               (setf iter2 iter1)
                               (send dialog :modal-dialog-return t)))))
           (iter-dialog (send modal-dialog-proto :new
                              (list iter-text-item iter 
                                    (list ok cancel)))))
        (send iter-dialog :modal-dialog)))|#
 (if iter1 (setf iter2 iter1))
 (send model :iterations iter2)
 (when iter2
       (dotimes (i iter2)
          (send model :iterate-once) 
          (if (> (send model :minimum-rsq-improve)
              (select (- (last (send model :rsq-list))
                 (select (send model :rsq-list) (1- (send model :count)))) 0))
              (return))
          (if (< (send model :r-squared) (select (last (send model :rsq-list)) 0))
              (return)))
       (when (or (equalp (send model2 :method) "OLS") iter1)
             (send (send self :menu) :remove)
             (send self :menu-template 
                   '(trans-plot1 trans-plot2 resid-plot1 resid-plot2 
                     infl-plot1 infl-plot2 rsq-plot ; var-list 
                                 obs-list))
             (send self :new-menu)
           ; (if (not (equalp show "no")) (send (send self :menu) :install))
             (send (send self :transformation-plot) :new-menu "FitTrans")
             (send (send self :rsq-beta-plot) :showing t)
             (send (send self :influence-plot2) :hide-window)
             (send (send (send self :influence-plot2) :menu) :remove)
             (send (send self :influence-plot2) :showing nil)
            ; (send (send self :added-var-plot) :hide-window)
            ; (send (send (send self :added-var-plot) :menu) :remove)
            ; (send (send self :added-var-plot) :showing nil)
            ; (send (send self :var-list) :showing t)
             (send self :infl-type2 "MR-Lev")
             (send self :infl-type1 "MR-Cooks")
             (send self :resid-type1 "MR-Raw")
             (send self :resid-type2 "MR-Bayes")
             (when (equalp (send model2 :method) "OLS")
            ;       (send (send self :var-list) :show-window)
                   (send (send self :rsq-beta-plot) :show-window))
             (send model2 :method "Monotonic"))
       (send self :update-transformation-plot (send model :YRaw)
                  (send model :Y) (send model :YHat))
       (send (send self :transformation-plot)
                  :title "Fit and Transformation")
       (defmeth (send self :transformation-plot) :iter8 ()
         (send (send self :spreadplot-supervisor) :iterate2))
       (send (send self :influence-plot1) :title "Leverage and Influence")
       (send (send self :influence-plot1) :plot-buttons :new-x nil)
       (send (send self :transformation-plot) :variable-label '(0 1)
             (list pred (strcat "Monotone Predicted " pred)))
       (send (send self :transformation-plot) :adjust-to-data)
       (send self :update-rsq-beta-plot)
       (send self :update-residual-plot)
       (send self :update-influence-plot)
       (let* ((datamat (send model :x))
              (num (iseq (select (array-dimensions datamat) 1)))
              (y (send model :y))
              (dv2 (select (send mod :variables) (send mod :dv)))
              (dv (if (listp dv2) (select dv2 0) dv2)))
         (send self :update-added-var-plot 
               (send self :added-var-plot) nil datamat y dv nobs num mod)
                ))))                           

(defmeth morals-spreadplot-supervisor-proto :iterate3 (&optional iter1 show)
  (let* (
         (model2 (send self :model))
         (model (send model2 :robust-model))
         (iter2 nil))
  (when (not iter1) (setf iter2 1))
 #| (when (not iter1)
        (let* (
         (iter-text-item (send text-item-proto :new "Number of Robust Iterations:"))
         (iter (send edit-text-item-proto :new "20" :text-length 6
                     :size (list 60 18)))
         (cancel (send modal-button-proto :new "Cancel"
                       :action #'(lambda ()
                                   (let ((dialog (send cancel :dialog)))
                                     (send dialog :modal-dialog-return nil)))))
         (ok (send modal-button-proto :new "OK"
                   :action #'(lambda ()
                               (let ((dialog (send ok :dialog))
                                     (iter1 (with-input-from-string
                                             (s (send iter :text))
                                             (read s)) 1)) 
                                (setf iter2 iter1)
                                (send dialog :modal-dialog-return t)))))
         (iter-dialog (send modal-dialog-proto :new
                              (list iter-text-item iter 
                                    (list ok cancel)))))
    (send iter-dialog :modal-dialog)))|#
    (if iter1 (setf iter2 iter1))
    (send model :iterations iter2)
    (send model :robust-loop .001 iter2)
    (cond ((or (equalp (send model2 :method) "OLS") iter1)
           (send self :create-robust-plot)
           (send self :create-robust-reg-plot)
           (send (send self :robust-plot) :location (select loc23 0)
                 (select loc23 1))
           (send (send self :menu) :remove)
           (send self :infl-type2 "RR-Lev")
           (send self :infl-type1 "RR-Cooks")
           (send self :resid-type1 "RR-Raw")
           (send self :resid-type2 "RR-Bayes")
           (when (equalp (send model2 :method) "OLS")
                 (send (send self :robust-plot) :show-window)
                 (send (send self :robust-reg-plot) :show-window))
           (send model2 :method "Robust"))
      ((equalp (send model2 :method) "Robust")
       (send self :update-robust-plot)
       (send self :update-robust-reg-plot)
       (send (send self :robust-plot) :showing t)
       (send (send self :robust-reg-plot) :showing t)))
    ;(send (send self :added-var-plot) :hide-window)
    ;(send (send self :added-var-plot) :showing nil)
    ;(send (send (send self :added-var-plot) :menu) :remove)
    ;(send (send self :robust-plot) :location 
           ;      (select loc22 0) (select loc22 1))
    (send (send self :robust-plot) :showing t)
    (send (send self :robust-reg-plot) :showing t)
    (send (send self :rsq-beta-plot) :hide-window)
    (send (send (send self :rsq-beta-plot) :menu) :remove)
    (send (send self :rsq-beta-plot) :showing nil)
    (send (send self :influence-plot2) :hide-window)
    (send (send (send self :influence-plot2) :menu) :remove)
    (send (send self :influence-plot2) :showing nil)
    (send (send self :influence-plot1) :title "Leverage and Influence")
    (send (send self :influence-plot1) :plot-buttons :new-x nil)
    ;(send (send self :var-list) :hide-window)
    ;(send (send (send self :var-list) :menu) :remove)
    ;(send (send self :var-list) :showing nil)
    (send (send self :transformation-plot) :hide-window)
    (send (send (send self :transformation-plot) :menu) :remove)
    (send (send self :transformation-plot) :showing nil)
    (send self :update-residual-plot)
    (send self :update-influence-plot)
    (let* ((datamat (send model :x))
           (num (iseq (select (array-dimensions datamat) 1)))
           (y (send model :y))      
           (nobs (send model2 :nobs))
           (dv2 (select (send model2 :variables) (send model2 :dv)))
           (dv (if (listp dv2) (select dv2 0) dv2)))
      (send self :update-added-var-plot 
            (send self :added-var-plot) nil datamat y dv nobs num model2))
    ))
 
(defmeth morals-spreadplot-supervisor-proto :create-robust-reg-plot ()
  (let* (
         (rrp (send robust-reg-plot-proto :new self))
         (mod (send self :model))
         (robmodel (send (send self :model) :robust-model))
         (labels (send mod :labels))
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         )
    (send rrp :variable-label '(0 1) 
          (list dv  (strcat "Robust Predicted " dv)))
    (send rrp :add-points (send robmodel :y)
          (send robmodel :fit-values) :point-labels labels)
    (send rrp :plot-buttons :new-x nil :new-y nil :iterate t)
    #+color(when (> *color-mode* 0)
                 (send rrp :use-color t)
                 (send rrp :point-color 
                       (iseq (send rrp :num-points)) 'blue))
    (send rrp :mouse-mode 'brushing)
    (send rrp :showing t)
    (send rrp :showing-labels t)
    (send rrp :size (+ plot-size window-decoration-width) plot-size)
    (send rrp :location (select loc12 0) (select loc12 1))
    (send rrp :linked t)
    (send rrp :adjust-to-data)
    (send rrp :abline 0 1)
    (send self :robust-reg-plot rrp)))

(defmeth morals-spreadplot-supervisor-proto :update-robust-reg-plot ()
  (let* (
         (rrp (send self :robust-reg-plot))
         (robmodel (send (send self :model) :robust-model))
         (labels (send (send self :model) :labels))
         )
    (send rrp :clear-points)
    (send rrp :add-points (send robmodel :y)
                         (send robmodel :fit-values) :point-labels labels)
    #+color(when (> *color-mode* 0)
                 (send rrp :use-color t)
                 (send rrp :point-color 
                       (iseq (send rrp :num-points)) 'blue))
    (send rrp :abline 0 1)
    (send rrp :adjust-to-data)
    ))


(defproto robust-plot-proto '(spreadplot-supervisor showing) ()
  scatterplot-proto ())

(defmeth robust-plot-proto :spreadplot-supervisor (&optional (obj-id nil set))
  (when set (setf (slot-value 'spreadplot-supervisor) obj-id))
  (slot-value 'spreadplot-supervisor))

(defmeth robust-plot-proto :showing (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'showing) obj-id)) 
  (slot-value 'showing))

(defmeth robust-plot-proto :show-plot ()
  (send self :show-window)
  (send self :showing t))

(defmeth robust-plot-proto :close ()
  (send (send self :spreadplot-supervisor) :close-dialog self)
  )

(defmeth robust-plot-proto :isnew (ssp &rest args
                                       &key
                                       (title "Robust Weights")
                                       (menu-title "Weights")
                                       (scale 'nil)
                                       (show 't))
  (send self :spreadplot-supervisor ssp)
  (apply #'call-next-method 2
         (append args `(:title ,title :menu-title ,menu-title :show nil)))
  (send self :plot-buttons :new-x nil :new-y nil)
  
  )




; ****************** Robust Regression Plot ********************


(defproto robust-reg-plot-proto '(spreadplot-supervisor showing) ()
  scatterplot-proto ())

(defmeth robust-reg-plot-proto :spreadplot-supervisor (&optional (obj-id nil set))
  (when set (setf (slot-value 'spreadplot-supervisor) obj-id))
  (slot-value 'spreadplot-supervisor))

(defmeth robust-reg-plot-proto :showing (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'showing) obj-id)) 
  (slot-value 'showing))

(defmeth robust-reg-plot-proto :show-plot ()
  (send self :show-window)
  (send self :showing t))

(defmeth robust-reg-plot-proto :close ()
  (send (send self :spreadplot-supervisor) :close-dialog self)
  )

(defmeth robust-reg-plot-proto :iter8 ()
  (send (send self :spreadplot-supervisor) :iterate3)
  )

(defmeth robust-reg-plot-proto :isnew (ssp &rest args
                                       &key
                                       (title "Robust Fit")
                                       (menu-title "Fit")
                                       (scale 'nil)
                                       (show 't))
  (send self :spreadplot-supervisor ssp)
  (apply #'call-next-method 2
         (append args `(:title ,title :menu-title ,menu-title :show nil))))