;;; February 19, 2001 ;;; Alternative family of transformations that can be used when the response ;;; predictors are possibly negative or zero. ;;; This is currently an add-on for Arc. Put this file in the Extras folder ;;; and it will load automatically. Documentation and the latest source ;;; are available from ;;; http://www.stat.umn.edu/arc/addons.html ;;; Adding a new transformation family: ;;; 1. Write a function like yj-power below. It must include the ;;; included keyword, and not fail with missing values. For a ;;; parameter p and a variable y, return t(y,p), accounting for ;;; missing and not-included cases ;;; 2. Add to the parameter *transformations* (defined below) a list ;;; of 2 elements, first a name like 'yj-power for the family ;;; and then the name of the function, like #'yj-power. ;;; Steps 1 and 2 are enough to allow setting the global setting ;;; *transformation-default-family* to the name of the new family. It ;;; will then be used in graphics that use transformation families. ;;; Adding it to the Transformations dialog, or getting the transformed ;;; values changed automatically, will require modifying several of the ;;; methods in this file. ;;; new (arc-setting (QUOTE *Transformation-default-family*) (QUOTE box-cox) "Chooses the default transformation method for scatterplot matrices and elsewhere. Possible values are box-cox, yj-power, folded power, or modulus." (QUOTE box-cox) ) (defun yj-power (y p &key included (normalize t)) "Function args: (data power &key included (normalize t)) This function returns the normalized Yeo-Johnson transformation, suggested by In-Kwon Yeo and Richard A. Johnson (2000). A new family of power transformations to improve normality or symmetry, Biometrika, 87, 954-959." (let* ((lam (if (< (abs p) 1.e-6) 0 p)) (obs (find-obs y)) (gm (geometric-mean (^ (+ 1 (abs (select y obs))) (if-else (< (select y obs) 0) -1 1)) (if included (which (select included obs))))) (transform (mapcar #'(lambda (x) (cond ((and (>= x 0) (/= lam 0)) (/ (- (^ (+ x 1) lam) 1) lam)) ((and (>= x 0) (= lam 0)) (log (+ 1 x))) ((and (< x 0) (/= lam 2)) (- (/ (- (^ (+ (- x) 1) (- 2 lam)) 1) (- 2 lam)))) (t (- (log (+ (- x) 1)))))) (select y obs))) (z (copy-seq y))) (setf (select z obs) transform) (if normalize (/ z (^ gm (- lam 1))) z))) ;;; this item should be moved to arcinint.lsp (defparameter *transformations* (list (list 'box-cox #'box-cox-power) (list 'yj-power #'yj-power) (list 'yeo-johnson #'yj-power) (list 'folded-power #'folded-power) (list 'modulus #'modulus-transform))) (defun tranmethod (&optional (what *transformation-default-family*)) (let ((ans (assoc what *transformations*))) (if ans (second ans) #'box-cox-power))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; from overlay5.lsp (defmeth transform-control-proto :data (&key set masked-to-missing) (when set (setf (slot-value 'data) (send (send self :graph) :point-coordinate (send self :axis) (iseq (send (send self :graph) :num-points)))) (send self :visible (send self :is-visible))) ; new 2/15/2001 (let* ((data (slot-value 'data)) (masked (send self :points-missing))) (if masked-to-missing (setf (select data masked) (set-missing))) data)) (defmeth transform-control-proto :add-data (&key (overwrite nil)) (let* ((name (send self :name)) (dataset (send (send (send self :graph) :slot-value 'owner) :get-dataset)) (z (send self :data :masked-to-missing t)) (lam (select (send self :display) (send self :index)))) (when (/= lam 1) (send dataset :make-power-transform name :p lam :c 0 :b 'e :data z :family (send (send self :graph) :transformation-family))))) (defmeth transform-control-proto :is-visible () ;new 2/15/2001 (case (send (send self :graph) :transformation-family) (box-cox (and (> (min (select (slot-value 'data) (which (send self :not-missing)))) 0) (> (length (remove-duplicates (slot-value 'data))) 2))) (t t))) (defmeth graph-proto :transformation-family ; new 2/15/2001 (&optional (new *transformation-default-family* set)) "Method args (&optional (new *transformation-family-default* set)) Sets/returns the transformation family for a particular graph." (if (null (send self :has-slot 'transformation-family)) (send self :add-slot 'transformation-family new)) (if set (send self :slot-value 'transformation-family new)) (slot-value 'transformation-family)) (defmeth transform-control-proto :transform (&key modified) (let* ((x (send self :data)) (z (copy-seq x)) (family (send (send self :graph) :transformation-family)) (sel (which (send self :not-missing))) (lambda (select (send self :display) (send self :index)))) (setf (select z sel) (cond ((= lambda 1) (select x sel)) ((eq family 'yj-power) (yj-power (select x sel) lambda :normalize nil)) ((= lambda 0) (log (select x sel))) (modified (/ (- (^ (select x sel) lambda) 1) lambda)) (t (^ (select x sel) lambda)))) z)) (defmeth transform-control-proto :select-transform (&key (add t) (use-marks nil)) "Method args: (&key (add t) (use-marks t)) Finds the power transformation that will make the data for this plot control as close to normally distributed as possible. Maximizes the profile loglikelihood, using golden section search." (let* (ans (graph (send self :graph)) (axis (send self :axis)) (sel (send graph :points-visible)) (z (send self :data)) (m (send graph :mark)) (family (tranmethod (send graph :transformation-family)));2/2001 (selg (cond ((null m) (list sel)) ((and m use-marks) (mapcar #'(lambda (a) (intersection sel a)) (third m))) (t (let ((a (choose-item-dialog "Transform toward normality:" '("Condition on marking variable" "Ignore marking variable")))) (cond ((null a) (return-from :select-transform)) ((= a 0) (mapcar #'(lambda (a) (intersection sel a)) (third m))) (t (list sel)))))))) (flet ((llik (lam) (let* ((b (mapcar #'(lambda (x) (funcall family x lam)) (mapcar #'(lambda (s) (select z s)) selg))) (d (mapcar #'(lambda (b) (^ (- b (mean b)) 2)) b))) (* -0.5 (length b) (log (apply #'+ (mapcar #'sum d))))))) (def ans (first (golden #'llik -3 3 :epsilon .005 :min nil))) (when add (cond ((or (> ans 3) (< ans -3)) (sysbeep) (return-from :select-transform (message-dialog "Answer is unreasonable"))) (t (send self :add-to-slidebar (* .01 (round (* 100 ans))) :update t)))) (if (null add) (format t "Estimated Power = ~a~%" ans)) (max -3 (min 3 ans))))) ;;; ;;; transform-menu-proto from overlay5.lsp ;;; ;;; ;;; transformation menu proto, for scatterplot matrices ;;; written 94/10/26 by S. Weisberg ;;; (defmeth transform-menu-proto :menu () (let* ((graph (send self :graph)) (control self)) (when (null (slot-value 'menu)) (let* ((menu (send menu-proto :new "Transformation menu")) (family (send menu-item-proto :new (format nil "Family = ~a, select to change" (send graph :transformation-family)) :action #'(lambda () (send control :change-family)))) (logs (send menu-item-proto :new "Transform to logs" :action #'(lambda () (send control :all 0)))) (ones (send menu-item-proto :new "Restore to untransformed" :action #'(lambda () (send control :all 1)))) (saves (send menu-item-proto :new "Add transformed variables to dataset" :action #'(lambda () (send control :saves)))) (savea (send menu-item-proto :new "Add untransformed variables to dataset" :action #'(lambda () (send control :savea)))) (eval (send menu-item-proto :new "Evaluate LRT at..." :action #'(lambda () (send control :eval)))) (find (send menu-item-proto :new "Find normalizing transformations" :action #'(lambda () (send control :find))))) (defmeth eval :update () (send eval :enabled (send control :has-slot 'bc))) (defmeth family :update () (send family :title (format nil "Family = ~a, select to change" (string-capitalize (send graph :transformation-family))))) (mapcar #'(lambda (c) (defmeth c :update () (send c :enabled (send control :has-transforms)))) (list logs ones saves find)) (send self :make-menu menu family logs ones saves find eval) (setf (slot-value 'menu) menu))) (slot-value 'menu))) ;; currently, the following method only toggles between box-cox and ;; yj-power. To add other families, change the toggle to a dialog. (defmeth transform-menu-proto :change-family () (let* ((graph (send self :graph)) (ov (send graph :find-overlays 'transform-control-proto)) (family (send graph :transformation-family))) (send graph :transformation-family (if (eq family 'box-cox) 'yj-power 'box-cox)) ; the next bit redraws all the transformations with the new family (mapcar #'(lambda (o) (send o :visible (send o :is-visible)) (send o :index (if (send o :visible) (send o :index) (position 1 (send o :display) :test #'=)))) ov))) (defmeth transform-menu-proto :find (&key (summary t)) (let* ((c (send self :controls)) (c (select c (which (mapcar #'(lambda (c) (send c :visible)) c)))) (n (mapcar #'(lambda (c) (send c :title)) c)) (marks (send (send self :graph) :mark)) (n1 (let ((ans (trans-dialog n :marks marks))) (cond ((and ans (first ans)) ans) ((null ans) (return-from :find)) (t (return-from :find (message-dialog "No variables selected")))))) (c (select c (first n1))) (sv (send self :get-starting-values c (second n1))) (method (third n1)) (graph (send self :graph)) (bin-resp "") (bin-trial "") (family (send graph :transformation-family)) ; 2/17/2001 (sel (let ((a (repeat 0 (send graph :num-points))) (b (send graph :points-visible))) (cond ((null (select n1 3)) (setf (select a b) 1) (list a)) ((equal (select n1 3) "Mark") (mapcar #'(lambda (s) (let ((c (repeat 0 (send graph :num-points)))) (setf (select c (intersection s b)) 1) c)) (third marks))) ((equal (select n1 3) "Binomial") (let* ((w (send (send graph :slot-value 'owner) :get-binomial-weights (send graph :points-not-visible)))) (when w (setf bin-resp (second w)) (setf bin-trial (third w))) (if w (first w) (return-from :find))))))) (d (mapcar #'(lambda (c) (send c :data)) c)) (ans (bctransform d :sv sv :method method :sel sel :family family))) (send self :add-slot 'bc (list c (first ans) (fifth ans))) (send self :add-slot 'sel sel) (when summary (format t "Summary of Transformations to Normality~%") (format t "using the ~a family of transformations~%" (string-capitalize family)) (when (equal (select n1 3) "Mark") (format t "Conditioning on the marking variable ~a~%" (first marks))) (when (equal (select n1 3) "Binomial") (format t "Conditioning on binomial response = ~a, trials = ~%" bin-resp bin-trial)) (format t "Variable~20tLambda-hat~33tSE~40tWald test~51tWald test~%") (format t "~40tlambda =0~51tlambda =1~%") (mapcar #'(lambda (c lam se) (format t "~a~20t~6,3f~30t~6,3f~40t~6,2f~50t~6,2f~%" (send c :title) lam se (/ lam se) (/ (- lam 1) se))) c (first ans) (second ans)) (format t "~%") (format t "Likelihood ratio test of all lambda = 0:~41t~6,3f~49tdf =~3d p = ~4,3f~%" (third ans) (length c) (- 1 (chisq-cdf (third ans) (length c)))) (format t "Likelihood ratio test of all lambda = 1:~41t~6,3f~49tdf =~3d p = ~4,3f~%" (fourth ans) (length c) (- 1 (chisq-cdf (fourth ans) (length c))))) (mapcar #'(lambda (c ans) (cond ((and (< ans 3) (< -3 ans)) (send c :add-to-slidebar ans :update t)) (t (format t "***Unreasonable answer for ~a~%" (send c :title))))) c (* .01 (round (* 100 (first ans))))))) ;;; ;;; Added the family keyword 2/17/2001 to allow other than Box-Cox ;;; transformations ;;; (defun bctransform (z &key (sv (repeat 1 (length z))) (method #'newtonmax) (sel (list (repeat 1 (length (first z))))) (family 'box-cox)) "Message args: (z &key sv method sel) Finds power transformations of the lists in z to make the transformed data as close to normal as possible. Uses box-cox-power from Arc and newtonmax from xlispstat. The idea is taken from S. Velilla (1993), \"A note on the multivariate Box-Cox transformation to normality,\" Statistics and Probability Letters, 17, 259-263. sel is a list of lists defining groups and weights." (flet ((tloglik (lam) (bc-log-lik-profile z lam sel :family family))) (let* ((ans (funcall method #'tloglik sv :maxiter 10)) (se (sqrt (diagonal (inverse (- (numhess #'tloglik ans)))))) (mlr (tloglik ans)) (L0 (tloglik (repeat 0 (length z)))) (L1 (tloglik (repeat 1 (length z))))) (list ans se (* 2 (- mlr L0)) (* 2 (- mlr L1)) mlr)))) ;;; family arg added 2/17/2001 (defun bc-log-lik-profile (z lam wts &key (family 'box-cox)) "Function args: (z lam) z is a list of lists. Evaluates the log-likelihood profile, apart from constants, for the Box-Cox multivariate power model. See S. Velilla (1993), \"A note on the multivariate Box-Cox transformation to normality,\" Statistics and Probability Letters, 17, 259-263. Wts is a list of weights." (let* ((sw (sqrt wts)) (sel (mapcar #'(lambda (a) (which (if-else (= a 0) nil t))) wts)) (f (tranmethod family)) (x (mapcar #'(lambda (z2 lam2) (combine (mapcar #'(lambda (wts swts sel2) (let* ((w (select wts sel2)) (d (funcall f (select z2 sel2) lam2 :weights w)) (m (/ (sum (* d w)) (sum w)))) (* (select swts sel2) (- d m)))) wts sw sel))) z lam)) (s (sv-decomp (apply #'bind-columns x))) (d (coerce (second s) 'list))) (* -1 (length (first z)) (apply #'sum (log d))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; from reg3.lsp (defmeth regression-model-proto :yj-power (c p) (yj-power (+ (send self :yvar) c) p :included (send self :included))) (defun power-dialog () "Gets necessary information for using the Box-Cox method." (let* ((title (send text-item-proto :new "Use the method of Box & Cox to select a transformation of the response y, or of (y+c) if a constant c is specified. Also, choose a family of transformations. A confidence curve and the \"optimal\" value of the transformation is returned.")) (tf (send text-item-proto :new "Transformation Family")) (get-tf (send choice-item-proto :new (list "Box-Cox Power" "Yeo-Johnson Power" "Folded Power" "Modulus"))) (ty (send text-item-proto :new "Transform response +")) (get-ty (send edit-text-item-proto :new "0" :text-length (apply #'ms *text-width-short*))) ; (rt (send text-item-proto :new "Rankit plots of:")) ; (get-rt (send choice-item-proto :new (list "None" "Ordinary residuals" ; "Studentized residuals" "Ext. Studentized residuals") :value 0)) (cancel (send modal-button-proto :new "Cancel")) (get-answer #'(lambda () (list (select (list ':bcp ':yj-power ':folded-power ':modulus) (send get-tf :value)) ; (select (list nil ':residuals ':studentized-residuals ; ':externally-studentized-residuals) ; (send get-rt :value)) nil (with-input-from-string (s (send get-ty :text)) (read s)) ))) (ok (send modal-button-proto :new "OK" :action #'(lambda () (funcall get-answer)))) (dialog (send modal-dialog-proto :new (list (list title) (list tf get-tf) (list ty get-ty) ; (list rt get-rt) (list ok cancel))))) (send dialog :default-button ok) (send dialog :modal-dialog))) (defmeth regression-model-proto :bc-transform1 (&rest args &key residuals (shift 0) (lambda *power-transformation-selections*) (y-transform :bcp) (acc *power-transformation-accuracy*) (quantile-function #'normal-quant)) " Message Args: (&key residuals (shift 0) (lambda *power-transformations-selections*) (y-transform :bcp) (quantile-function #'normal-quant)) Returns a confidence curve (Cook & Weisberg, 1990 JASA, p. 544) of the log likelihood for transformations applied to the response and predictors in the model indexed by lam in the lambda-range. The transformation to y must be normalized to have Jacobian |dy/dlam| = 1. If :residuals is not nil, a dynamic slider probability plot is produced with quantiles generated by quantile function for the transformed model. See Cook and Weisberg, 1989, Technometrics." (let* (ans param val p2-needs-computing lmax proj (reg self) (make-proj #'(lambda () (project (send self :x-matrix) :intercept nil :included (send self :included) :weights (send self :pweights)))) (f-lik #'(lambda (y lam) (* -.5 (send self :num-included) (log (send proj :residual-sum-of-squares y))))) (get-values #'(lambda (lam) (let* ((y (let ((ans (send self y-transform shift lam))) (if ans ans (return-from :bc-transform1)))) (r (send proj residuals y))) (list (send self :quantiles :x r :quantile-function quantile-function) r (funcall f-lik y lam) lam)))) (get-max #'(lambda () (flet ((f (lam) (funcall f-lik (send self y-transform shift lam) lam))) (golden #'f -3 3 :min nil :epsilon acc)))) (data #'(lambda () (setf proj (funcall make-proj)) (let* ((ans1 (funcall get-max)) (or (order (second ans1)))) (setf lmax (first ans1)) (if (eq y-transform :bcp) (format t "~a:~a, Box-Cox method: y^{lambda-hat} = y^{~4,2f}~%" (send (send self :data) :name) (send self :name) lmax) (format t "~a:~a, ~a family: lambda-hat = ~4,2f~%" (send (send self :data) :name) (send self :name) y-transform lmax)) (setf p2-needs-computing t) (setf param (select (second ans1) or)) (setf val (select (third ans1) or)) (list val param)))) (p2 (apply #'send self :power-transform-confidence-curve (funcall data))) (p1 (if residuals (apply #'send self :make-plot data (list "Probability Scale" (methname-to-string residuals)) :title "Choose response transform" args) p2)) (xrange #'(lambda (x) (list (min x) (max x)))) (sval (send graph-control-proto :new)) (slider (when residuals (first (send p1 :dynamic-plot-control (iseq (length lambda)) lambda))))) (defmeth sval :do-click (&rest args) nil) (defmeth sval :redraw () (send p2 :draw-string (format nil "Lambda-hat = ~4,2f" lmax) 10 (+ 2 (send p2 :text-ascent)))) (defmeth sval :redraw-latex (output) (format output "\\put(~a,~a){\\makebox(0,0)[l]{~a}} % Lambda-max ~%" 5 (- (second (send p2 :size)) 2 (send p2 :text-ascent) (send p2 :text-descent)) (format nil "Lambda-hat = ~4,2f" lmax))) (send p2 :add-slot 'owner (send self :data)) (send (send self :data) :graphs p2) (send p2 :add-overlay sval) (defmeth p2 :close () (send (slot-value 'owner) :delete-graph self) (call-next-method)) (defmeth p2 :update-graph (&rest args) (send self :clear-lines) (send self :add-lines (apply #'send reg :dr-get-lines (funcall data)) :draw nil) (send self :adjust-to-data)) (setf p2-needs-computing nil) (when residuals (apply #'send p1 :nice-range 0 (funcall xrange (mapcar #'first ans))) (apply #'send p1 :nice-range 1 (funcall xrange (mapcar #'second ans))) (defmeth slider :do-action (j) (when (slot-value 'graph) (let* ((graph (send self :graph))) (send graph :draw-next-frame '(0 1) (list (select (mapcar #'first ans) j) (select (mapcar #'second ans) j))))))) p2)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; from rgraph2.lsp (defmeth boxplot-transform-control-proto :select-transform (&key (add t) (use-marks nil)) "Method args: (&key (add t) (use-marks t)) Finds the power transformation that will make the data for this plot control as close to normally distributed as possible. Maximizes the profile loglikelihood, using golden section search." (let* (ans (graph (send self :graph)) (axis (send self :axis)) (sel (which (send graph :included))) (z (select (send self :data) sel)) (x (send graph :point-coordinate 0 sel)) (g (nsplit x :delete-singles t)) (f (send graph :transformation-family)) (selg (cond ((null g) (message-dialog "All groups have one observation") (return-from :select-transform)) ((= (length g) 1) (list sel)) (use-marks g) (t (let ((a (choose-item-dialog "Transform toward normality:" '("Condition on marking variable" "Ignore marking variable")))) (cond ((null a) (return-from :select-transform)) ((= a 0) g) (t (list sel)))))))) (flet ((llik (lam) (let* ((b (mapcar #'(lambda (x) (funcall (tranmethod f) x lam)) (mapcar #'(lambda (s) (select z s)) selg))) (d (mapcar #'(lambda (b) (^ (- b (mean b)) 2)) b))) (* -0.5 (length b) (log (apply #'+ (mapcar #'sum d))))))) (def ans (first (golden #'llik -3 3 :epsilon .005 :min nil))) (when add (cond ((or (> ans 3) (< ans -3)) (sysbeep) (return-from :select-transform (message-dialog "Answer is unreasonable"))) (t (send self :add-to-slidebar (* .01 (round (* 100 ans))) :update t)))) (if (null add) (format t "Estimated Power = ~a~%" ans)) (max -3 (min 3 ans))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; dataset2.lsp ;;; (defmeth dataset-proto :make-power-transform (name &rest args &key p c b data family (allow-duplicate-name t)) (if (eq family 'yj-power) (apply #'send self :make-yj-transformation name args) (let* ((base (let ((b (send self :find-datalist name))) (if b b (send datalist-proto :new :variate :name name :data data)))) (x (+ c (if base (send base :data) (send self :name-to-data name)))) (n1 (if base name (select name (remove (find-character name) (iseq (length name)))))) (ok (check-power-transform x p b))) (cond ((null ok) (message-dialog (format nil "Transformation of ~a is not defined for all values" name))) (t (let* ((n (transform-label n1 p c b)) (obs (find-obs x)) (val (copy-seq x))) (setf (select val obs) (cond ((and (= p 0) (eq b 'e)) (log (select x obs))) ((= p 0) (log (select x obs) b)) (t (if (eq family 'modified) (/ (- (^ (select x obs) p) 1) p) (^ (select x obs) p))))) (unless (and (null allow-duplicate-name) (send self :find-datalist n)) (send self :variate :data val :name n :verbose *transformation-friendly-message* :info (if (= p 0) (format nil "Base ~a log of ~a" b name) (format nil "~aower transform of ~a" (if (eq family 'modified) "Modified p" "P") name)))))))))) (defmeth dataset-proto :make-yj-transformation (name &rest args &key p c b data family (allow-duplicate-name t)) (let* ((base (let ((b (send self :find-datalist name))) (if b b (send datalist-proto :new :variate :name name :data data)))) (x (+ c (if base (send base :data) (send self :name-to-data name)))) (n1 (if base name (select name (remove (find-character name) (iseq (length name)))))) (n (if (= c 0) (format nil "YJ-power[~a,~a]" name p) (format nil "YJ-power[~a+~a,~a]" name c p))) (val (yj-power x p :normalize nil))) (unless (and (null allow-duplicate-name) (send self :find-datalist n)) (send self :variate :data val :name n :verbose *transformation-friendly-message* :info "Yeo-Johnson power transformation")))) ;revised 991029 revised 010215 (defun transform-dialog (names) "Function args: name Opens a dialog box to get information about a transformation. For use with regression model proto." (let* ((power (send text-item-proto :new "p:")) (center (send text-item-proto :new "c:")) (center-d (send edit-text-item-proto :new "0" :text-length (apply #'ms *text-width-min*))) (power-d (send edit-text-item-proto :new "0" :text-length (apply #'ms *text-width-min*))) (base (send text-item-proto :new "b:")) (base-d (send edit-text-item-proto :new (format nil "~a" (if (equal *logarithm-base-default* 'e) "e" *logarithm-base-default*)) :text-length (apply #'ms *text-width-min*))) (types (send choice-item-proto :new (list "Power transformations: (x+c)^p" "Log transformations: log(x+c)" "Modified power: [(x+c)^p-1]/p" "Yeo-Johnson power") :value 0)) (family-names (list 'box-cox 'box-cox 'modified 'yj-power)) (all (send allocate-items-proto :new)) (left (send subordinate-list-proto :new names 'primary all)) (right (send subordinate-list-proto :new (repeat "" (length names)) 'secondary all)) (left-h (send text-item-proto :new "Candidates")) (right-h (send text-item-proto :new "Selection")) (chooser-name (send text-item-proto :new "Choose one or more variates to transform with a power or log transformation by double-clicking on variable names.")) (base-name (send text-item-proto :new "Logs are base b (e or a positive number)")) (cancel (send modal-button-proto :new "Cancel")) (get-answer #'(lambda (do-again) (list (select (send all :value) 1) :p (if (= (send types :value) 1) 0 (send power-d :value)) :family (select family-names (send types :value) ) :c (send center-d :value) :b (send base-d :value) :repeat do-again))) (again (send modal-button-proto :new "Again" :action #'(lambda () (funcall get-answer t)))) (done (send modal-button-proto :new "OK" :action #'(lambda () (funcall get-answer nil)))) (dialog (send modal-dialog-proto :new (list chooser-name (list (list left-h left) (list right-h right)) (list types) base-name (list power power-d center center-d base base-d) (list done again cancel))))) (send dialog :default-button done) (send dialog :modal-dialog))) ;;; ;;; Some documentation functions, not currently used, but a good idea ;;; in any case ;;; (defun yeo-johnson-help () (big-message-dialog "The Yeo-Johnson family of transformations allow using power transformations when values of a variable y may be negative. For a transformation parameter lam, the transformation is defined by:" "For y >= 0, return the Box-Cox transformation of (y+1) with power lam." "For y<0, return Box-Cox transformation of (-y+1) with power (2-lam)." )) (defun box-cox-help () (big-message-dialog "The Box-Cox family of transformations is defined for a variable y that is strictly positive and a parameter lam by:" "(y^(lam) -1)/lam if lam not equal to 0" "log(y) if lam is equal to 0")) (defun folded-power-help () (big-message-dialog "The folded family of transformations allow using power transformations when values of a variable y may be negative. For a transformation parameter lam, the transformation is defined by:" "For y >= 0, return the Box-Cox transformation of y with power lam." "For y<0, return Box-Cox transformation of -y with power lam." )) (defun power-family-help () (big-message-dialog "Arc includes several families of transformation of a variable y based on the basic power family of transformations." "The Box-Cox method requires that all elements of y > 0 and is defined by" "(y^(lam) -1)/lam if lam not equal to 0" "log(y) if lam is equal to 0" "The Yeo-Johnson family (yj-power) allows negative y and is given by" "For y >= 0, return the Box-Cox transformation of (y+1) with power lam." "For y<0, return Box-Cox transformation of (-y+1) with power (2-lam)." "The folded power family also permits negative y, and is obtained by applying the Box-Cox transformation to |y|." ))