home *** CD-ROM | disk | FTP | other *** search
- ;;;; A Data Set Prototype
- (defproto data-set-proto '(data title))
-
- (defmeth data-set-proto :isnew (data &key title)
- (send self :data data)
- (if title (send self :title title)))
-
- (defmeth data-set-proto :title (&optional (title nil set))
- "Method args: (&optional title)
- Sets or retrieves the object's title."
- (if set (setf (slot-value 'title) title))
- (slot-value 'title))
-
- (defmeth data-set-proto :data (&optional (data nil set))
- "Method args: (&optional data)
- Sets or retrieves the object's data."
- (if set (setf (slot-value 'data) data))
- (slot-value 'data))
-
- (defmeth data-set-proto :describe (&optional (stream t))
- "Method args: (&optional (stream t))
- Prints a simple description of the object to STREAM."
- (let ((title (send self :title))
- (data (send self :data)))
- (format stream "This is ~a~%" title)
- (format stream "The sample mean is ~g~%" (mean data))
- (format stream "The sample standard deviation is ~g~%"
- (standard-deviation data))))
-
- (defmeth data-set-proto :plot () (histogram (send self :data)))
-
- (defmeth data-set-proto :save ()
- `(send data-set-proto :new
- ',(send self :data)
- :title ',(send self :title)))
-
- (send data-set-proto :title "a data set")
-
- (defun make-data-set (x &key (title "a data set") (print t))
- (let ((object (send data-set-proto :new x :title title)))
- (if print (send object :describe))
- object))
-
- ;;;; A Time Series Prototype
-
- (defproto time-series-proto
- '(origin spacing) () data-set-proto)
-
- (defmeth time-series-proto :origin (&optional (origin nil set))
- (if set (setf (slot-value 'origin) origin))
- (slot-value 'origin))
-
- (defmeth time-series-proto :spacing (&optional (sp nil set))
- (if set (setf (slot-value 'spacing) sp))
- (slot-value 'spacing))
-
- (defmeth time-series-proto :plot ()
- (let* ((data (send self :data))
- (time (+ (send self :origin)
- (* (iseq (length data))
- (send self :spacing)))))
- (plot-points time data)))
- #|
- (defmeth time-series-proto :plot ()
- (let ((data (send self :data)))
- ; (plot-points (iseq 0 (- (length data) 1)) data)))
- (plot-points (iseq (length data)) data)))
- |#
- (defmeth time-series-proto :describe (&optional (stream t))
- (call-next-method stream)
- (format stream
- "The autocorrelation is ~g~%"
- (autocorrelation (send self :data))))
-
- (defun autocorrelation (x)
- (let* ((n (length x)))
- (/ (sum (* (select x (iseq 0 (- n 2)))
- (select x (iseq 1 (- n 1)))))
- (sum (* x x)))))
-
- (send time-series-proto :title "a time series")
- (send time-series-proto :origin 0)
- (send time-series-proto :spacing 1)
-
- (defun make-time-series (x &key (title "a time series") (print t))
- (let ((object (send time-series-proto :new x :title title)))
- (if print (send object :describe))
- object))
-
- (defun make-moving-average ()
- (let* ((e (normal-rand 21))
- (data (+ (select e (iseq 1 20))
- (* .6 (select e (iseq 0 19))))))
- (send time-series-proto :new data)))
-
- ;;;; A Rectangular Data Set Prototype
- (defproto rect-data-proto '(vlabels clabels) () data-set-proto)
-
- (defmeth rect-data-proto :isnew (data &key title variable-labels case-labels)
- (let ((n (length (first data)))
- (m (length data)))
- (send self :data data)
- (if title (send self :title title))
- (send self :variable-labels
- (if variable-labels
- variable-labels
- (mapcar #'(lambda (x) (format nil "X~a" x))
- (iseq 0 (- m 1)))))
- (send self :case-labels
- (if case-labels
- case-labels
- (mapcar #'(lambda (x) (format nil "~a" x))
- (iseq 0 (- n 1)))))))
-
- (defmeth rect-data-proto :variable-labels (&optional (labels nil set))
- (if set (setf (slot-value 'vlabels) labels))
- (slot-value 'vlabels))
-
- (defmeth rect-data-proto :case-labels (&optional (labels nil set))
- (if set (setf (slot-value 'clabels) labels))
- (slot-value 'clabels))
-
- (defmeth rect-data-proto :plot ()
- (let ((vars (send self :data))
- (labels (send self :variable-labels)))
- (case (length vars)
- (1 (histogram vars :variable-labels labels))
- (2 (plot-points vars :variable-labels labels))
- (3 (spin-plot vars :variable-labels labels))
- (t (scatterplot-matrix vars :variable-labels labels)))))
-
- (send rect-data-proto :title "a rectangular data set")
-
- ;;;; A Data Set Instance
- (setf x (send data-set-proto :new (chisq-rand 20 5)))
-
- ;;;; A Time Series Instance
- (setf y (send time-series-proto :new
- (let ((e (normal-rand 21)))
- (+ (select e (iseq 1 20))
- (* .6 (select e (iseq 0 19)))))))
-
- ;;;; A Rectangular Data Set Instance
- (setf z (send rect-data-proto :new (uniform-rand '(20 20 20 20))))
-