;;########################################################################
;; regvis6.lsp
;; Visualization for OLS, Robust & Monotonic Regression ViSta model object
;; Contains code for added variable plot and for links
;; Copyright (c) 1995-6 by Carla M. Bann
;;########################################################################

(setf *rsq-plots* nil)


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



; _______________________________________________________

(setf *obs-plots* nil)

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

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

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

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

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

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

(defmeth lin-reg-plot-proto :links ()
  (if (member self *obs-plots*) *obs-plots*))

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

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

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

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

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

(defmeth robust-reg-plot-proto :links ()
  (if (member self *obs-plots*) *obs-plots*))

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



; ___________________________________________________________________

(defproto added-var-plot-proto '(spreadplot-supervisor showing x simple-reg)
  '() scatterplot-proto)

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

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

(defmeth added-var-plot-proto :x (&optional (value nil set)) 
  (when set (setf (slot-value 'x) value)) 
  (slot-value 'x))

(defmeth added-var-plot-proto :simple-reg (&optional (logical nil set)) 
  (when set (setf (slot-value 'simple-reg) logical)) 
  (slot-value 'simple-reg))

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

(defmeth added-var-plot-proto :new-y () (send self :change-y-axis))

(defmeth added-var-plot-proto :change-y-axis ()
  (send (send self :spreadplot-supervisor) :get-added-var self))

(defun added-var-plot (spreadplot-supervisor x y &rest args)
  (apply #'send added-var-plot-proto :new spreadplot-supervisor x y args))


(defmeth added-var-plot-proto :isnew
  (spreadplot-supervisor x y
     &rest args
     &key
     (title "Regression")
     (menu-title "Regress")
     (simple-reg nil)                    
     (scale 'nil)
     (show 't)
     showing) 
  (let* ((labels (send (send spreadplot-supervisor :model) :labels)))
    (send self :spreadplot-supervisor spreadplot-supervisor)
    (send self :simple-reg simple-reg)
    (apply #'call-next-method 2 
           (append args `(:title ,title :menu-title ,menu-title
                                 :show nil)))
    (send self :use-color t)
    (send self :add-points x y :point-labels labels :draw 'nil)
    (when (not simple-reg) 
          ;(send self :add-overlay (make-overlay3 self))
          (send self :plot-buttons :new-x nil)
          )
    (send self :adjust-to-data :draw 'nil)
    (if show (send self :show-window))))

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

(defmeth added-var-plot-proto :links ()
  (if (member self *obs-plots*) *obs-plots*))

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

(defmeth morals-spreadplot-supervisor-proto :get-added-var (plot)
  (let* ((mod (send self :model))
         (model (send mod :morals-model))
         (y (send model :y))
         (labels (send mod :labels))
         (datamat (send model :x))
         (nobs (send mod :nobs))
         (num (iseq (select (array-dimensions datamat) 1)))
         (iv (select (send mod :variables) (send mod :iv)))
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (text (send text-item-proto :new "Choose Added Variable"))
         (var-toggle (send choice-item-proto :new iv :value (send plot :x)))
         (ok (send modal-button-proto :new "OK" :action
             #'(lambda () (let* ((dialog (send ok :dialog))
                                 (value (send var-toggle :value)))
                            (send self :update-added-var-plot plot
                                  value datamat y dv nobs num mod)
                            (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)))))  
         (var-dialog (send modal-dialog-proto :new
                             (list text var-toggle (list ok cancel))))
         )
  (send var-dialog :modal-dialog)
))

(defmeth morals-spreadplot-supervisor-proto :update-added-var-plot 
  (plot value datamat y dv nobs num mod)
  (if (not value) (setf value (send plot :x)))
  (if (not (numberp value)) (setf value 0))
  (let* (
         (x (combine (select datamat (iseq nobs) value)))
         (num (remove value num))
         (otherxs (select datamat (iseq nobs) num))
         (point-labels (send mod :labels))
         (rw nil)
         (yx nil)
         (xx nil)
         )
    (cond
      ((equal (send mod :method) "Robust")
       (setf rw (first (last (send (send (send self :model) :robust-model) 
                                   :weight-list))))
       (setf yx (regression-model otherxs y :weights rw :print nil))
       (setf xx (regression-model otherxs x :weights rw :print nil)))
      (t
       (setf yx (regression-model otherxs y :print nil))
       (setf xx (regression-model otherxs x :print nil))))
    (send plot :x value)
    (send plot :clear-points :draw nil)
    (send plot :add-points (send xx :residuals)
          (send yx :residuals) :point-labels point-labels :draw nil)
    (if (equal (send mod :method) "Monotonic")
        (send plot :variable-label '(0 1) (list (strcat (select 
          (send mod :variables) (select (send mod :iv) value))
                       "|Other Vars") (strcat "Mono-" dv "|Other Vars"))) 
        (send plot :variable-label '(0 1) (list (strcat (select 
          (send mod :variables) (select (send mod :iv) value))
                       "|Other Vars") (strcat dv "|Other Vars"))))
    (send plot :adjust-to-data)))