;
;******************************************************
;
; dialogs.
;
; ena - 3/7/2000.
;
;******************************************************
;
(provide "dialogs")
;
(defun get-read-covar-values ()
   (let*
      (
         (prompt (send text-item-proto :new "covariate name:"))
         (name (send edit-text-item-proto :new "" :text-length 20))
         (jit-check (send toggle-item-proto :new "jitter"))
         (ok (send modal-button-proto :new "OK" 
            :action #'(lambda () 
               (list (send name :text) (send jit-check :value)))))
         (read-covars-dialog (send modal-dialog-proto :new
            (list
               (list prompt name)
               jit-check
               ok
               )
            ))
         )
      (send read-covars-dialog :default-button ok)
      (send read-covars-dialog :modal-dialog)
      )
   )
;
(defun choose-2-covars ()
   (let*
      (
         (first-item (send choice-item-proto :new *covar-names*))
         (second-item (send choice-item-proto :new *covar-names*))
         (first-label (send text-item-proto :new "x variable"))
         (second-label (send text-item-proto :new "y variable"))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda ()
               (list (send first-item :value) (send second-item :value))))
            )
         (choose-2-covars-dialog
            (send modal-dialog-proto :new
               (list
                  (list
                     (list first-label first-item)
                     (list second-label second-item)
                     )
                   ok
                   )
                )
             )
          )
       (send choose-2-covars-dialog :default-button ok)
       (send choose-2-covars-dialog :modal-dialog)
       )
   )
;
(defun choose-3-covars ()
   (let*
      (
         (first-item (send choice-item-proto :new *covar-names*))
         (second-item (send choice-item-proto :new *covar-names*))
         (third-item (send choice-item-proto :new *covar-names*))
         (first-label (send text-item-proto :new "x variable"))
         (second-label (send text-item-proto :new "y variable"))
         (third-label (send text-item-proto :new "z variable"))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda ()
               (list (send first-item :value) (send second-item :value) (send third-item :value))))
            )
         (choose-3-covars-dialog
            (send modal-dialog-proto :new
               (list
                  (list
                     (list first-label first-item)
                     (list second-label second-item)
                     (list third-label third-item)
                     )
                   ok
                   )
                )
             )
          )
       (send choose-3-covars-dialog :default-button ok)
       (send choose-3-covars-dialog :modal-dialog)
       )
   )
;
(defun choose-2-spectra ()
   (let*
      (
         (first-item (send choice-item-proto :new *spectra-names*))
         (second-item (send choice-item-proto :new *spectra-names*))
         (first-label (send text-item-proto :new "spectrum 1"))
         (second-label (send text-item-proto :new "spectrum 2"))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda ()
               (list (send first-item :value) (send second-item :value))))
            )
         (choose-2-covars-dialog
            (send modal-dialog-proto :new
               (list
                  (list
                     (list first-label first-item)
                     (list second-label second-item)
                     )
                   ok
                   )
                )
             )
          )
       (send choose-2-covars-dialog :default-button ok)
       (send choose-2-covars-dialog :modal-dialog)
       )
   )
