home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d3xx / d385 / xlispstat.lha / XLispStat / lisp.lzh / XLisp-Stat / Functions / dataprotos.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1990-10-11  |  4.7 KB  |  145 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. (defmeth data-set-proto :save ()
  33.   `(send data-set-proto :new
  34.          ',(send self :data)
  35.          :title ',(send self :title)))
  36.  
  37. (send data-set-proto :title "a data set")
  38.  
  39. (defun make-data-set (x &key (title "a data set") (print t))
  40.   (let ((object (send data-set-proto :new x :title title)))
  41.     (if print (send object :describe))
  42.     object))
  43.  
  44. ;;;; A Time Series Prototype
  45.  
  46. (defproto time-series-proto 
  47.           '(origin spacing) () data-set-proto)
  48.  
  49. (defmeth time-series-proto :origin (&optional (origin nil set))
  50.   (if set (setf (slot-value 'origin) origin))
  51.   (slot-value 'origin))
  52.  
  53. (defmeth time-series-proto :spacing (&optional (sp nil set))
  54.   (if set (setf (slot-value 'spacing) sp))
  55.   (slot-value 'spacing))
  56.  
  57. (defmeth time-series-proto :plot ()
  58.   (let* ((data (send self :data))
  59.          (time (+ (send self :origin)
  60.                   (* (iseq (length data))
  61.                      (send self :spacing)))))
  62.    (plot-points time data)))
  63. #|
  64. (defmeth time-series-proto :plot ()
  65.   (let ((data (send self :data)))
  66. ;    (plot-points (iseq 0 (- (length data) 1)) data)))
  67.     (plot-points (iseq  (length data)) data)))
  68. |#
  69. (defmeth time-series-proto :describe (&optional (stream t))
  70.   (call-next-method stream)
  71.   (format stream 
  72.           "The autocorrelation is ~g~%" 
  73.           (autocorrelation (send self :data))))
  74.  
  75. (defun autocorrelation (x)
  76.   (let* ((n (length x)))
  77.     (/ (sum (* (select x (iseq 0 (- n 2))) 
  78.                (select x (iseq 1 (- n 1)))))
  79.        (sum (* x x)))))
  80.  
  81. (send time-series-proto :title "a time series")
  82. (send time-series-proto :origin 0)
  83. (send time-series-proto :spacing 1)
  84.  
  85. (defun make-time-series (x &key (title "a time series") (print t))
  86.   (let ((object (send time-series-proto :new x :title title)))
  87.     (if print (send object :describe))
  88.     object))
  89.  
  90. (defun make-moving-average ()
  91.   (let* ((e (normal-rand 21))
  92.          (data (+ (select e (iseq 1 20))
  93.                   (* .6 (select e (iseq 0 19))))))
  94.   (send time-series-proto :new data)))
  95.  
  96. ;;;; A Rectangular Data Set Prototype
  97. (defproto rect-data-proto '(vlabels clabels) () data-set-proto)
  98.  
  99. (defmeth rect-data-proto :isnew (data &key title variable-labels case-labels)
  100.   (let ((n (length (first data)))
  101.         (m (length data)))
  102.     (send self :data data)
  103.     (if title (send self :title title))
  104.     (send self :variable-labels
  105.           (if variable-labels
  106.               variable-labels
  107.               (mapcar #'(lambda (x) (format nil "X~a" x)) 
  108.                       (iseq 0 (- m 1)))))
  109.     (send self :case-labels
  110.           (if case-labels
  111.               case-labels
  112.               (mapcar #'(lambda (x) (format nil "~a" x)) 
  113.                       (iseq 0 (- n 1)))))))
  114.  
  115. (defmeth rect-data-proto :variable-labels (&optional (labels nil set))
  116.   (if set (setf (slot-value 'vlabels) labels))
  117.   (slot-value 'vlabels))
  118.  
  119. (defmeth rect-data-proto :case-labels (&optional (labels nil set))
  120.   (if set (setf (slot-value 'clabels) labels))
  121.   (slot-value 'clabels))
  122.  
  123. (defmeth rect-data-proto :plot ()
  124.   (let ((vars (send self :data))
  125.         (labels (send self :variable-labels)))
  126.     (case (length vars)
  127.       (1 (histogram vars :variable-labels labels))
  128.       (2 (plot-points vars :variable-labels labels))
  129.       (3 (spin-plot vars :variable-labels labels))
  130.       (t (scatterplot-matrix vars :variable-labels labels)))))
  131.  
  132. (send rect-data-proto :title "a rectangular data set")
  133.  
  134. ;;;; A Data Set Instance
  135. (setf x (send data-set-proto :new (chisq-rand 20 5)))
  136.  
  137. ;;;; A Time Series Instance
  138. (setf y (send time-series-proto :new
  139.                 (let ((e (normal-rand 21)))
  140.                   (+ (select e (iseq 1 20)) 
  141.                      (* .6 (select e (iseq 0 19)))))))
  142.  
  143. ;;;; A Rectangular Data Set Instance
  144. (setf z (send rect-data-proto :new (uniform-rand '(20 20 20 20))))
  145.