;; crspmob1.lsp
;; contains code to implement correspondence analysis model prototype object
;; Copyright (c) 1992-94 by Lee Bee Leng - Modified May 31, 1995 by FWY
;; Intepretation added July 97 by fwy

;--------------------------------------------------
;  Correspondence Analysis Model Prototype Object
;--------------------------------------------------

;forrest made changes in this file.  search for forrest
;forrest added next line
(require "vista")

(defproto Corresp-proto 
  '(Data Row-Sums Col-Sums Nrows Ncols MaxDim Table 
    Row-Mass Col-Mass Expected Deviation Contribution
    RPI CPI RSC CSC RI CI Best-Row-Pts Best-Col-Pts
    GSVD Norm-Opt Norm-Rows Norm-Cols Residuals
    Point-Moved-p O-Norm-Rows O-Norm-Cols O-Residuals
    RDu CDu Point-Moved-p Precision Dimension) 
  () mv-model-object-proto)
 

(defmeth Corresp-proto :Data (&optional (data nil set))
  (if set (setf (slot-value 'Data) data))
  (slot-value 'Data))
 
(defmeth Corresp-proto :Row-Sums (&optional (row-sums nil set))
  (if set (setf (slot-value 'Row-Sums) row-sums))
  (slot-value 'Row-Sums))
 
(defmeth Corresp-proto :Col-Sums (&optional (col-sums nil set))
  (if set (setf (slot-value 'Col-Sums) col-sums))
  (slot-value 'Col-Sums))
 
(defmeth Corresp-proto :Nrows (&optional (nrows nil set))
"Args: (&optional nrows)
Set or return the number of rows of data table."
  (if set (setf (slot-value 'Nrows) nrows))
  (slot-value 'Nrows))
 
(defmeth Corresp-proto :Ncols (&optional (ncols nil set))
"Args: (&optional ncols)
Set or return the number of columns of data table."
  (if set (setf (slot-value 'Ncols) ncols))
  (slot-value 'Ncols))
 
(defmeth Corresp-proto :MaxDim (&optional (max nil set))
"Args: (&optional max)
Set or return the maximum dimension."
  (if set (setf (slot-value 'MaxDim) max))
  (slot-value 'MaxDim))
 
(defmeth Corresp-proto :Table (&optional (table nil set))
"Args: (&optional table)
Set or return the contingency table."
  (if set (setf (slot-value 'Table) table))
  (slot-value 'Table))
 
(defmeth Corresp-proto :Row-Mass (&optional (row-mass nil set))
"Args: (&optional row-mass)
Set or return the row sums of contingency table."
  (if set (setf (slot-value 'Row-Mass) row-mass))
  (slot-value 'Row-Mass))
 
(defmeth Corresp-proto :Col-Mass (&optional (col-mass nil set))
"Args: (&optional col-mass)
Set or return the column sums of contingency table."
  (if set (setf (slot-value 'Col-Mass) col-mass))
  (slot-value 'Col-Mass))
 
(defmeth Corresp-proto :Expected (&optional (expected nil set))
"Args: (&optional expected)
Set or return the expected frequency matrix under the hypothesis of row and column independence."
  (if set (setf (slot-value 'Expected) expected))
  (slot-value 'Expected))
 
(defmeth Corresp-proto :Deviation (&optional (deviation nil set))
"Args: (&optional deviation)
Set or return the observed minus expected frequencies under the hypothesis of row and column independence."
  (if set (setf (slot-value 'Deviation) deviation))
  (slot-value 'Deviation))
 
(defmeth Corresp-proto :Contribution (&optional (contrib nil set))
"Args: (&optional contrib)
Set or return the percentage contribution to total chi-square test statistics."
  (if set (setf (slot-value 'Contribution) contrib))
  (slot-value 'Contribution))
 
(defmeth Corresp-proto :RPI (&optional (rpi nil set))
"Args: (&optional rpi)
Set or return the Row Partial contribution to Inertia."
  (if set (setf (slot-value 'RPI) rpi))
  (slot-value 'RPI))
 
(defmeth Corresp-proto :CPI (&optional (cpi nil set))
"Args: (&optional cpi)
Set or return the Column Partial contribution to Inertia."
  (if set (setf (slot-value 'CPI) cpi))
  (slot-value 'CPI))
 
(defmeth Corresp-proto :RSC (&optional (rsc nil set))
"Args: (&optional rsc)
Set or return the Row Squared Cosines."
  (if set (setf (slot-value 'RSC) rsc))
  (slot-value 'RSC))
 
(defmeth Corresp-proto :CSC (&optional (csc nil set))
"Args: (&optional csc)
Set or return the Column Squared Cosines."
  (if set (setf (slot-value 'CSC) csc))
  (slot-value 'CSC))
 
(defmeth Corresp-proto :RI (&optional (ri nil set))
"Args: (&optional ri)
Set or return the Row Inertia."
  (if set (setf (slot-value 'RI) ri))
  (slot-value 'RI))
 
(defmeth Corresp-proto :CI (&optional (ci nil set))
"Args: (&optional ci)
Set or return the Column Inertia."
  (if set (setf (slot-value 'CI) ci))
  (slot-value 'CI))
 
(defmeth Corresp-proto :Best-Row-Pts (&optional (brp nil set))
  (if set (setf (slot-value 'Best-Row-Pts) brp))
  (slot-value 'Best-Row-Pts))
 
(defmeth Corresp-proto :Best-Col-Pts (&optional (bcp nil set))
  (if set (setf (slot-value 'Best-Col-Pts) bcp))
  (slot-value 'Best-Col-Pts))
 
(defmeth Corresp-proto :GSVD (&optional (gsvd nil set))
"Args: (&optional gsvd)
Set or return the generalized singular value decomposition of the contingency table.
The first singular value (which is one) and the first left & right singular vectors are discarded."
  (if set (setf (slot-value 'GSVD) gsvd))
  (slot-value 'GSVD))
 
(defmeth Corresp-proto :Norm-Opt (&optional (norm-opt nil set))
"Args: (&optional norm-opt)
Set or return the normalization method."
  (if set (setf (slot-value 'Norm-Opt) norm-opt))
  (slot-value 'Norm-Opt))
 
(defmeth Corresp-proto :Norm-Rows (&optional (norm-rows nil set))
"Args: (&optional norm-rows)
Returns the normalized row coordinates."
  (if set (setf (slot-value 'Norm-Rows) norm-rows))
  (slot-value 'Norm-Rows))
 
(defmeth Corresp-proto :Norm-Cols (&optional (norm-cols nil set))
"Args: (&optional norm-cols)
Returns the normalized column coordinates."
  (if set (setf (slot-value 'Norm-Cols) norm-cols))
  (slot-value 'Norm-Cols))
 
(defmeth Corresp-proto :Residuals (&optional (resid nil set))
"Args: (&optional resid)
Set or return the residuals."
  (if set (setf (slot-value 'Residuals) resid))
  (slot-value 'Residuals))
 
(defmeth Corresp-proto :O-Norm-Rows (&optional (norm-rows nil set))
  (if set (setf (slot-value 'O-Norm-Rows) norm-rows))
  (slot-value 'O-Norm-Rows))
 
(defmeth Corresp-proto :O-Norm-Cols (&optional (norm-cols nil set))
  (if set (setf (slot-value 'O-Norm-Cols) norm-cols))
  (slot-value 'O-Norm-Cols))
 
(defmeth Corresp-proto :O-Residuals (&optional (resid nil set))
  (if set (setf (slot-value 'O-Residuals) resid))
  (slot-value 'O-Residuals))
 
(defmeth Corresp-proto :RDu (&optional (rDu nil set))
  (if set (setf (slot-value 'RDu) rDu))
  (slot-value 'RDu))
 
(defmeth Corresp-proto :CDu (&optional (cDu nil set))
  (if set (setf (slot-value 'CDu) cDu))
  (slot-value 'CDu))
 
(defmeth Corresp-proto :Precision (&optional (precision nil set))
"Args: (&optional precision)
Set or return the precision of analysis."
  (if set (setf (slot-value 'Precision) precision))
  (slot-value 'Precision))
 
(defmeth Corresp-proto :Dimension (&optional (dimension nil set))
"Args: (&optional dimension)
Set or return the dimensionality of analysis."
  (if set (setf (slot-value 'Dimension) dimension))
  (slot-value 'Dimension))
 
(defmeth Corresp-proto :Point-Moved-p (&optional (moved nil set))
  (if set (setf (slot-value 'Point-Moved-p) moved))
  (slot-value 'Point-Moved-p))
 
(defmeth Corresp-proto :Analysis-Dialog ()
  (let* ((Title (send text-item-proto :new
                      "Correspondence Analysis Options"))
         (profile-item (send choice-item-proto :new
                             (list
                              "Analyze Row Profiles"
                              "Analyze Column Profiles"
                              "Analyze Both") :value 2))
         (Dimens-text (send text-item-proto :new
                            "Dimensionality"))
         (Dimens-item (send edit-text-item-proto
                            :new "3" :text-length 2))
         (Cancel (send modal-button-proto :new "Cancel"))
         (OK (send modal-button-proto :new "OK"
             :action
             #'(lambda ()
                 (list (send profile-item :value)
                       (with-input-from-string
                        (D (send dimens-item :text))
                        (read D nil)))))))
    (send modal-dialog-proto :new
          (list title
                profile-item
                (list dimens-text dimens-item)
                (list ok cancel))
;forrest added the following line
          :default-button ok
          )))
 
(defmeth Corresp-proto :Options ()
  (when (send self :dialog)
        (let* ((options (send (send self :Analysis-Dialog) :modal-dialog))
               (maxdim (- (min (array-dimensions (send self :data-matrix))) 1)))
          (when options
                (send self :Norm-opt (first options))
                (cond
                  ((not (numberp (second options)))
                   (error-message
                    (format nil "Error: Invalid character entered for dimensionality."))
                   (setf options nil))
                  (t
                   (cond
                     ((< (second options) 1) 
                      (error-message 
                       (format nil "Error: Minimum Dimensionality is 1."))
                      (setf options nil))
                     ((> (second options) maxdim)
                      (error-message
                       (format nil "Error: Maximum Dimensionality is ~d." maxdim))
                      (setf options nil))
                     ((and (>= (second options) 1)
                           (<= (second options) maxdim))
                      (send self :Dimension (second options)))))))
          options)))
 
(defmeth Corresp-proto :Analysis ()
"Args: None
Performs simple correspondence analyses on raw categorical data."
  (let* ((data (send self :Data-matrix))
         (table (/ data (sum data)))
         (nr (first (array-dimensions data)))
         (nc (second (array-dimensions data)))
         (max-dimens (- (min nr nc) 1))
         (dimens (send self :dimension))
         (rs (mapcar #'sum (row-list data)))
         (cs (mapcar #'sum (column-list data)))
         (r (mapcar #'sum (row-list table)))
         (c (mapcar #'sum (column-list table)))
         (Dr (diagonal r))
         (Dc (diagonal c))
         (gsvd (gsv-decomp table (inverse Dr) (inverse Dc)))
         (E (outer-product r c))
         (diff (- table E))
         (X2 (/ (^ diff 2) E))
         (Contri (* 100 (/ X2 (sum X2))))
         (Row-Con (mapcar #'sum (row-list Contri)))
         (Col-Con (mapcar #'sum (column-list Contri)))
         (Contrib (bind-columns (bind-rows Contri Col-Con)
                                (combine Row-Con 100)))
         (q (length (second gsvd)))
         (A (select (first gsvd) (iseq nr) (iseq 1 (- q 1))))
         (Du (diagonal (select (second gsvd) (iseq 1 (- q 1)))))
         (B (select (third gsvd) (iseq nc) (iseq 1 (- q 1))))
         (rpi (%* (inverse Dr) (^ A 2)))
         (cpi (%* (inverse Dc) (^ B 2)))
         (rsc (%*
               (inverse
                (diagonal (%* (^ (%* A Du) 2) (repeat 1 max-dimens))))
               (^ (%* A Du) 2)))
         (csc (%*
               (inverse
                (diagonal (%* (^ (%* B Du) 2) (repeat 1 max-dimens))))
               (^ (%* B Du) 2)))
         (ti (sum (diagonal (^ Du 2))))
         (ri (/ (%* (inverse Dr) 
                    (%* (^ (%* A Du) 2) (repeat 1 max-dimens))) TI))
         (ci (/ (%* (inverse Dc)
                    (%* (^ (%* B Du) 2) (repeat 1 max-dimens))) TI)))
    (send self :Nrows nr)
    (send self :Ncols nc)
    (send self :MaxDim max-dimens)
    (send self :Table table)
    (send self :Row-Sums rs)
    (send self :Col-Sums cs)
    (send self :Row-Mass r)
    (send self :Col-Mass c)
    (send self :Expected E)
    (send self :Deviation Diff)
    (send self :Contribution Contrib)
    (send self :RPI rpi)
    (send self :CPI cpi)
    (send self :RSC rsc)
    (send self :CSC csc)
    (send self :RI ri)
    (send self :CI ci)
    (send self :GSVD 
          (list A (diagonal Du) B (fourth gsvd)))
    (when (fourth gsvd)
          (send self :Normalize (send self :norm-opt))
          (send self :Compute-Residuals)
          (send self :Get-Best)
          (send self :flag))))
 
(defmeth Corresp-proto :Normalize (norm-opt)
"Args: (norm-opt)
    0 - Normalize Rows only
    1 - Normalize Columns only
    2 - Normalize Rows and Columns"
  (when (and (<= 0 norm-opt) (<= norm-opt 2))
        (send self :Norm-Opt norm-opt)
        (let* ((gsvd (send self :GSVD))
               (A (first gsvd))
               (Du (diagonal (second gsvd)))
               (B (third gsvd))
               (invDr (diagonal (/ (send self :Row-Mass))))
               (invDc (diagonal (/ (send self :Col-Mass))))
               (I (identity-matrix (- (send self :Ncols) 1))))
          (case norm-opt
            (0 (send self :Norm-Rows (%* invDr A Du))
               (send self :O-Norm-Rows (%* invDr A Du))
               (send self :Norm-Cols (%* invDc B))
               (send self :O-Norm-Cols (%* invDc B)))
            (1 (send self :Norm-Rows (%* invDr A))
               (send self :O-Norm-Rows (%* invDr A))
               (send self :Norm-Cols (%* invDc B Du))
               (send self :O-Norm-Cols (%* invDc B Du)))
            (2 (send self :Norm-Rows (%* invDr A Du))
               (send self :O-Norm-Rows (%* invDr A Du))
               (send self :Norm-Cols (%* invDc B Du))
               (send self :O-Norm-Cols (%* invDc B Du))))))
  (and (<= 0 norm-opt) (<= norm-opt 2)))
 
(defmeth Corresp-proto :Compute-Residuals ()
  (let* ((dimens (send self :dimension))
         (gsvd (send self :gsvd))
         (Ar (select (first gsvd) (iseq (send self :NRows))
                                  (iseq dimens)))
         (Dr (diagonal (select (second gsvd) (iseq dimens))))
         (Br (select (third gsvd) (iseq (send self :NCols))
                                  (iseq dimens)))
         (fitted (%* Ar Dr (transpose Br)))
         (resid (- (send self :Deviation) fitted)))
    (send self :Residuals resid)
    (send self :O-Residuals resid)))
 
(defmeth Corresp-proto :Get-Best ()
  (let* ((rpi (send self :rpi))
         (cpi (send self :cpi))
         (maxrpi (mapcar #'max (column-list rpi)))
         (maxcpi (mapcar #'max (column-list cpi)))
         (i 0)
         (j 0)
         (best-row-pts (iseq (length (column-list rpi))))
         (best-col-pts (iseq (length (column-list cpi)))))
    (dolist (x (column-list rpi))
            (do ((count1 0 (+ count1 1)))
                ((= (select x count1) (select maxrpi i))
                 (setf (select best-row-pts i) count1)))
            (setf i (+ i 1)))
    (dolist (y (column-list cpi))
            (do ((count2 0 (+ count2 1)))
                ((= (select y count2) (select maxcpi j))
                 (setf (select best-col-pts j) count2)))
            (setf j (+ j 1)))
    (send self :best-row-pts (select (send self :labels) best-row-pts))
    (send self :best-col-pts (select (send self :variables) best-col-pts))))
 
(defmeth Corresp-proto :flag ()
  (let* ((good (send self :norm-rows))
         (send self :norm-cols))
;forrest changed the following
    (when (not good) 
          (error-message "Computation terminated due to error.~%"))))         
 
(defmeth Corresp-proto :Report
  (&key (stream t) 
        (dialog nil)
        (Precision 2 setp) (Dimension 3 setd)
        (level "Brief"))
  (if (not (eq current-object self)) (setcm self))
  (if setp (send self :Precision precision))
  (if setd (send self :Dimension dimension))
  (let* ((w nil)
         (labels (send self :labels))
         (labels2 (combine labels "Total"))
         (vars (send self :variables))
         (p (send self :Precision))
         (d (send self :Dimension))
         (Row-Profiles (* (%* (inverse (diagonal (send self :Row-Mass)))
                              (send self :Table)) 100))
         (Col-Profiles (* (%* (send self :Table)
                              (inverse (diagonal (send self :Col-Mass)))) 100))
         (Row-sq-cos (select (send self :RSC)
                             (iseq (send self :Nrows))
                             (iseq d)))
         (Col-sq-cos (select (send self :CSC)
                             (iseq (send self :Ncols))
                             (iseq d)))
         (Row-Quality (mapcar #'sum (row-list Row-sq-cos)))
         (Col-Quality (mapcar #'sum (row-list Col-sq-cos)))
         (Dim-Labels (mapcar #'(lambda (x) (format nil "Dim ~a  " x))
                             (+ 1 (iseq d))))
         (B-R-P (matrix (list d 1)
                        (mapcar #'strcat Dim-Labels
                                (select (send self :Best-Row-Pts) (iseq d)))))
         (B-C-P (matrix (list d 1)
                        (mapcar #'strcat Dim-Labels
                                (select (send self :Best-Col-Pts) (iseq d)))))
         (Singular-Values (second (send self :GSVD)))
         (Inertias (^ Singular-values 2))
         (Chi-Sq (* 1000 (sum (send self :data)) Inertias))
         (Tot-Chi-Sq (sum Chi-sq))
         (Percent-Chi-Sq (* 100 (/ Chi-Sq Tot-Chi-Sq)))
         (CumPercent (* 100 (/ (cumsum Chi-Sq) Tot-Chi-sq)))
         (Norm-opt (send self :Norm-opt))
         (choice (cond
                   ((equalp level "brief")
                    (list (list 5)))
                   ((equalp level "normal")
                    (list (list 0 1 3 5)))
                   ((equalp level "detailed")
                    (list (list 0 1 2 3 4 5))))))
    (if dialog
        (setf Choice
              (choose-subset-dialog
               "Correspondence Analysis Report"
               '("Contingency Table"
                 "Row and Column Profiles"
                 "Chi-Square Statistics"
                 "Row and Column Coordinates"
                 "Inertias and Squared Cosines"
                 "Summary") :initial (select Choice 0))))
    (when Choice
          (setf w (report-header (send self :title)))
          (display-string
           (format nil "~a~2%" (send self :title)) w)
          (display-string
           (format nil "Model: ~a~2%" (send self :name)) w)
          (display-string
           (format nil "Variable Names: ~a~2%" vars) w)
          (when (member '0 (select Choice 0))
                (display-string
                 (format nil "~%Contingency Table~%") w)
                (print-matrix-to-window (fuzz (* (send self :table) 100) p) w :labels labels))
          (when (member '1 (select Choice 0))
                (display-string
                 (format nil "~%Row Profiles~%") w)
                (print-matrix-to-window (fuzz Row-Profiles p) w :labels labels)
                (display-string
                 (format nil "~%Column Profiles~%") w)
                (print-matrix-to-window (fuzz Col-Profiles p) w :labels labels))
          (when (member '2 (select Choice 0))
                (display-string
                 (format nil "~%Chi-Square Statistic (Expected Frequencies)~%") w)
                (print-matrix-to-window (fuzz (send self :Expected) p) w
                                        :labels labels)
                (display-string
                 (format nil "~%Observed Minus Expected Frequencies~%") w)
                (print-matrix-to-window (fuzz (send self :Deviation) p) w
                                        :labels labels)
                (display-string
                 (format nil "~%Percentage Contribution to Total Chi-Square Statistics~%") w)
                (print-matrix-to-window (fuzz (send self :Contribution) p) w
                                  :labels labels2))
          (when (member '3 (select Choice 0))
                (display-string
                 (format nil "~%Row Coordinates~%") w)
                (print-matrix-to-window
                 (fuzz (select (send self :O-Norm-Rows)
                               (iseq (send self :Nrows))
                               (iseq d)) p) w :labels labels)
                (display-string
                 (format nil "~%Column Coordinates~%") w)
                (print-matrix-to-window
                 (fuzz (select (send self :O-Norm-Cols)
                               (iseq (send self :Ncols))
                               (iseq d)) p) w :labels vars))
          (when (member '4 (select Choice 0))
                (display-string
                 (format nil "~%Partial Contribution to Inertia for Row Points~%") w)
                (print-matrix-to-window
                 (fuzz (select (send self :RPI)
                               (iseq (send self :Nrows))
                               (iseq d)) p) w :labels labels)
                (display-string
                 (format nil "~%Partial Contribution to Inertia for Column Points~%") w)
                (print-matrix-to-window
                 (fuzz (select (send self :CPI)
                               (iseq (send self :Ncols))
                               (iseq d)) p) w :labels vars)
                (display-string
                 (format nil "~%Squared Cosines for Row Points~%") w)
                (print-matrix-to-window (fuzz Row-sq-cos p) w :labels labels)
                (display-string
                 (format nil "~%Squared Cosines for Column Points~%") w)
                (print-matrix-to-window (fuzz Col-sq-cos p) w :labels vars))
          (when (member '5 (select Choice 0))
                (display-string
                 (format nil "~%Summary Statistics for Row Points~%Quality Mass  Inertia~%") w)
                (print-matrix-to-window
                 (fuzz (bind-columns Row-Quality
                                     (send self :Row-Mass)
                                     (send self :RI)) p) w :labels labels)
                (display-string
                 (format nil "~%Largest Contributor to Inertia~%") w)
                (print-matrix-to-window B-R-P w)
                (display-string
                 (format nil "~%Summary Statistics for Column Points~%Qualtiy Mass  Inertia~%") w)
                (print-matrix-to-window
                 (fuzz (bind-columns Col-Quality
                                     (send self :Col-Mass)
                                     (send self :CI)) p) w :labels vars)
                (display-string
                 (format nil "~%Largest Contributor to Inertia~%") w)
                (print-matrix-to-window B-C-P w)
                (display-string
                 (format nil "~%Singular Values~%") w)
                (print-matrix-to-window
                 (fuzz (matrix (list 1 (length singular-values))
                               Singular-Values) p) w)
                (display-string
                 (format nil "~%Principal Inertias~%") w)
                (print-matrix-to-window
                 (fuzz (matrix (list 1 (length inertias)) inertias) 4) w)
                (display-string
                 (format nil "~%Percentages of Inertia~%") w)
                (print-matrix-to-window
                 (fuzz (matrix (list 1 (length percent-chi-sq))
                               percent-chi-sq) 4) w)
                (display-string
                 (format nil "~%Cumulative Percentages of Inertia~%") w)
                (print-matrix-to-window
                 (fuzz (matrix (list 1 (length cumpercent))
                               cumpercent) 4) w)))))
 
(defmeth Corresp-proto :create-data
  (&key (dialog nil) 
        (row-scores t)
        (col-scores t)
        (input nil)
        (table nil)
        (expected nil))
  (if (not (eq current-object self)) (setcm self))
  (let ((Creator (send *desktop* :selected-icon))
        (Choice (list (list (if row-scores 0)
                            (if col-scores 1)
                            (if input      2)
                            (if table      3)
                            (if expected   4)))))
    (if dialog
        (setf Choice
              (choose-subset-dialog
               "Output Data Objects"
               '("Row Coordinates" "Column Coordinates"
                 "Analyzed Input Data" "Contingency Table"
                 "Expected Frequency")
               :initial (select Choice 0))))
    (when Choice
          (when (member '0 (select Choice 0))
                (send current-model :CRS-Row-Data-Object Creator))
          (when (member '1 (select Choice 0))
                (send current-model :CRS-Col-Data-Object Creator))
          (when (member '2 (select Choice 0))
                (send current-model :Create-Input-Data-Object "CRS" Creator))
          (when (member '3 (select Choice 0))
                (send current-model :CRS-Table-Data-Object Creator))
          (when (member '4 (select Choice 0))
                (send current-model :CRS-Expected-Data-Object Creator))))
  t);fwy 4.28 7/15/97 added t so gm works right
 
(defmeth Corresp-proto :CRS-Row-Data-Object (Creator)
  (data (concatenate 'string "Rows-" (send self :name))
        :created Creator
        :title (concatenate 'string "CRS Row Coordinates for "
                            (send self :title))
        :variables (mapcar #'(lambda (x) (format nil "Row-Dim~a" x))
                           (iseq (send self :MaxDim)))
        :labels (send self :labels)
        :types (repeat "Numeric" (send self :MaxDim))
        :data (combine (send self :O-Norm-Rows))))
 
(defmeth Corresp-proto :CRS-Col-Data-Object (Creator)
  (data (concatenate 'string "Cols-" (send self :name))
        :created Creator
        :title (concatenate 'string "CRS Column Coordinates for "
                            (send self :title))
        :variables (mapcar #'(lambda (x) (format nil "Col-Dim~a" x))
                           (iseq (send self :MaxDim)))
        :labels (send self :variables)
        :types (repeat "Numeric" (send self :MaxDim))
        :data (combine (send self :O-Norm-Cols))))
 
(defmeth Corresp-proto :CRS-Table-Data-Object (Creator)
  (data (concatenate 'string "Frequency-" (send self :name))
        :created Creator
        :title (concatenate 'string "Contingency Table for "
                            (send self :title))
        :variables (send self :variables)
        :labels (send self :labels)
        :types (send self :types)
        :data (combine (send self :Table))))
 
(defmeth Corresp-proto :CRS-Expected-Data-Object (Creator)
  (data (concatenate 'string "Expected-" (send self :name))
        :created Creator
        :title (concatenate 'string "Expected Frequency Table for "
                            (send self :title))
        :variables (send self :variables)
        :labels (send self :labels)
        :types (send self :types)
        :data (combine (send self :Expected))))
 
(defmeth Corresp-proto :save-model-template (data-object)
  `(Correspondence-Analysis
    :title ,(send self :title)
    :name ,(send self :name)
    :dialog nil
    :norm-opt ,(send self :norm-opt)
    :dimension ,(send self :dimension)
    :precision ,(send self :precision)
    :data (data ,(send data-object :name)
                :title ,(send data-object :title)
                :variables ',(send self :variables)
                :types     ',(send self :types)
                :labels    ',(send self :labels)
                :data      ',(send self :data))))
