home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Garbo
/
Garbo.cdr
/
mac
/
science
/
xlspstr1.sit
/
oneway.lsp
< prev
next >
Wrap
Lisp/Scheme
|
1990-08-15
|
4KB
|
139 lines
;;;; XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney
;;;; Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz
;;;; You may give out copies of this software; for conditions see the file
;;;; COPYING included with this distribution.
(provide "oneway")
(require "regression")
;;;;
;;;;
;;;; One Way ANOVA Model Prototype
;;;;
;;;;
(defproto oneway-model-proto '(grouped-data) '() regression-model-proto)
(defun oneway-model (data &key (print t) group-names)
"Args: ( data &key (print t))
DATA: list of compound-data
Example:"
(let ((data (mapcar #'(lambda (x) (coerce x 'list)) data))
(m (send oneway-model-proto :new)))
(send m :grouped-data data)
(send m :group-names group-names)
(if print (send m :display))
m))
(defmeth oneway-model-proto :display ()
"Message args: ()
Prints the least squares regression summary."
(call-next-method)
(format t "Group Mean Square: ~10g ~A~%"
(send self :group-mean-square) (list (send self :group-df)))
(format t "Error MeanSquare: ~10g ~A~%"
(send self :error-mean-square) (list (send self :error-df)))
(format t "~%"))
(defmeth oneway-model-proto :save ()
"Message args: ()
Returns an expression that will reconstruct the model."
`(oneway-model ',(send self :grouped-data)
:group-names ',(send self :group-names)))
;;;
;;; Slot Accessors and Mutators
;;;
(defmeth oneway-model-proto :grouped-data (&optional data)
"Message args: (&optional data)
Sets or returns the grouped data."
(when data
(let* ((y (apply #'append data))
(indices (repeat (iseq 0 (- (length data) 1))
(mapcar #'length data)))
(levels (remove-duplicates indices))
(indicators (mapcar #'(lambda (x) (if-else (= x indices) 1 0))
levels))
(x (apply #'bind-columns indicators)))
(setf (slot-value 'y) y)
(setf (slot-value 'x) x)
(setf (slot-value 'intercept) nil)
(setf (slot-value 'grouped-data) data)
(send self :needs-computing t)))
(slot-value 'grouped-data))
(defmeth oneway-model-proto :group-names (&optional (names nil set))
"Method args: (&optional names)
Sets or returns group names."
(if set (setf (slot-value 'predictor-names) names))
(let ((g-names (slot-value 'predictor-names))
(ng (length (slot-value 'grouped-data))))
(if (not (and g-names (= ng (length g-names))))
(setf (slot-value 'predictor-names)
(mapcar #'(lambda (a) (format nil "Group ~a" a))
(iseq 0 (- ng 1))))))
(slot-value 'predictor-names))
;;;
;;; Overrides for Linear Regression Methods
;;;
(defmeth oneway-model-proto :y ()
"
Message args: ()
Returns the response vector."
(call-next-method))
(defmeth oneway-model-proto :x ()
"Message args: ()
Returns the design matrix."
(call-next-method))
(defmeth oneway-model-proto :intercept (&rest args)
"Message args: ()
Always returns nil. For compatibility with linear regression."
nil)
(defmeth oneway-model-proto :predictor-names () (send self :group-names))
;;;
;;; Other Methods
;;;
(defmeth oneway-model-proto :standard-deviations ()
"Message args: ()
Returns list of within group standard deviations."
(mapcar #'standard-deviation (send self :grouped-data)))
(defmeth oneway-model-proto :group-df ()
"Message args: ()
Returns degrees of freedom for groups."
(- (length (send self :grouped-data)) 1))
(defmeth oneway-model-proto :group-sum-of-squares ()
"Message args: ()
Returns sum of squares for groups."
(sum (^ (- (send self :fit-values) (mean (send self :y))) 2)))
(defmeth oneway-model-proto :group-mean-square ()
"Message args: ()
Returns mean square for groups."
(/ (send self :group-sum-of-squares) (send self :group-df)))
(defmeth oneway-model-proto :error-df ()
"Message args: ()
Returns degrees of freedom for error."
(send self :df))
(defmeth oneway-model-proto :error-mean-square ()
"Message args: ()
Returna mean square for error."
(/ (send self :sum-of-squares) (send self :df)))
(defmeth oneway-model-proto :boxplots ()
"Message args: ()
Produce parallel box plots of the groups."
(boxplot (send self :grouped-data)))