;;########################################################################
;; regvis3.lsp
;; Visualization for OLS, Robust & Monotonic Regression ViSta model object
;; This file contains LSMT-plot-proto, rsq-plot-proto and supervisor code
;; Copyright (c) 1995-6 by Carla M. Bann
;;########################################################################

(defproto scatterplot2-proto () () scatterplot-proto)

(defmeth scatterplot2-proto :isnew (x &rest args &key point-labels symbol color) 
"Args: x &rest args &key point-labels symbol color
X is a list of at least two equal length lists of data.  The first two lists are plotted as the scatterplot, the remaining lists are additional dimensions which may be shown with the :current-variables message. ARGS may be any keyword argument understood by the :isnew methods for graph-proto and graph-window-proto. POINT-LABELS, SYMBOL, and COLOR set the labels, symbol and color of the points." 
  (let* ((ndim (length x))
         (npts (length (first x)))
         (w (apply #'call-next-method ndim :show nil args)))
    (send w :add-points x)
    (when symbol (send w :point-symbol (iseq npts) symbol))
    #+color (when (and (> *color-mode* 0) color)  
                  (send w :use-color t)
                  (send w :point-color (iseq npts) color))
    (when point-labels (send w :point-label (iseq npts) point-labels)) 
    (send w :adjust-to-data)
    w))
    
;redefine plot-points using the new scatterplot2-proto

(defun plot-points2  (x &rest args &key (show t))
"Args: x & rest args &key (show t)
X is a list of at least two equal length lists of data, OR a list of values.  In the latter case, the next argument must be Y.  The former case allows:
(plot-points (list x y)) whereas the latter case allows (plot-points x y)
both forms being used in Tierney's book.  We can also specify
(plot-points (list x y z)) for higher-dimensional scatterplots. The first two lists are plotted as the scatterplot, the remaining lists are additional dimensions which may be shown with the :current-variables message. ARGS may be any keyword argument understood by the :isnew methods for scatterplot2-proto."
  (let ((x (if (vectorp x) (coerce x 'list) x)))
    (when (not (listp (first x)))
          (setf x (list x (first args)))
          (setf args (rest args))) 
    (let ((w (apply #'send scatterplot2-proto :new x :show nil args)))
      (when show (send w :show-window))
      w)))

#|**************************************************************************
Define LSMT-PLOT-PROTO (inherits from scatterplot2-proto)
**************************************************************************|#

; defproto

(defproto LSMT-PLOT-PROTO '(spreadplot-supervisor showing) () scatterplot2-proto ())

; slot-accessor method

(defmeth LSMT-PLOT-PROTO :spreadplot-supervisor (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'spreadplot-supervisor) obj-id)) 
  (slot-value 'spreadplot-supervisor))

(defmeth LSMT-PLOT-PROTO :showing (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'showing) obj-id)) 
  (slot-value 'showing))

(defmeth LSMT-PLOT-PROTO :show-plot ()
  (send self :show-window)
  (send self :showing t))

; constructor function

(defun lsmt-plot (raw trans fit &rest args &key (show t))                     
  (let ((p (apply #'send LSMT-PLOT-PROTO :new raw trans fit args)))
    (when show (send p :show-window))
    p))


; object-specific methods

(defmeth LSMT-PLOT-PROTO :update-plot (raw trans fit)
  (let* ((rank-order (order raw))
         (X (select raw rank-order))
         (Y (select trans rank-order))
         )
    (send self :clear-lines)
    (send self :add-lines X Y)
    (send self :clear-points)
    (send self :add-points raw fit)
    (send self :abline 0 1)
    (send self :adjust-to-data) 
    self))



; object-specific methods

(defmeth morals-spreadplot-supervisor-proto :update-transformation-plot (raw trans fit) 
  (let* ((rank-order (order raw))
         (X (select raw rank-order))
         (Y (select trans rank-order))
         (plot (send self :transformation-plot))
         (labels (send (send self :model) :labels))
         (color 'black)
         (line-color 'black)
         )  
    #+color(when (> *color-mode* 0)
                 (setf color 'blue)
                 (setf line-color 'red) 
                 (send plot :use-color t))
    (send plot :clear-lines)
    (send plot :add-lines X Y :color line-color)
    (send plot :clear-points)
    (send plot :add-points raw fit :point-labels labels :color color)
    (send plot :abline 0 1)
    (send plot :adjust-to-data) 
    plot))


(defmeth LSMT-PLOT-PROTO :isnew (raw trans fit ssp &rest args) 
  (let* ((rank-order (order raw))
         (X (select raw rank-order))
         (Y (select trans rank-order))
         (labels (send (send ssp :model) :labels))
         (color 'black)
         (line-color 'black)
         )  
    #+color(when (> *color-mode* 0)
                 (setf color 'blue)
                 (setf line-color 'red) 
                 (send self :use-color t))
    (send self :spreadplot-supervisor ssp)
    (send self :menu-title "Fit")
    (apply #'call-next-method (list raw fit) 
           :title "Fit" ;LS Monotone Transformation
           args)
    (apply #'send self :range 1 (send self :range 0)) 
    (send self :clear-lines)
    (send self :add-lines X Y :color line-color)
    (send self :clear-points)
    (send self :mouse-mode 'brushing)
    (send self :add-points raw fit :point-labels labels :color color)
    (send self :abline 0 1)
    (send self :adjust-to-data) 
    (when (not (send ssp :simple-reg))
          (send self :plot-buttons :new-x nil :new-y nil :iterate t))
  self))

(defmeth LSMT-PLOT-PROTO :iter8 ()
  (send (send self :spreadplot-supervisor) :iterate)
  )

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


(defun lsmt-plot (raw trans fit ssp &rest args &key (show t))                     
  (let ((p (apply #'send LSMT-PLOT-PROTO :new raw trans fit ssp args)))
    (when show (send p :show-window))
    p))

(setf *rsq-plots* nil)

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

(defmeth rsq-plot-proto :links ()
  (if (member self *rsq-plots*) *rsq-plots*))


(defmeth rsq-plot-proto :linked (&optional (link nil set))
  (when set (setf *rsq-plots* (if link (cons self *rsq-plots*)
                                  (remove self *rsq-plots*)))
            (call-next-method link))
  (call-next-method))

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

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

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


(defun rsq-plot (spreadplot-supervisor &rest args)
  (apply #'send rsq-plot-proto :new spreadplot-supervisor args))


(defmeth rsq-plot-proto :isnew
  (spreadplot-supervisor 
     &rest args
     &key
     (title "R-Square Beta Plot")
     (menu-title "RSQ-Beta")
     (scale 'nil)
     (show 't))
  (send self :spreadplot-supervisor spreadplot-supervisor)
  (apply #'call-next-method 2 
         (append args `(:title ,title :menu-title ,menu-title
                        :show nil)))
)

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


(defmeth morals-spreadplot-supervisor-proto :update-rsq-beta-plot () 
  (let* (
         (plot (send self :rsq-beta-plot))
         (i 0)
         (j 0)
         (k 0)
         (iter-list nil)
         (rsq-beta-list nil)
         (iteration-list nil)
         (model (send (send self :model) :morals-model))
         (count (send model :count))
         (rsq-list (send model :rsq-list))
         )
    (dotimes (k (send model :count))
             (setf iteration-list (append iteration-list 
                             (list (repeat k (length 
                             (send (send self :model) :iv))))))) 

    (dotimes (j (length (first (send model :standardized-beta-list))))
           (dotimes (i (length (send model :standardized-beta-list)))   
                    (setf rsq-beta-list (append rsq-beta-list (list 
                                  (select (select 
                                  (send model :standardized-beta-list) i) 
                                          j))))
                    (setf iter-list (append iter-list (list (select (select
                                    iteration-list i) j)))))
           (send plot :add-lines iter-list rsq-beta-list)
           (send plot :add-points iter-list rsq-beta-list)
           (send plot :add-lines (iseq count) rsq-list)
           (send plot :add-points (iseq count) rsq-list)
           (setf i 0)
           (setf iter-list nil)
           (setf rsq-beta-list nil))
    (send plot :adjust-to-data)
    (send self :rsq-beta-plot plot) 
    plot))

(defmeth morals-spreadplot-supervisor-proto :update-residual-plot ()
  (let* ((resid-list (list "MR-Raw" "MR-Bayes" "MR-Student" "MR-External"
                           "RR-Raw" "RR-Bayes" "RR-Student" "RR-External"  
                           "LR-Raw" "LR-Bayes" "LR-Student" "LR-External"))
         (resid-type (send self :resid-type1))
         (mod (send self :model))
         (model (send mod :morals-model))
         (model2 nil)
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (mpred (strcat "Monotone Predicted " dv))
         (opred (strcat "OLS Predicted " dv))
         (rpred (strcat "Robust Predicted " dv))
         (lin-reg (send mod :lin-reg-model))
         (i 0)
         (j 0)
         (initial-index nil)
         (r (/ (send model :residuals) (send model :sigma-hat)))
         (r2 (/ (send lin-reg :residuals) (send lin-reg :sigma-hat)))
         (d (* 2 (sqrt (send model :leverages))))
         (low (- r d))
         (high (+ r d))
         (x-values (send model :fit-values))
         (x-values2 (send lin-reg :fit-values))
         (plot (send self :residual-plot1))
         (labels (send mod :labels))
         (color 'black)
        )
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (if (equalp (send mod :method) "Robust") 
        (setf model2 (send mod :robust-model))
        (setf model2 (send mod :morals-model)))
    (dotimes (j 2)
    (dotimes (i 12)
             (if (equalp resid-type (select resid-list i))
                 (setf initial-index i)))
    (case initial-index
      (0 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :raw-residuals) :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list mpred "Monotone Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (1 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points x-values r :color color :point-labels labels)
         (map 'list #'(lambda (a b c d) (send plot :plotline a b c d nil))
               x-values low x-values high)
         (send plot :variable-label '(0 1) (list mpred "Bayes Monotone Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (2 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :studentized-residuals) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list mpred "Standardized Monotone Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (3 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model2 :fit-values) 
               (send model2 :externally-studentized-residuals)
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list mpred "Monotone Externally Studentized Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (4 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :residuals) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list rpred "Weighted Robust Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (5 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points x-values r 
               :color color :point-labels labels)
         (map 'list #'(lambda (a b c d) (send plot :plotline a b c d nil))
               x-values low x-values high)
         (send plot :variable-label '(0 1) (list rpred "Bayes Robust Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (6 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :studentized-residuals) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list rpred "Standardized Robust Residuals")) 
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (7 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model2 :fit-values) 
               (send model2 :externally-studentized-residuals)
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list rpred "Robust Externally Studentized Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (8 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :raw-residuals) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list opred "OLS Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (9 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points x-values2 r2 
               :color color :point-labels labels)
         (map 'list #'(lambda (a b c d) (send plot :plotline a b c d nil))
               x-values low x-values2 high)
         (send plot :variable-label '(0 1) (list opred "Bayes OLS Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (10 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :studentized-residuals) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list opred "Standardized OLS Residuals")) 
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data))
      (11 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send lin-reg :fit-values) 
               (send lin-reg :externally-studentized-residuals)
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list opred "OLS Externally Studentized Residuals"))
         (send plot :abline 0.0 0.0)
         (send plot :adjust-to-data)))
   (setf plot (send self :residual-plot2))
   (setf resid-type (send self :resid-type2))
   (setf j 1)          
)))






(defmeth morals-spreadplot-supervisor-proto :update-influence-plot ()
  (let* ((infl-list (list "MR-Lev" "MR-Cooks" "RR-Lev" "RR-Cooks" "LR-Lev" "LR-Cooks"))
         (infl-type (send self :infl-type1))
         (mod (send self :model))
         (model (send mod :morals-model))
         (model2 nil)
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (lin-reg (send mod :lin-reg-model))
         (i 0)
         (j 0)
         (initial-index nil)
         (x-values (send model :fit-values))
         (x-values2 (send lin-reg :fit-values))
         (plot (send self :influence-plot1))
         (labels (send mod :labels))
         (color 'black)
        )
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (if (equalp (send mod :method) "Robust") 
        (setf model2 (send mod :robust-model))
        (setf model2 (send mod :morals-model)))
    (dotimes (j 2)
    (dotimes (i 6)
            (if (equalp infl-type (select infl-list i))
                (setf initial-index i)))
    (case initial-index
      (0 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :leverages) :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Monotone Predicted " dv) "Monotone Leverages"))
         (send plot :adjust-to-data))
      (1 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :cooks-distances) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Monotone Predicted " dv) "Monotone Cook's Distances"))
         (send plot :adjust-to-data))
      (2 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :leverages) :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Robust Predicted " dv) "Robust Leverages"))
         (send plot :adjust-to-data))
      (3 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :cooks-distances) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Robust Predicted " dv) "Robust Cook's Distances"))
         (send plot :adjust-to-data))
      (4 (send plot :clear-points)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :leverages) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "OLS Predicted " dv) "OLS Leverages"))
         (send plot :adjust-to-data))
      (5 (send plot :clear-points)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :cooks-distances) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "OLS Predicted " dv) "OLS Cook's Distances"))
         (send plot :adjust-to-data)))
    (setf plot (send self :influence-plot2))
    (setf infl-type (send self :infl-type2))
    (setf j 1))))


(defmeth morals-spreadplot-supervisor-proto :create-robust-plot ()
  (let* (
         (rp (send robust-plot-proto :new self
                   :variable-labels '("Iterations" "Observation Weights")))
         (model (send (send self :model) :robust-model))
         (iteration-list nil)
         (iter-list nil)
         (wl nil)
         (nobs (send (send self :model) :nobs))
         (index 0)
         (len (length (remove 'nil (send model :weight-list))))
         (labels (send (send self :model) :labels))
         (color 'black)
         )
  (setf wl (remove 'nil (combine (send model :weight-list))))
  (send rp :add-points (list (repeat (1- (send model :count)) nobs) 
                                      (combine (last (send model :weight-list))))
                 :point-labels (send (send self :model) :labels))
     #+color(when (> *color-mode* 0)
                  (send rp :use-color t)
                  (setf color 'blue)
                  (send rp :point-color 
                        (iseq (send rp :num-points)) 'blue))
  (dotimes (k nobs)
           (send rp :add-lines (iseq len)
                                (select wl 
                                   (+ (* (iseq len) nobs)
                                   index)) :color color)
           (setf index (+ index 1)))
  (send rp :size (+ plot-size window-decoration-width) plot-size)
  (send rp :linked t)
  (send rp :showing-labels t)
  (send rp :mouse-mode 'brushing)
  (send rp :adjust-to-data)
  (send rp :showing t)
  (send self :robust-plot rp)))




(defmeth morals-spreadplot-supervisor-proto :update-robust-plot ()
  (let* (
         (rp (send self :robust-plot))
         (model (send (send self :model) :robust-model))
         (iteration-list nil)
         (iter-list nil)
         (wl nil)
         (nobs (send (send self :model) :nobs))
         (index 0)
         (len (length (remove 'nil (send model :weight-list))))
         (color 'black)
         )
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (send rp :clear-points)
    (send rp :clear-lines) 
    (setf wl (remove 'nil (combine (send model :weight-list))))
    (send rp :add-points (list (repeat (1- (send model :count)) nobs)
                               (combine (last (send model :weight-list))))
          :color color
          :point-labels (send (send self :model) :labels))
    (dotimes (k nobs)
             (send rp :add-lines (iseq len)
                   (select wl (+ (* (iseq len) nobs) index))
                   :color color)
             (setf index (+ index 1)))
    (send rp :adjust-to-data)))

