
;;############################################################################
;; tablobj2.lsp
;; Copyright (c) 1991-98 by Forrest W. Young
;; This file contains code to implement visualization of table data objects.
;;############################################################################

(defmeth table-data-object-proto :visualize (&key dialog)
  (if (not (eq current-object self)) (setcd self))
  (let* ((bp nil) (qp nil) (qqp nil) (dnl nil) (nl nil)
         (nways (send self :nways))
         (ways (send self :ways))
         (sources (send self :source-names))
         (design (combine "Overall" sources))
         (grouped-data (send self :grouped-data 0))
         (resp-var-name (first (send current-data :variables)))
         (last-effects-labels nil)
         (point-labels (send current-data :obs-labels))
         (labels (first (send self :level-names))))
    (setf *current-spreadplot* self)
    (setf bp (boxplot grouped-data :diamonds t :boxes t 
                      :mean-line t :median-line t
                      :location location11
                      :show nil
                      :size (+ (list window-decoration-width 0)
                               (* '(2 1) graph-size))
                      :point-labels point-labels
                      :y-axis-label resp-var-name
                      :variable-labels labels))
    (send bp :y-axis t t (third (send bp :y-axis)))
    (send bp :variable-label 1 (first (send current-data :variables)))
    (send bp :showing-labels t)
    (send bp :mouse-mode 'brushing)
    
    (defmeth bp :close ()
      (setf *current-spreadplot* nil)
      (send bp  :remove)
      (send dnl :remove)
      (send qp  :remove)
      (send qqp :remove)
      (send nl  :remove))

    (when (> nways 2) (setf design (combine design "Cells"))) 
    (when (= nways 3) (setf (first (last design ))
                            (strcat (second design) "*" (third design) "*" (fourth design))))
    (setf dnl (name-list design
                         :show nil
                         :location location13
                         :title "Sources"))
    (send dnl :menu nil)
    (send dnl :fix-name-list)
   ; (send dnl :has-v-scroll (max (screen-size)))
    (send dnl :size (- (first namelist-size) msdos-fiddle)
          (- (second namelist-size) msdos-fiddle))
    (defmeth dnl :close ()
      (send bp :close))
    (defmeth dnl :do-select-click (&rest args)
      (apply #'call-next-method args)
      (when(send self :selection)
            (let* ((sel (first (send self :selection)))
                   (num (send self :num-points))
                   (ways (send current-data :ways))
                   (nways (send current-data :nways)))
              (cond 
                ((= sel 0)
                 (send bp :new-plot (combine (send current-data :data))
                       :point-labels point-labels ;(send current-data :labels)
                       :variable-labels " ")
                 (send qp :new-plot (combine (send current-data :data))
                       :reg-line t
                       :variable-label resp-var-name)
                 (send qqp :clear)
                 (send qqp :variable-label 0 " ")
                 (send qqp :variable-label 1 " ")
                 (send nl :clear))
                ((and (> nways 1) (< 0 sel (1- num)))
                 (setf grouped-data (send current-data :grouped-data (1- sel)))
                 (setf labels (nth (1- sel) (send current-data :level-names)))
                 (setf point-labels 
                       (combine (send current-data :grouped-labels (1- sel))))
                 (send bp :new-plot grouped-data
                       :point-labels point-labels
                       :variable-labels labels)
                 (send qp :new-plot (first grouped-data)
                       :reg-line t
                      ; :nice-range (combine (send bp :range 1)
                      ;                      (third (send bp :y-axis)))
                       :variable-label (first labels))
                 (send qqp :new-plot 
                       (second grouped-data)
                       (first grouped-data)
                       :reg-line t
                       :nice-x-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :nice-y-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :variable-labels (list (second labels) (first labels)))
                 (send nl :clear-points :draw nil)  
                 (send nl :add-points (length grouped-data)
                       :point-labels labels :draw nil)  
                 (send nl :has-v-scroll (max (screen-size)))
                 )
                (t
;(break)
                 (setf last-effects-labels
                       (if (= nways 1)
                           labels
                           (send current-data :labels)))
                 (setf point-labels (send current-data :obs-labels))                                   
                 (send bp :new-plot (send current-data :data)
                       :variable-labels last-effects-labels
                       ;(send current-data :labels)
                       :point-labels point-labels)
                 (send qp :new-plot (first (send current-data :data))
                       :reg-line t
                      ; :nice-range (combine (send bp :range 1)
                      ;                      (third (send bp :y-axis)))
                       :variable-label last-effects-labels
                       ;(first (send current-data :labels))
                       )
                 (send qqp :new-plot (second (send current-data :data))
                       (first (send current-data :data))
                       :reg-line t
                       :nice-x-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :nice-y-range (combine (send bp :range 1)
                                              (third (send bp :y-axis)))
                       :variable-labels 
                       (list (second last-effects-labels) 
                             (first last-effects-labels))
                       ;(list (second (send current-data :labels))
                       ;      (first  (send current-data :labels)))
                       )
                 (send nl :clear-points :draw nil)                   
                 (send nl :add-points (length (send current-data :labels))
                       :point-labels last-effects-labels :draw nil)
                 (send nl :has-v-scroll (max (screen-size)))
                 )))))
    
    (setf qp (qplot  (first grouped-data)
                     :reg-line t :show nil
                    ; :nice-range (combine (send bp :range 1) 
                    ;                      (third (send bp :y-axis)))
                     :location location21
                     :size graph-size
                     :variable-label (first labels)))
    (defmeth qp :close ()
      (send bp :close))
    (setf qqp (qqplot (second grouped-data)
                      (first  grouped-data)
                      :location location22
                      :size graph-size
                      :reg-line t :show nil
                      :nice-x-range (combine (send bp :range 1)
                                             (third (send bp :y-axis)))
                      :nice-y-range (combine (send bp :range 1)
                                             (third (send bp :y-axis)))
                      :variable-labels 
                      (list (second labels) (first labels))))
            
    (defmeth qqp :close ()
      (send bp :close))
    
    (send qp :plot-buttons :mouse-mode nil :new-y nil)
    
    (setf nl (name-list labels :show nil
                        :location location23 :title "Levels"))
    (send nl :menu nil)
    (send nl :fix-name-list)
    (send nl :has-v-scroll (max (screen-size)))
    (send nl :size (- (first namelist-size) msdos-fiddle)
          (- (second namelist-size) msdos-fiddle))
    (defmeth nl :close ()
      (send bp :close))
    (defmeth nl :do-select-click (&rest args)
      (apply #'call-next-method args)
      (when (send self :selection)
            (let* ((xy (send self :selection))
                   (labels (coerce (send bp :variable-labels) 'list))
                   (y (sort-data (nth (first  xy) (send bp :data))))
                   (x (sort-data (/ (1+ (rank y)) (1+ (length y))))))
              (send qp :new-plot y :reg-line t 
                   ; :nice-range (combine (send bp :range 1)
                   ;                      (third (send bp :y-axis)))
                    :variable-label (nth (first xy) labels))
              (when (> (length xy) 1)
                    (setf x (sort-data (nth (second xy) (send bp :data))))
                    (send qqp :new-plot x y :reg-line t
                          :nice-x-range (combine (send bp :range 1)
                                                 (third (send bp :y-axis)))
                          :nice-y-range (combine (send bp :range 1)
                                                 (third (send bp :y-axis)))
                          :variable-labels (list
                                            (nth (second xy) labels)
                                            (nth (first  xy) labels)))))))
    
    (defmeth self :spreadplot-help ()
      (plot-help-window (strcat "SpreadPlot Help"))
      (paste-plot-help (format nil "This is the SpreadPlot for Classification and Table Data. In this SpreadPlot clicking on entries in the Sources and Levels windows changes what is displayed in the other plot windows. Clicking on a Source entry will change the data source for which information is displayed in the other windows. Clicking on a Levels entry will change the level of the source for which information is displayed in the Q-plot and QQ-plot.~2%"))
      (show-plot-help)
      (send spreadplot-proto :spreadplot-help :nothing t :flush nil))

    (defmeth qp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This plot displays a quantile plot (Q-plot) or normal-probability plot (NP-plot) for a subset of the observations. The subset is formed by the level choosen in the LEVELS window. The choice of subsets is itself determined by the source choosen in the SOURCES window. By clicking on various LEVELS and SOURCES it is possible to see subsets for all levels of each way of the data, and for all levels of every combination of the ways.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (send qqp :plot-buttons :new-x nil :new-y nil :mouse-mode nil)
  ;:margin '(0 17 0 20)
    (defmeth qqp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This plot displays a quantile-quantile plot (QQ-plot) formed from a pair of subsets of the observations. The pair of subsets is formed by the levels choosen in the LEVELS window. You make the choice by shift-clicking on two levels, or dragging across two levels. The choice of levels is itself determined by the source choosen in the SOURCES window. By clicking on various LEVELS and SOURCES it is possible to see subsets for all levels of each way of the data, and for all levels of every combination of the ways.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (defmeth bp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This plot displays a side-by-side Box, Diamond and Dot plot for each of the levels of a source in your data. The choice of sources is determined by clicking in the SOURCES window. By clicking on various SOURCES it is possible to see side-by-side box-plots for all levels of each way of the data, and for all levels of every combination of the ways.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (defmeth dnl :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This window displays sources of information in the data. A source is either the OVERALL data, a main way of the data, or a combination of two or more of the ways of the data. By clicking on a source in the SOURCES window it is possible to see side-by-side box, diamond and dot plots of the levels of the source. In addition, the LEVELS window will display the levels of the choosen source, which effects the specific Q-plots and QQ-plots that can be shown.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    
    (defmeth nl :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
                               "This window displays the levels of a choosen data source. (The OVERALL source has only one level. It is not shown.) If you click on one level in the LEVELS window you will get a Q-plot of that level. If you shift-click (or drag) on a pair of levels, you will get a QQ-plot of the pair of levels.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    (send bp :add-plot-help-item)
    (send dnl :add-plot-help-item)
    (send qp :add-plot-help-item)
    (send qqp :add-plot-help-item)
    (send nl :add-plot-help-item)
    (send nl :has-v-scroll (max (screen-size)))
    (send dnl :has-v-scroll (max (screen-size)))
#+macintosh
    (when (> xls-minor-release 50)
          (mapcar #'(lambda (plot)
                      (apply #'send plot :location 
                             (- (send plot :location)
                                (list -3 window-decoration-height))))
                  (list bp dnl qp qqp nl)))
    (send bp  :show-window)
    (send dnl :show-window)
    (send qp  :show-window)
    (send qqp :show-window)
    (send nl  :show-window)
    (send bp  :show-window)
    ))

(defmeth table-data-object-proto :data-matrix ()
"Message args: none
Reports table data as a multivariate category matrix."
  (let* ((way-names (send self :ways))
         (class-names (send self :classes))
         (ncells (send self :ncells))
         (cellfreqs (send self :cellfreqs))
         (nways (send self :nways))
         (class-num (repeat 0 nways))
         (nobs (send self :nobs))
         (nclasses (send self :nclasses))
         (mv-data (make-array (list nobs (1+ nways)))) 
         (response (combine (send self :data)))
         (L 0)
         (string "")) 
    (dotimes (i ncells)
             (dotimes (k (select cellfreqs i))
                 
                      (setf (select mv-data L 0) (select response L))
                      (dotimes (j nways)
                               (setf (select mv-data L (1+ j))
                                     (select (select class-names j)
                                             (select class-num j))))
                      (setf L (1+ L)))
             (dolist (j (iseq (- nways 1) 0))
                     (setf (select class-num j) (+ (select class-num j) 1))
                     (if (= (select class-num j)  (select nclasses j))
                         (setf (select class-num j) 0)
                         (return))))
    mv-data))

(defmeth table-data-object-proto :create-data (&optional name) 
"Message args: (&optional name)
Creates a multivariate data object from the current table data.  The data object is named NAME (a string) if specified, otherwise a dialog is presented for name. Returns object identification of the new data object."
  (if (not (eq current-object self)) (setcd self))
  (setf merge-dob nil)
  (let ((menu-name nil)
        )
    (if name
        (setf menu-name name)
        (setf menu-name 
              (get-string-dialog "Create Classification Data Named:"
                        :initial (strcat "Cls-" (send self :name)))))
    (when (and menu-name (= (length menu-name) 0)) 
          (error-message "error - you must specify a name."))
    (cond 
      ((and menu-name (> (length menu-name) 0))
       (data menu-name
             :created (send *desktop* :selected-icon)
             :title (concatenate 'string "Created from "(send self :title))
             :data (combine (send current-data :data-matrix))
             :variables (combine (send current-data :variables)
                                 (send current-data :ways))
             :labels (repeat (send current-data :labels) 
                             (send current-data :cellfreqs))
             :types (combine "Numeric" 
                             (repeat "Category" (send current-data :nways)))
             )))))