;;########################################################################
;; regvis4.lsp
;; Visualization for OLS, Robust & Monotonic Regression ViSta model object
;; This file contains moral-spreadplot-supervisor-proto code
;; and varlist and obslist proto code
;; Copyright (c) 1995-6 by Carla M. Bann. 
;;########################################################################

(defproto var-list-proto '(spreadplot-supervisor showing) ()
  name-list-proto ())

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

(defmeth var-list-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 var-list-proto :spreadplot-supervisor (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'spreadplot-supervisor) obj-id)) 
  (slot-value 'spreadplot-supervisor))


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


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

(defmeth var-list-proto :close ()
  (send (send self :spreadplot-supervisor) :close-dialog self)
  )

(defmeth var-list-proto :isnew (ssp &rest args)
  (let* (
         (vars (select (send (send ssp :model) :variables)
                       (send (send ssp :model) :iv)))
         (nvars (length vars))
         (vl (call-next-method 0 :show nil))
         )
  (send vl :spreadplot-supervisor ssp)
  (send vl :add-points (list (iseq nvars)))
  (send vl :point-label (iseq nvars) vars)
  (send vl :title "Predictor Variables")
  (send vl :adjust-to-data)
 vl))

(defproto obs-list-proto '(spreadplot-supervisor showing) ()
  name-list-proto ())


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


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


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


(defmeth obs-list-proto :close ()
  (send (send self :spreadplot-supervisor) :close-dialog self)
  )

(defmeth obs-list-proto :isnew (ssp &rest args)
  (let* (
         (obs (send current-data :labels))
         (nobs (length obs))
         (ol (call-next-method 0 :show nil))
         )
  (send ol :spreadplot-supervisor ssp)
  (send ol :add-points (list (iseq nobs)))
  (send ol :point-label (iseq nobs) obs)
  (send ol :title "Observations")
  (send ol :adjust-to-data)
 ol))



(defmeth morals-spreadplot-supervisor-proto :choose-location (plot)

 #+macintosh 
    (let* (
         (loc-item1 (send toggle-item-proto :new "Upper Left" :location (list 10 10)))
         (loc-item2 (send toggle-item-proto :new "Upper Middle" :location (list 110 10)))
         (loc-item3 (send toggle-item-proto :new "Upper Right" :location (list 225 10)))
         (loc-item4 (send toggle-item-proto :new "Lower Left" :location (list 10 35)))
         (loc-item5 (send toggle-item-proto :new "Lower Middle" :location (list 110 35)))
         (loc-item6 (send toggle-item-proto :new "Lower Right" :location (list 225 35)))
         (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)))
                               (if (equalp (send loc-item1 :value) t)
                                   (send plot :location 
                                         (select loc11 0) (select loc11 1)))
                               (if (equalp (send loc-item2 :value) t)
                                   (send plot :location 
                                         (select loc12 0) (select loc12 1)))
                               (if (equalp (send loc-item3 :value) t)
                                   (send plot :location 
                                         (select loc13 0) (select loc13 1)))
                               (if (equalp (send loc-item4 :value) t)
                                   (send plot :location 
                                         (select loc21 0) (select loc21 1)))
                               (if (equalp (send loc-item5 :value) t)
                                   (send plot :location 
                                         (select loc22 0) (select loc22 1)))
                               (if (equalp (send loc-item6 :value) t)
                                   (send plot :location 
                                         (select loc23 0) (select loc23 1)))
                               (send dialog :modal-dialog-return t)))))   

         (loc-dialog (send modal-dialog-proto :new 
                      (list (list loc-item1 loc-item2 loc-item3)
                            (list loc-item4 loc-item5 loc-item6)
                            (list ok cancel)))))
        (send loc-dialog :modal-dialog))

 #-macintosh
        (let* ((loc-item (send choice-item-proto :new
                   (list "Upper Left" "Upper Middle" "Upper Right" "Lower Left" 
                         "Lower Middle" "Lower Right")))
              (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)))
                               (if (equalp (send loc-item :value) 0)
                                   (send plot :location 
                                         (select loc11 0) (select loc11 1)))
                               (if (equalp (send loc-item :value) 1)
                                   (send plot :location 
                                         (select loc12 0) (select loc12 1)))
                               (if (equalp (send loc-item :value) 2)
                                   (send plot :location 
                                         (select loc13 0) (select loc13 1)))
                               (if (equalp (send loc-item :value) 3)
                                   (send plot :location 
                                         (select loc21 0) (select loc21 1)))
                               (if (equalp (send loc-item :value) 4)
                                   (send plot :location 
                                         (select loc22 0) (select loc22 1)))
                               (if (equalp (send loc-item :value) 5)
                                   (send plot :location 
                                         (select loc23 0) (select loc23 1)))
                               (send dialog :modal-dialog-return t))))) 
              (loc-dialog (send modal-dialog-proto :new 
                      (list loc-item
                            (list ok cancel)))))
        (send loc-dialog :modal-dialog)))

