home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / science / xlspstr1.sit / Examples / dataprotos.lsp < prev    next >
Lisp/Scheme  |  1989-07-28  |  3KB  |  95 lines
  1. ;;;; A Data Set Prototype
  2. (defproto data-set-proto '(data title))
  3.  
  4. (defmeth data-set-proto :isnew (data &key title)
  5.   (send self :data data)
  6.   (if title (send self :title title)))
  7.  
  8. (defmeth data-set-proto :title (&optional (title nil set))
  9. "Method args: (&optional title)
  10. Sets or retrieves the object's title."
  11.   (if set (setf (slot-value 'title) title))
  12.   (slot-value 'title))
  13.  
  14. (defmeth data-set-proto :data (&optional (data nil set))
  15. "Method args: (&optional data)
  16. Sets or retrieves the object's data."
  17.   (if set (setf (slot-value 'data) data))
  18.   (slot-value 'data))
  19.  
  20. (defmeth data-set-proto :describe (&optional (stream t))
  21. "Method args: (&optional (stream t))
  22. Prints a simple description of the object to STREAM."
  23.   (let ((title (send self :title))
  24.            (data (send self :data)))
  25.     (format stream "This is ~a~%" title)
  26.     (format stream "The sample mean is ~g~%" (mean data))
  27.     (format stream "The sample standard deviation is ~g~%"
  28.             (standard-deviation data))))
  29.  
  30. (defmeth data-set-proto :plot () (histogram (send self :data)))
  31.  
  32. (send data-set-proto :title "a data set")
  33.  
  34. (defun make-data-set (x &key (title "a data set") (print t))
  35.   (let ((object (send data-set-proto :new x :title title)))
  36.     (if print (send object :describe))
  37.     object))
  38.  
  39. ;;;; A Time Series Prototype
  40. (defproto time-series-proto () () data-set-proto)
  41.  
  42. (defmeth time-series-proto :plot ()
  43.   (let ((data (send self :data)))
  44.     (plot-points (iseq 0 (- (length data) 1)) data)))
  45.  
  46. (defmeth time-series-proto :describe (&optional (stream t))
  47.   (call-next-method stream)
  48.   (format stream 
  49.           "The autocorrelation is ~g~%" 
  50.           (autocorrelation (send self :data))))
  51.  
  52. (defun autocorrelation (x)
  53.   (let* ((n (length x)))
  54.     (/ (sum (* (select x (iseq 0 (- n 2))) 
  55.                (select x (iseq 1 (- n 1)))))
  56.        (sum (* x x)))))
  57.  
  58. (send time-series-proto :title "a time series")
  59.  
  60. (defun make-time-series (x &key (title "a data set") (print t))
  61.   (let ((object (send time-series-proto :new x :title title)))
  62.     (if print (send object :describe))
  63.     object))
  64.  
  65. ;;;; A Rectangular Data Set Prototype
  66. (defproto rect-data-proto '(labels) () data-set-proto)
  67.  
  68. (defmeth rect-data-proto :isnew (data &key title labels)
  69.   (let ((n (length data)))
  70.     (send self :data data)
  71.     (if title (send self :title title))
  72.     (send self :labels
  73.           (if labels
  74.               labels
  75.               (mapcar #'(lambda (x) (format nil "X~a" x)) 
  76.                       (iseq 0 (- n 1)))))))
  77.  
  78. (defmeth rect-data-proto :labels (&optional (labels nil set))
  79.   (if set (setf (slot-value 'labels) labels))
  80.   (slot-value 'labels))
  81.  
  82. (send rect-data-proto :title "a rectangular data set")
  83.  
  84. ;;;; A Data Set Instance
  85. (setf x (send data-set-proto :new (chisq-rand 20 5)))
  86.  
  87. ;;;; A Time Series Instance
  88. (setf y (send time-series-proto :new
  89.                 (let ((e (normal-rand 21)))
  90.                   (+ (select e (iseq 1 20)) 
  91.                      (* .6 (select e (iseq 0 19)))))))
  92.  
  93. ;;;; A Rectangular Data Set Instance
  94. (setf z (send rect-data-proto :new (uniform-rand '(20 20 20 20))))
  95.