;;########################################################################
;; regvis1.lsp
;; Visualization for OLS, Robust & Monotonic Regression ViSta model object
;; Copyright (c) 1995-6 by Carla M. Bann
;;########################################################################


(defmeth morals-model-object-proto :spreadplot-supervisor (&optional (val nil set)) 
  (when set (setf (slot-value 'spreadplot-supervisor) val)) 
  (slot-value 'spreadplot-supervisor))


(defmeth morals-model-object-proto :install-spreadplot-supervisor (spreadplot-supervisor)
"Method args: SPREADPLOT
Installs the spreadplot-object SPREADPLOT into the current morals model object.  If a spreadplot object is already installed, query whether it should be replaced (overwritten) or not.  Returns the object-id of the spreadplot-supervisor-object installed in the model.  " 
      (if (send spreadplot-supervisor :menu) 
         (send (send spreadplot-supervisor :menu) :install))
      spreadplot-supervisor)


(defmeth morals-model-object-proto :delete-spreadplot-supervisor ()
"Method args: ()
Deletes the spreadplot-supervisor in the spreadplot slot of the current morals  model object (if any). " 
  (when (send self :spreadplot-supervisor)
        (send (send self :spreadplot-supervisor) :remove)
        (setf (slot-value 'spreadplot-supervisor) 'nil)  ))

(defmeth morals-model-object-proto :hide-spreadplot-supervisor ()
"Method args: ()
Hides the spreadplot-supervisor in the spreadplot slot of the current principal component model object (if any). " 
  (when (send self :spreadplot-supervisor)
        (send (send self :spreadplot-supervisor) :hide-ssp) ))


(defmeth morals-model-object-proto :show-spreadplot-supervisor ()
"Method args: ()
Deletes the spreadplot-supervisor in the spreadplot slot of the current principal component model object (if any). " 
  (when (send self :spreadplot-supervisor)
        (send (send self :spreadplot-supervisor) :show-ssp) )) 


#|
|-----------------|
| Create morals-spreadplot
|-----------------|
|# 


(setf plot-size  
          (min (- (floor (/ (first screen-size) 3))
                  window-decoration-width 2)
               (- (floor (/ (- (second screen-size) menu-bar-height) 2))
                  msdos-fiddle ;fwy
                  (/ window-decoration-height 2))))
    


(defmeth morals-model-object-proto :create-spreadplot (&optional show)
"Method args: (SPACE &key (FROM 'current) )

Creates a pca vis/revis-visualization.  The SPACE argument determines which space is initially showing.  The :FROM keyword argument specifies which model ['Current, 'PCA, 'Ingram, or 'Ingrex] the vis/revis plots are based upon."
  (let* ( (mssp nil)))
  (when (not (send self :spreadplot-supervisor))
        (setf mssp (send morals-spreadplot-supervisor-proto :new :model self))
        (send mssp :simple-reg (= 1 (length (send self :iv))))
        (send mssp :location-array)
        (send mssp :create-plots)
        (when (not (send mssp :simple-reg)) (send mssp :new-menu))
        (send self :spreadplot-supervisor mssp)
; (send mssp :menu nil) kills spreadplot menu but makes iterative methods ng
        (when (not (equalp show "no")) (send mssp :show-ssp))
        mssp)
  (when (send self :spreadplot-supervisor)
        (when (not (equalp show "no")) 
              (send self :show-spreadplot-supervisor))
        (send self :spreadplot-supervisor))
  )



;*****SPREADPLOT********

#|
|-------------------------|
| SpreadPlot Object Proto |
|-------------------------|
|#

(defproto spreadplot-supervisor-proto 
  '( model menu  menu-title menu-template)
  '()
  *object*)


(defmeth spreadplot-supervisor-proto :isnew (&key 
                                         model 
                                         (menu-title "SpreadPlot")
                                         (menu-template '(dash dash dash)) )
"Method Args ()

" 
  (if model (setf (slot-value 'model) model))
  (if menu-title (setf (slot-value 'menu-title) menu-title))
  (if menu-template (setf (slot-value 'menu-template) menu-template))  
 )


#|
|-----------------|
| SLOT ACCESSORS  |
|-----------------|
|# 
(defmeth spreadplot-supervisor-proto :model (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'model) values))
  (slot-value 'model) )

(defmeth spreadplot-supervisor-proto :menu (&optional (values nil set))
"Method Args:  &optional MENU
Sets or retrieves the spreadplot's menu in its MENU slot."
  (if set (setf (slot-value 'menu) values))
  (slot-value 'menu) )

(defmeth spreadplot-supervisor-proto :menu-title (&optional (values nil set))
"Method Args:  &optional ''TITLE''
Sets or retrieves the title of the spreadplot's menu."
  (if set (setf (slot-value 'menu-title) values))
  (slot-value 'menu-title) )

(defmeth spreadplot-supervisor-proto :menu-template (&optional (values nil set))
"Method Args:  &optional TEMPLATE
Sets or retrieves the template of items for the spreadplot's menu."
  (if set (setf (slot-value 'menu-template) values))
  (slot-value 'menu-template) )


#|
|--------------------|
| Additional Methods |
|--------------------|
|# 
(defmeth spreadplot-supervisor-proto :remove ()
"Method Args: () 
Removes the spreadplot.  First, remove its menu if it has one.  Then, remove the individual plots installed in it. "
  (when (send self :menu)
        (send (send self :menu) :remove)
        (send (send self :menu) :dispose) )
  (mapcar #'(lambda (plot) 
              (when plot
                    (if (send plot :allocated-p)
                        (send plot :remove))))
              (send self :all-plots)) )

(defmeth spreadplot-supervisor-proto :show-ssp ()
"Method Args: () 
Shows the spreadplot.  First, installs its menu (if it has one) into the menu bar.  Then, shows the individual plots installed in it. "
  (send self :show-visible-plots)
;  (when (send self :menu)
;        (send (send self :menu) :install))
  (mapcar #'(lambda (plot)
              (when (send plot :has-slot 'plot-help-menu)
                    (when (send plot :slot-value 'plot-help-menu)
                          (when (not (send (send plot :slot-value 
                                                 'plot-help-menu) :menu))
                                (send *help-menu* :append-items 
                                      (send plot :slot-value 
                                            'plot-help-menu))))))
          (send self :all-plots))
  )

(defmeth spreadplot-supervisor-proto :hide-ssp ()
"Method Args: () 
Hides the spreadplot.  First, removes its menu (if it has one) from the menu bar.  Then, hides the individual plots installed in it. "
  (when (send self :menu)
        (send (send self :menu) :remove))
  (mapcar #'(lambda (plot)
              (when (send plot :has-slot 'plot-help-menu)
                    (when (send plot :slot-value 'plot-help-menu)
                          (send *help-menu* :delete-items 
                                (send plot :slot-value 'plot-help-menu)))))
              (send self :all-plots))
  (send self :hide-all-plots) )



(defmeth spreadplot-supervisor-proto :new-menu 
  (&optional title  &key (items (send self :menu-template)) ) 
  (unless title 
          (setq title (slot-value 'menu-title)) )
  (if (slot-value 'menu) 
      (send (slot-value 'menu) :dispose) )
  (flet (
         (make-item (item) (send self :make-menu-item item) )
         )
    (let (
          (menu (send menu-proto :new title) )
          )
      (send self :menu menu) 
      (apply #'send menu :append-items  
             (remove nil (mapcar #'make-item items)))
      menu) ) )


(defmeth spreadplot-supervisor-proto :make-menu-item (item-template)
  (if (kind-of-p item-template menu-item-proto)
      item-template
      (case item-template
        ( dash (send dash-item-proto :new) ) 
        ( show-plots 
          (send graph-item-proto :new "Show Plots" self 
                :show-visible-plots) )
        ( hide-plots 
          (send graph-item-proto :new "Hide Plots" self 
                :hide-all-plots) )
        ( show-spreadplot 
          (send graph-item-proto :new "Show SpreadPlot" self 
                :show-ssp) )
        ( hide-spreadplot 
          (send graph-item-proto :new "Hide SpreadPlot" self 
                :hide-ssp) )
        ( kill-spreadplot
          (send graph-item-proto :new "Kill SpreadPlot" (slot-value 'model)
                :delete-spreadplot-supervisor) )

        )))


(defmeth spreadplot-supervisor-proto :all-plots ()
"Method Args: () 
Retrieves the list of a spreadplot-object's own slots and checks whether they are plots or not.  Returns a list of all plots from the object's slots. 

Note: expects any slot to contain one and only one plot. 
" 
(let (
        
        (slots (mapcar #'(lambda (x)
                                  (send self :slot-value x))
                              (send self :own-slots)))
   
        ; (slots (remove-duplicates (send self :slot-names)))
      )
  
    (select slots (which (mapcar #'(lambda (x) 
                                     (kind-of-p x graph-proto))
                                 slots))) ))


(defmeth spreadplot-supervisor-proto :hide-all-plots ()
  (mapcar #'(lambda (x)
              (send x :hide-window)
              (send (send x :menu) :remove))
          (send self :all-plots)))


(defmeth spreadplot-supervisor-proto :show-visible-plots ()
  (mapcar #'(lambda (x)
              (send x :show-window))
          (send self :all-plots)))



;****MORALS SPREADPLOT******

#|
|-------------------------|
| SpreadPlot Object Proto |
|-------------------------|

|#

(defproto morals-spreadplot-supervisor-proto 
  '(rsq-beta-plot residual-plot1 residual-plot2 influence-plot1    
    influence-plot2 transformation-plot simple-reg
    lin-reg-plot  infl-type1 infl-type2 resid-type1 resid-type2
    var-list obs-list robust-plot robust-reg-plot added-var-plot)
  '()
  spreadplot-supervisor-proto)



(defmeth morals-spreadplot-supervisor-proto :isnew 
  (&rest args &key model plots menu (menu-title "SpreadPlot" mti-test)
  (menu-template 
       '(rsq-plot trans-plot3 av-plot resid-plot1 resid-plot2 infl-plot1 
         infl-plot2 var-list obs-list) mte-test)  
  residual-plot1 residual-plot2 influence-plot1 influence-plot2  
  transformation-plot lin-reg-plot rsq-beta-plot var-list obs-list
  added-var-plot)

"Method Args ()
"
(let* (
      (args2 (if mti-test 
                 args
                 (append args (list :menu-title menu-title))))
      (args3 (if mte-test
                 args2
                 (append args2 (list :menu-template menu-template))))
       ) 
  (apply #'call-next-method args3)
))

#|
|-----------------|
| SLOT ACCESSORS  |
|-----------------|
|# 


(defmeth spreadplot-supervisor-proto :rsq-beta-plot (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'rsq-beta-plot) values))
  (slot-value 'rsq-beta-plot) )


(defmeth spreadplot-supervisor-proto :residual-plot1 (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'residual-plot1) values))
  (slot-value 'residual-plot1) )


(defmeth spreadplot-supervisor-proto :influence-plot1 (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'influence-plot1) values))
  (slot-value 'influence-plot1) )


(defmeth spreadplot-supervisor-proto :transformation-plot (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'transformation-plot) values))
  (slot-value 'transformation-plot) )

(defmeth spreadplot-supervisor-proto :residual-plot2 (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'residual-plot2) values))
  (slot-value 'residual-plot2) )


(defmeth spreadplot-supervisor-proto :influence-plot2 (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'influence-plot2) values))
  (slot-value 'influence-plot2) )


(defmeth spreadplot-supervisor-proto :lin-reg-plot (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'lin-reg-plot) values))
  (slot-value 'lin-reg-plot) )

(defmeth spreadplot-supervisor-proto :added-var-plot (&optional (values nil set))
"Method Args:  &optional (VALUES nil) 
Sets or retrieves the object id# of the model in which the spreadplot is installed."
  (if set (setf (slot-value 'added-var-plot) values))
  (slot-value 'added-var-plot) )

(defmeth spreadplot-supervisor-proto :infl-type1 (&optional (values nil set))
  (if set (setf (slot-value 'infl-type1) values))
  (slot-value 'infl-type1) )

(defmeth spreadplot-supervisor-proto :resid-type1 (&optional (values nil set))
  (if set (setf (slot-value 'resid-type1) values))
  (slot-value 'resid-type1) )

(defmeth spreadplot-supervisor-proto :infl-type2 (&optional (values nil set))
  (if set (setf (slot-value 'infl-type2) values))
  (slot-value 'infl-type2) )

(defmeth spreadplot-supervisor-proto :resid-type2 (&optional (values nil set))
  (if set (setf (slot-value 'resid-type2) values))
  (slot-value 'resid-type2) )


(defmeth spreadplot-supervisor-proto :var-list (&optional (values nil set))
  (if set (setf (slot-value 'var-list) values))
  (slot-value 'var-list) )

(defmeth spreadplot-supervisor-proto :obs-list (&optional (values nil set))
  (if set (setf (slot-value 'obs-list) values))
  (slot-value 'obs-list) )


(defmeth spreadplot-supervisor-proto :robust-plot (&optional (values nil set))
  (if set (setf (slot-value 'robust-plot) values))
  (slot-value 'robust-plot) )

(defmeth spreadplot-supervisor-proto :robust-reg-plot (&optional (values nil set))
  (if set (setf (slot-value 'robust-reg-plot) values))
  (slot-value 'robust-reg-plot) )

(defmeth spreadplot-supervisor-proto :simple-reg (&optional (values nil set))
  (if set (setf (slot-value 'simple-reg) values))
  (slot-value 'simple-reg) )