(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) 1))
         (rsq-list (send model :rsq-list))
         (color 'black)
         )
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (send plot :clear-points)
    (send plot :clear-lines)
    (dotimes (k count)
             (setf iteration-list (append iteration-list 
                             (list (repeat k (length (first 
                                   (send model :standardized-beta-list))))))))
    (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 :color color)
           (send plot :add-lines (iseq count) rsq-list :color color)
           (setf i 0)
           (setf iter-list nil)
           (setf rsq-beta-list nil))
    (send plot :add-points (list (repeat (send model :count) 
          (length (combine (last (send model :standardized-beta-list)))))
                  (combine (last (send model :standardized-beta-list))))
          :color color
          :point-labels (select (send (send self :model) :variables)
                                (send (send self :model) :iv)))
    (when (equalp (send model :count) 0)
          (send plot :add-points (list 0) (list (send model :r-squared))
                 :color color))
    (when (> (send model :count) 0)
          (send plot :add-points (list (send model :count)) 
                     (list (select (send model :rsq-list) 
                                   (send model :count)))
                :color color
                :point-labels (list "RSQ")))
    (send plot :adjust-to-data)
    (send self :rsq-beta-plot plot) 
    plot))


(defmeth morals-spreadplot-supervisor-proto :create-plots () 
  (let* (
         (i 0)
         (j 0)
         (k 0)
         (iteration-list nil)
         (iter-list nil)
         (rsq-beta-list nil)
         (a 0)
         (model (send (send self :model) :morals-model))
         (dv2 (select (send (send self :model) :variables) 
                     (send (send self :model) :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (pred (strcat "OLS Predicted " dv))
         (count (+ (send model :count) 1))
         (rsq-list (send model :rsq-list))
         (model2 (send self :model))
         (lin-reg (send model2 :lin-reg-model))
         (datamat (send model2 :data-matrix))
         (nobs (send model2 :nobs))
         (plots nil)
         (x (combine (select datamat (iseq nobs) (select 
                                                 (send model2 :iv) 0))))
         (otherxs (select datamat (iseq nobs) (remove 
                                  (select (send model2 :iv) 0)
                                          (send model2 :iv))))
         (simple-reg 
          (= (second (array-dimensions otherxs)) 0));fwy 3.31 10/30/97 
         (y (combine (select datamat (iseq nobs) (send model2 :dv))))
         (yx-mod (regression-model otherxs y :print nil))
         (xx-mod (regression-model otherxs x :print nil))
         (rsqp (rsq-plot self :variable-labels '("Iterations"
                                            "R-Square/Betas")
                              :title "R-Square and Betas"
                              :go-away t
                              :show nil))
         (rp1 (residual-plot self (send model :fit-values)
                            (send model :raw-residuals)
                            :go-away t
                            :show nil :title "Residuals"
                            ))
         (ip1 (influence-plot self (send model :fit-values)
                            (send model :cooks-distances)
                            :title "Influence"
                            :go-away t
                            :show nil))
         (tp1 nil)
         (rp2 (residual-plot self (send model :fit-values)
                            (send model :raw-residuals)
                            :show nil
                            :go-away t
                            :title "Residuals"))
         (ip2 (influence-plot self (send model :fit-values)
                            (send model :leverages)
                            :title "Leverage"
                            :menu-title "Leverage"
                            :go-away t
                            :show nil))
         (lr (lin-reg-plot self (send lin-reg :Y) (send lin-reg :fit-values) 
                         :title "Fit" ;"OLS Regression" fwy 3.31 10/31/97
                         :go-away t
                         :show nil))
         ;(var-list (send var-list-proto :new self))
         (obs-list (send obs-list-proto :new self))
         (av (if simple-reg;fwy 3.31 10/30/97 changed for simple reg vis
                 (added-var-plot  self x y :show nil :simple-reg simple-reg)
                 (added-var-plot  self 
                                  (send xx-mod :residuals) 
                                  (send yx-mod :residuals) :show nil)))
         (color 'black)
         )
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (setf *current-spreadplot* self)
    (defmeth self :spreadplot-help ()
      (plot-help-window (strcat "SpreadPlot Help"))
      (paste-plot-help (format nil "This is the SpreadPlot for Simple Regression. "))
      (show-plot-help)
      (send spreadplot-proto :spreadplot-help :points t :labels t :flush nil))
    (when simple-reg (send model2 :simple-reg t))
    (if simple-reg ;fwy 3.31 10/30/97 changed for simple reg vis
        
        (send av :variable-label '(0 1)
              (list (select (send model2 :variables) 
                            (select (send model2 :iv) 0))
                    dv))    
        (send av :variable-label '(0 1) 
              (list (strcat (select (send model2 :variables) 
                                    (select (send model2 :iv) 0))
                            "|Other Vars") 
                    (strcat dv "|Other Vars"))))
    
    (if (= (send model :count) 0)
        (setf tp1 (lsmt-plot (send model :YRaw) (send model :Y)
                             (send model :fit-values) self 
                             :title "Fit and Transformation" ;
                             :show nil))
        (setf tp1 (lsmt-plot (send model :YRaw) (send model :Y)
                             (send model :YHat) self
                             :title "Fit  and Transformation"
                             :show nil)))
    (when (> (send model :count) 0)
          (defmeth tp1 :iter8 ()
            (send (send self :spreadplot-supervisor) :iterate2)
            ))
    (send rp1 :variable-label '(0 1) (list pred "OLS Raw Residuals"))
    (send ip1 :variable-label '(0 1) (list pred "OLS Cook's Distances"))
    (send rp2 :variable-label '(0 1) (list pred "OLS Raw Residuals"))
    (send ip2 :variable-label '(0 1) (list pred "OLS Leverages"))
    (send av  :location (select loc11 0) (select loc11 1))
    (send lr  :location (select loc12 0) (select loc12 1)) ;tp1
    (send rp1 :location (select loc13 0) (select loc13 1))
    (send rp2 :location (select loc13 0) (select loc13 1))
    (send ip1 :location (select loc22 0) (select loc22 1))
    (send ip2 :location (select loc23 0) (select loc23 1))
    (cond 
      (simple-reg
       (apply #'send av :abline (send model :coef-estimates))
       )
      (t
       (send tp1  :location (select loc12 0) (select loc12 1))
       (send rsqp :location (select loc23 0) (select loc23 1))
       ))
    (send rsqp :showing-labels t)
    (send rsqp :mouse-mode 'brushing)
    (send rsqp :plot-buttons :new-x nil :new-y nil)
    (send lr :showing-labels t)
    (send ip1 :showing-labels t)
    (send ip2 :showing-labels t)
    (send lr :location (select loc12 0) (select loc12 1))
    (send obs-list :location (select loc21 0) (select loc21 1))
    (send obs-list :has-h-scroll (max (screen-size)))
    (send obs-list :has-v-scroll (max (screen-size)))
    (send obs-list :showing-labels t)
    (send obs-list :fix-name-list)
    ;(send var-list :location (select loc22 0) (select loc22 1))
    ;(send var-list :has-h-scroll (max (screen-size)))
    ;(send var-list :has-v-scroll (max (screen-size)))
    ;(send var-list :showing-labels t)
    ;(send var-list :fix-name-list)
    (send rp1 :abline 0.0 0.0)
    (send rp1 :showing-labels t)
    (send rp2 :abline 0.0 0.0)
    (send rp2 :showing-labels t)
    (send tp1 :variable-label '(0 1) (list dv pred))
    (send tp1 :showing-labels t)
    (send tp1 :redraw)
    (when simple-reg 
          (send av :title "Regression"))
    (send av :showing-labels t)
    (send lr :abline 0 1)
    (send self :residual-plot1 rp1)
    (send self :residual-plot2 rp2)
    (send self :influence-plot1 ip1)
    (send self :influence-plot2 ip2)
    (send self :transformation-plot tp1)
    (send self :lin-reg-plot lr)
    (send self :added-var-plot av)
    ;(send self :var-list var-list)
    (send self :obs-list obs-list)
    (send self :resid-type1 "LR-Raw")
    (send self :resid-type2 "LR-Bayes")
    (send self :infl-type1 "LR-Cooks")
    (send self :infl-type2 "LR-Lev")
    (send self :update-residual-plot)
    
    (when (> (send model :count) 0)
          (dotimes (k count)
             (setf iteration-list (append iteration-list 
                             (list (repeat k (length (first 
                                             (send model :standardized-beta-list)))))))))
    (send rsqp :clear-points)
    (send rsqp :clear-lines)
    (dotimes (k count)
             (setf iteration-list (append iteration-list 
                             (list (repeat k (length (first 
                                   (send model :standardized-beta-list))))))))
    (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 rsqp :add-lines iter-list rsq-beta-list)
           (send rsqp :add-lines (iseq count) rsq-list)
           (setf i 0)
           (setf iter-list nil)
           (setf rsq-beta-list nil))
    (send rsqp :add-points (list (repeat (send model :count) 
            (length (combine (last (send model :standardized-beta-list)))))
                    (combine (last (send model :standardized-beta-list))))
            :point-labels (select (send (send self :model) :variables)
                                (send (send self :model) :iv)))
    (when (equalp (send model :count) 0)
          (send rsqp :add-points (list 0) (list (send model :r-squared))))
    (when (> (send model :count) 0)
          (send rsqp :add-points (list (send model :count)) 
                     (list (select (send model :rsq-list) 
                                   (send model :count)))
                :color color
                :point-labels (list "RSQ")))
    #+color(when (> *color-mode* 0) (send rsqp :use-color t))

    (send rsqp :location (select loc23 0) (select loc23 1))
    (send self :rsq-beta-plot rsqp)    
    (mapcar #'(lambda (x) (send x :size (+ plot-size window-decoration-width) 
                                plot-size)
                          (send x :linked t)
                          (send x :adjust-to-data)) (send self :all-plots))
   ; (setf plots (remove (send self :var-list) (send self :all-plots)))
    (setf plots (remove (send self :obs-list) plots))
    (when (not simple-reg)
          (mapcar #'(lambda (plot) 
   ;                  (send plot :add-overlay (make-overlay2 plot self))
                      #+color(when (> *color-mode* 0)
                                  (send plot :use-color t)
                                  (send plot :point-color 
                                        (iseq (send plot :num-points)) 'blue))
                      (send plot :mouse-mode 'brushing)
                      (send plot :add-plot-help-item)) 
                  (list av tp1 rp2 obs-list ip1 ip2)));plots
    (cond 
      (simple-reg
       (let ((nptseq (iseq (send av :num-points))))
         (mapcar #'(lambda (plot)
                     #+color(when (> *color-mode* 0)
                                  (send plot :use-color t)
                                  (send plot :point-color nptseq 'blue))
                     (send plot :mouse-mode 'brushing)
                     (send plot :plot-buttons :new-x nil :new-y nil)
                     )
                 (list av lr ip1 ip2))
         (send rp2 :mouse-mode 'brushing)
         (send rp2 :plot-buttons :new-x nil)
         (send obs-list :mouse-mode 'brushing))
       (mapcar #'(lambda (plot) 
                   (send plot :showing t)
                   (send plot :add-plot-help-item));originally had av in list
               (list av lr rp2 obs-list ip1 ip2))) ;tp1 and lr are the same
      (t
   ;    (send rsqp :add-plot-help-item)   ;Leave these here, but remove
   ;    (send lr :add-plot-help-item)     ;comment and get titles right
   ;    (send var-list :add-plot-help-item)
       (mapcar #'(lambda (x) (send x :showing t))
               (list av tp1 rp2 obs-list ip1 ip2))))
    ))

      