;;;;##########################################################################
;;;;  $Id: Ext-oneway.lsp,v 1.2 1994/01/26 20:59:43 bates Exp $
;;;;  File            : Ext-oneway.lsp
;;;;  Author          : Douglas Bates (bates@stat.wisc.edu)
  
;;;;  PURPOSE
;;;;  	Extended one-way analysis of variance prototype
  
;;;;######################################################################### 

;;;; GENERAL DISCLAIMER
 
;;;; This program is free software; you can redistribute it
;;;; and/or modify it under the terms of the GNU General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 1, or (at your option) any later version.
 
;;;; This program is distributed in the hope that it will be
;;;; useful, but WITHOUT ANY WARRANTY; without even the implied
;;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;;; PURPOSE.  See the GNU General Public License for more
;;;; details.
 
;;;; You should have received a copy of the GNU General Public
;;;; License along with this program; if not, write to the Free
;;;; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;;; 02139, USA.
 
;;;; In short: you may use this code any way you like, as long as you
;;;; don't charge money for it, remove this notice, or hold anyone liable
;;;; for its results.

(provide "Ext-oneway")

(require "oneway")

;;;;
;;;;
;;;; Extended One Way ANOVA Model Prototype
;;;;
;;;;

(defproto Ext-oneway-model-proto '(f-ratio p-value) ()
  oneway-model-proto
  "Extended one-way analysis of variance model")

(defun Ext-oneway-model (data &key (print t) group-names)
"Args: ( data &key (print t) group-names)
DATA: list of compound-data
PRINT: whether to print the fit
GROUP-NAMES: Names for the groups"
(let ((data (mapcar #'(lambda (x) (coerce x 'list)) data))
      (m (send Ext-oneway-model-proto :new)))
    (send m :grouped-data data)
    (send m :group-names group-names)
    (if print (send m :display))
    m))

(defmeth Ext-oneway-model-proto  :save ()
"Message args: ()
Returns an expression that will reconstruct the model."
  `(Ext-oneway-model ',(send self :grouped-data) 
                 :group-names ',(send self :group-names)))
                       
(defmeth Ext-oneway-model-proto :anova-table ()
"Message args: ()
Prints the ANOVA table for the one-way analysis of variance."
  (let* ((group-mean-square (send self :group-mean-square))
	(error-mean-square (send self :error-mean-square))
	(f-ratio (send self :f-ratio))
	(p-value (send self :p-value)))
    (format t "                           Degrees~%")
    (format t "Source of          Sum of     of    Mean   F-ratio p-value~%")
    (format t "Variation         Squares  Freedom Square~%~%")
    (format t "  Group       ~10g     ~4,0g ~8g ~10g ~6,4g~%"
	    (send self :group-sum-of-squares) (send self :group-df)
	    group-mean-square f-ratio p-value)
    (format t "  Error       ~10g     ~4,0g ~8g~%"
	    (send self :sum-of-squares) (send self :error-df)
	    error-mean-square)
    (format t "  Total       ~10g     ~4,0g~%"
	    (+ (send self :group-sum-of-squares) (send self :sum-of-squares))
	    (+ (send self :group-df) (send self :error-df))
	    )
    )
  )

(defmeth Ext-oneway-model-proto :ref-plot (&optional (npts 51))
"Message args: (&optional (npts 51))
Create a plot of the group means with a reference distribution
connected to a slider.  The argument npts specifies the number of
points to be used in the plot of the reference distribution.
Based on the method described in section 6.7 of \"Statistics for
Experimenters\" by Box, Hunter, and Hunter (Wiley, 1979)"
  (let* ((scale-factor (sqrt (/ (send self :error-mean-square)
				(mean (mapcar
				       #'length
				       (send self :grouped-data))))))
	 (coefs (send self :coef-estimates))
	 (txvals (rseq -4 4 npts))
	 (yvals (t-dens txvals (send self :error-df)))
	 (xvals (+ (mean coefs) (* scale-factor txvals)))
	 (rp (plot-lines xvals yvals :title "Ref. dist'n" :show nil))
	 (rp-size (send rp :size)))
    (send rp :hide-window)
    (let ((range (get-nice-range (- (min coefs) (* 2 scale-factor))
	                  (+ (max coefs) (* 2 scale-factor)) 6)))
      (send rp :range 0 (nth 0 range) (nth 1 range))
      (send rp :x-axis t nil (nth 2 range)))
    (send rp :range 1 -0.15 (select (send rp :range 1) 1))
    (send rp :add-points (list coefs (+ -0.1 (* 0.05 (uniform-rand (length coefs))))))
    (send rp :point-symbol (iseq (length coefs)) 'dot4)
    (send rp :abline 0 0)
    (send rp :y-axis nil nil 0)
    (send rp :size (select rp-size 0) (round (/ (select rp-size 1) 3)))
    (send rp :show-window)
    (interval-slider-dialog
     (list (min coefs) (max coefs))
     :points npts
     :title "Ref. center"
     :action #'(lambda (x)
		 (send rp :clear-lines)
		 (send rp :add-lines (+ x (* scale-factor txvals)) yvals)
		 (send rp :abline 0 0)))
    rp))
  
;;;
;;; Slot Accessors and Mutators
;;;

(defmeth Ext-oneway-model-proto  :f-ratio ()
"Message args: ()
Returns the F-ratio for the one-way analysis of variance model"
  (cond ((slot-value 'f-ratio) (slot-value 'f-ratio))
	(t (setf (slot-value 'f-ratio)
		 (/ (send self :group-mean-square)
		    (send self :error-mean-square)))
	   (slot-value 'f-ratio))))

(defmeth Ext-oneway-model-proto  :p-value ()
"Message args: ()
Returns the p-value for the one-way analysis of variance model"
  (cond ((slot-value 'p-value) (slot-value 'p-value))
	(t (setf (slot-value 'p-value)
		 (- 1 (f-cdf (send self :f-ratio)
			     (send self :group-df)
			     (send self :error-df))))
	   (slot-value 'p-value))))