;
(defun yes-or-no-dialog (text)
   (let*
      (
         (yes (send modal-button-proto :new "Yes" 
            :action #'(lambda () T)))
         (no (send modal-button-proto :new "No"
            :action #'(lambda () nil)))
         (question (send text-item-proto :new text))
         (y-n-dialog (send modal-dialog-proto :new
            (list question (list yes no))))
         )
      (send y-n-dialog :default-button yes)
      (send y-n-dialog :modal-dialog)
      )
   )
;
(defun get-pca-info ()
   (let*
      (
         (spectrum (choose-item-dialog "Select spectrum for analysis." *spectra-names*))
         (spect-name (select *spectra-names* spectrum))
         (numpc (first (get-value-dialog "Number of principal components:")))
         (analysis-name-prompt (send text-item-proto :new
            "Enter name for analysis:"))
         (analysis-name-val (send edit-text-item-proto :new
            (concatenate 'string "PCA " 
            spect-name)))
         (covariates-prompt (send text-item-proto :new
            "Select covariates for analysis:"))
         (covariates-val (mapcar #'(lambda (x) (send toggle-item-proto :new x :value T)) *covar-names*))
         (weight-prompt (send text-item-proto :new "Enter names for PCA weights:"))
         (weight-labels (mapcar #'(lambda (x) (concatenate 'string spect-name
            " PCA wt " (with-output-to-string (s) (prin1 x s)))) (+ (iseq numpc) 1)))
         (weight-names-vals (mapcar #'(lambda (x) (send edit-text-item-proto :new x))
            weight-labels))
         (weight-fit-prompt (send text-item-proto :new "Enter names for predicted PCA weights:"))
         (weight-fit-labels (mapcar #'(lambda (x) (concatenate 'string spect-name
            " PCA wt pred " (with-output-to-string (s) (prin1 x s)))) (+ (iseq numpc) 1)))
         (weight-fit-names-vals (mapcar #'(lambda (x) (send edit-text-item-proto :new x))
            weight-fit-labels))
         (pca-resid-prompt (send text-item-proto :new
            "Enter name for norm of PCA residuals:"))
         (pca-resid-val (send edit-text-item-proto :new 
            (concatenate 'string spect-name " PCA resid")))
         (regress-resid-prompt (send text-item-proto :new
            "Enter name for norm of regression residuals:"))
         (regress-resid-val (send edit-text-item-proto :new 
            (concatenate 'string spect-name " regress resid")))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda () 
            (list 
               spectrum 
               numpc 
               (send analysis-name-val :text)
               (mapcar #'(lambda (x) (send x :value)) covariates-val)
               (mapcar #'(lambda (x) (send x :text)) weight-names-vals)
               (mapcar #'(lambda (x) (send x :text)) weight-fit-names-vals)
               (send pca-resid-val :text)
               (send regress-resid-val :text)
               )))
            )
         (get-regress-info-dialog
            (send modal-dialog-proto :new
               (list
                  (list analysis-name-prompt analysis-name-val)
                  (list pca-resid-prompt pca-resid-val)
                  (list regress-resid-prompt regress-resid-val)
                  (list covariates-prompt covariates-val)
                  (list
                     (list 
                        weight-prompt
                        (list weight-names-vals)
                        )
                     (list
                        weight-fit-prompt
                        (list weight-fit-names-vals)
                        )
                     )
                  ok
                  )
               )
            )
         )
      (send get-regress-info-dialog :default-button ok)
      (send get-regress-info-dialog :modal-dialog)
      )
   )
;
(defun display-regress-dialog (reg)
   (let*
      (
         (est (send reg :coef-estimates))
         (se (send reg :coef-standard-errors))
         (names (send reg :predictor-names))
         (df (send reg :df))
         (tvals (/ est se))
         (p-vals (mapcar #'(lambda (x) (* 2 (- 1 (t-cdf (abs x) df)))) tvals))
         (est-txt (mapcar #'num2string est))
         (se-txt (mapcar #'num2string se))
         (p-vals-txt (mapcar #'num2string p-vals))
         (names-item (cons "constant" (mapcar #'(lambda (x) (send text-item-proto :new x)) names)))
         (est-item (mapcar #'(lambda (x) (send text-item-proto :new x)) est-txt))
         (se-item (mapcar #'(lambda (x) (send text-item-proto :new x)) se-txt))
         (p-vals-item (mapcar #'(lambda (x) (send text-item-proto :new x)) p-vals-txt))
         (ok (send modal-button-proto :new "OK" :action #'(lambda () T)))
         (display-dialog (send modal-dialog-proto :new
            (list
               (list
                  (append (list "variable") names-item)
                  (append (list "coeff") est-item)
                  (append (list "se") se-item)
                  (append (list "P val") p-vals-item)
                  )
               ok
               )
            ))
         )
      (send display-dialog :default-button ok)
      (send display-dialog :modal-dialog)
      )
   )
;
(defun get-fetch-values ()
   (let*
      (
         (choose-var-label (send text-item-proto :new "Variable to fetch:"))
         (choose-var (send choice-item-proto :new *covar-names*))
         (save-var-label (send text-item-proto :new "Name to save as:"))
         (save-var-name (send edit-text-item-proto :new ""
            :text-length 20))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda ()
               (list (send save-var-name :text) (send choose-var :value)
               )
            )))
         (get-fetch-values-dialog (send modal-dialog-proto :new
            (list
               choose-var-label
               choose-var
               (list save-var-label save-var-name)
               ok
               )
            ))
         )
      (send get-fetch-values-dialog :default-button ok)
      (send get-fetch-values-dialog :modal-dialog)
      )
   )
;
(defun get-store-values ()
   (let*
      (
         (in-name-prompt (send text-item-proto :new 
            "Name of variable to store"))
         (store-name-prompt (send text-item-proto :new
            "Name to store variable as:"))
         (in-name-text (send edit-text-item-proto :new ""
            :text-length 20))
         (store-name-text (send edit-text-item-proto :new ""
            :text-length 20))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda ()
               (list (send in-name-text :text)
                     (send store-name-text :text)
                     )
               )))
         (get-store-values-dialog (send modal-dialog-proto :new
            (list
               (list in-name-prompt in-name-text)
               (list store-name-prompt store-name-text)
               ok
               ))
            )
         )
      (send get-store-values-dialog :default-button ok)
      (send get-store-values-dialog :modal-dialog)
      )
   )
;
(defun get-inten-reg-info ()
   (let*
      (
         (spectrum (choose-item-dialog "Select spectrum for analysis." *spectra-names*))
         (spect-name (select *spectra-names* spectrum))
         (analysis-name-prompt (send text-item-proto :new
            "Enter name for analysis:"))
         (analysis-name-val (send edit-text-item-proto :new
            (concatenate 'string "Int reg " 
            spect-name)))
         (covariates-prompt (send text-item-proto :new
            "Select covariates for analysis:"))
         (covariates-val (mapcar #'(lambda (x) (send toggle-item-proto :new x :value T)) 
            *covar-names*))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda () 
            (list 
               spectrum 
               (send analysis-name-val :text)
               (mapcar #'(lambda (x) (send x :value)) covariates-val)
               )))
            )
         (get-inten-reg-info-dialog
            (send modal-dialog-proto :new
               (list
                  (list analysis-name-prompt analysis-name-val)
                  (list covariates-prompt covariates-val)
                  ok
                  )
               )
            )
         )
      (send get-inten-reg-info-dialog :default-button ok)
      (send get-inten-reg-info-dialog :modal-dialog)
      )
   )
;
(defun get-plot-reg-info (reg)
   (let*
      (
         (prompt (send text-item-proto :new
            "Summaries to plot:"))
         (prompt-coef (send text-item-proto :new
            "Coefficients to plot:"))
         (rsq-toggle (send toggle-item-proto :new "r-squared" :value T))
         (pval-toggle (send toggle-item-proto :new "P values" :value T))
         (coef-toggle (mapcar #'(lambda (x) (send toggle-item-proto
            :new x :value T)) (append (list "constant") (send reg :slot-value 
            'covar-names))))
         (ok (send modal-button-proto :new "OK"
            :action #'(lambda () 
            (list 
               (send rsq-toggle :value)
               (send pval-toggle :value)
               (mapcar #'(lambda (x) (send x :value)) coef-toggle)
               )))
            )
         (get-plot-reg-info-dialog
            (send modal-dialog-proto :new
               (list
                  prompt
                  rsq-toggle
                  pval-toggle
                  prompt-coef
                  (list coef-toggle)
                  ok
                  )
               )
            )
         )
      (send get-plot-reg-info-dialog :default-button ok)
      (send get-plot-reg-info-dialog :modal-dialog)
      )
   )