/[emacs]/emacs/lisp/calc/calc-stat.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-stat.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:07:10 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-stat.el]  ;; Calculator for GNU Emacs, part II [calc-stat.el]
2  ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3  ;; Written by Dave Gillespie, daveg@synaptics.com.  ;; Written by Dave Gillespie, daveg@synaptics.com.
4    
5  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 34  Line 34 
34  (defun calc-vector-count (arg)  (defun calc-vector-count (arg)
35    (interactive "P")    (interactive "P")
36    (calc-slow-wrapper    (calc-slow-wrapper
37     (calc-vector-op "coun" 'calcFunc-vcount arg))     (calc-vector-op "coun" 'calcFunc-vcount arg)))
 )  
38    
39  (defun calc-vector-sum (arg)  (defun calc-vector-sum (arg)
40    (interactive "P")    (interactive "P")
41    (calc-slow-wrapper    (calc-slow-wrapper
42     (if (calc-is-hyperbolic)     (if (calc-is-hyperbolic)
43         (calc-vector-op "vprd" 'calcFunc-vprod arg)         (calc-vector-op "vprd" 'calcFunc-vprod arg)
44       (calc-vector-op "vsum" 'calcFunc-vsum arg)))       (calc-vector-op "vsum" 'calcFunc-vsum arg))))
 )  
45    
46  (defun calc-vector-product (arg)  (defun calc-vector-product (arg)
47    (interactive "P")    (interactive "P")
48    (calc-hyperbolic-func)    (calc-hyperbolic-func)
49    (calc-vector-sum arg)    (calc-vector-sum arg))
 )  
50    
51  (defun calc-vector-max (arg)  (defun calc-vector-max (arg)
52    (interactive "P")    (interactive "P")
53    (calc-slow-wrapper    (calc-slow-wrapper
54     (if (calc-is-inverse)     (if (calc-is-inverse)
55         (calc-vector-op "vmin" 'calcFunc-vmin arg)         (calc-vector-op "vmin" 'calcFunc-vmin arg)
56       (calc-vector-op "vmax" 'calcFunc-vmax arg)))       (calc-vector-op "vmax" 'calcFunc-vmax arg))))
 )  
57    
58  (defun calc-vector-min (arg)  (defun calc-vector-min (arg)
59    (interactive "P")    (interactive "P")
60    (calc-invert-func)    (calc-invert-func)
61    (calc-vector-max arg)    (calc-vector-max arg))
 )  
62    
63  (defun calc-vector-mean (arg)  (defun calc-vector-mean (arg)
64    (interactive "P")    (interactive "P")
# Line 74  Line 69 
69           (calc-vector-op "medn" 'calcFunc-vmedian arg))           (calc-vector-op "medn" 'calcFunc-vmedian arg))
70       (if (calc-is-inverse)       (if (calc-is-inverse)
71           (calc-vector-op "meae" 'calcFunc-vmeane arg)           (calc-vector-op "meae" 'calcFunc-vmeane arg)
72         (calc-vector-op "mean" 'calcFunc-vmean arg))))         (calc-vector-op "mean" 'calcFunc-vmean arg)))))
 )  
73    
74  (defun calc-vector-mean-error (arg)  (defun calc-vector-mean-error (arg)
75    (interactive "P")    (interactive "P")
76    (calc-invert-func)    (calc-invert-func)
77    (calc-vector-mean arg)    (calc-vector-mean arg))
 )  
78    
79  (defun calc-vector-median (arg)  (defun calc-vector-median (arg)
80    (interactive "P")    (interactive "P")
81    (calc-hyperbolic-func)    (calc-hyperbolic-func)
82    (calc-vector-mean arg)    (calc-vector-mean arg))
 )  
83    
84  (defun calc-vector-harmonic-mean (arg)  (defun calc-vector-harmonic-mean (arg)
85    (interactive "P")    (interactive "P")
86    (calc-invert-func)    (calc-invert-func)
87    (calc-hyperbolic-func)    (calc-hyperbolic-func)
88    (calc-vector-mean arg)    (calc-vector-mean arg))
 )  
89    
90  (defun calc-vector-geometric-mean (arg)  (defun calc-vector-geometric-mean (arg)
91    (interactive "P")    (interactive "P")
92    (calc-slow-wrapper    (calc-slow-wrapper
93     (if (calc-is-hyperbolic)     (if (calc-is-hyperbolic)
94         (calc-binary-op "geom" 'calcFunc-agmean arg)         (calc-binary-op "geom" 'calcFunc-agmean arg)
95       (calc-vector-op "geom" 'calcFunc-vgmean arg)))       (calc-vector-op "geom" 'calcFunc-vgmean arg))))
 )  
96    
97  (defun calc-vector-sdev (arg)  (defun calc-vector-sdev (arg)
98    (interactive "P")    (interactive "P")
# Line 113  Line 103 
103           (calc-vector-op "var" 'calcFunc-vvar arg))           (calc-vector-op "var" 'calcFunc-vvar arg))
104       (if (calc-is-inverse)       (if (calc-is-inverse)
105           (calc-vector-op "psdv" 'calcFunc-vpsdev arg)           (calc-vector-op "psdv" 'calcFunc-vpsdev arg)
106         (calc-vector-op "sdev" 'calcFunc-vsdev arg))))         (calc-vector-op "sdev" 'calcFunc-vsdev arg)))))
 )  
107    
108  (defun calc-vector-pop-sdev (arg)  (defun calc-vector-pop-sdev (arg)
109    (interactive "P")    (interactive "P")
110    (calc-invert-func)    (calc-invert-func)
111    (calc-vector-sdev arg)    (calc-vector-sdev arg))
 )  
112    
113  (defun calc-vector-variance (arg)  (defun calc-vector-variance (arg)
114    (interactive "P")    (interactive "P")
115    (calc-hyperbolic-func)    (calc-hyperbolic-func)
116    (calc-vector-sdev arg)    (calc-vector-sdev arg))
 )  
117    
118  (defun calc-vector-pop-variance (arg)  (defun calc-vector-pop-variance (arg)
119    (interactive "P")    (interactive "P")
120    (calc-invert-func)    (calc-invert-func)
121    (calc-hyperbolic-func)    (calc-hyperbolic-func)
122    (calc-vector-sdev arg)    (calc-vector-sdev arg))
 )  
123    
124  (defun calc-vector-covariance (arg)  (defun calc-vector-covariance (arg)
125    (interactive "P")    (interactive "P")
# Line 146  Line 132 
132             (calc-enter-result n "pcov" (cons 'calcFunc-vpcov             (calc-enter-result n "pcov" (cons 'calcFunc-vpcov
133                                               (calc-top-list-n n)))                                               (calc-top-list-n n)))
134           (calc-enter-result n "cov" (cons 'calcFunc-vcov           (calc-enter-result n "cov" (cons 'calcFunc-vcov
135                                            (calc-top-list-n n)))))))                                            (calc-top-list-n n))))))))
 )  
136    
137  (defun calc-vector-pop-covariance (arg)  (defun calc-vector-pop-covariance (arg)
138    (interactive "P")    (interactive "P")
139    (calc-invert-func)    (calc-invert-func)
140    (calc-vector-covariance arg)    (calc-vector-covariance arg))
 )  
141    
142  (defun calc-vector-correlation (arg)  (defun calc-vector-correlation (arg)
143    (interactive "P")    (interactive "P")
144    (calc-hyperbolic-func)    (calc-hyperbolic-func)
145    (calc-vector-covariance arg)    (calc-vector-covariance arg))
 )  
146    
147  (defun calc-vector-op (name func arg)  (defun calc-vector-op (name func arg)
148    (setq calc-aborted-prefix name    (setq calc-aborted-prefix name
149          arg (prefix-numeric-value arg))          arg (prefix-numeric-value arg))
150    (if (< arg 0)    (if (< arg 0)
151        (error "Negative arguments not allowed"))        (error "Negative arguments not allowed"))
152    (calc-enter-result arg name (cons func (calc-top-list-n arg)))    (calc-enter-result arg name (cons func (calc-top-list-n arg))))
 )  
153    
154    
155    
# Line 180  Line 162 
162  ;;; non-vectors.  ;;; non-vectors.
163    
164  (defun calcFunc-vsum (&rest vecs)  (defun calcFunc-vsum (&rest vecs)
165    (math-reduce-many-vecs 'calcFunc-add 'calcFunc-vsum vecs 0)    (math-reduce-many-vecs 'calcFunc-add 'calcFunc-vsum vecs 0))
 )  
166    
167  (defun calcFunc-vprod (&rest vecs)  (defun calcFunc-vprod (&rest vecs)
168    (math-reduce-many-vecs 'calcFunc-mul 'calcFunc-vprod vecs 1)    (math-reduce-many-vecs 'calcFunc-mul 'calcFunc-vprod vecs 1))
 )  
169    
170  (defun calcFunc-vmax (&rest vecs)  (defun calcFunc-vmax (&rest vecs)
171    (if (eq (car-safe (car vecs)) 'sdev)    (if (eq (car-safe (car vecs)) 'sdev)
# Line 193  Line 173 
173      (if (eq (car-safe (car vecs)) 'intv)      (if (eq (car-safe (car vecs)) 'intv)
174          (nth 3 (math-fix-int-intv (car vecs)))          (nth 3 (math-fix-int-intv (car vecs)))
175        (math-reduce-many-vecs 'calcFunc-max 'calcFunc-vmax vecs        (math-reduce-many-vecs 'calcFunc-max 'calcFunc-vmax vecs
176                               '(neg (var inf var-inf)))))                               '(neg (var inf var-inf))))))
 )  
177    
178  (defun calcFunc-vmin (&rest vecs)  (defun calcFunc-vmin (&rest vecs)
179    (if (eq (car-safe (car vecs)) 'sdev)    (if (eq (car-safe (car vecs)) 'sdev)
# Line 202  Line 181 
181      (if (eq (car-safe (car vecs)) 'intv)      (if (eq (car-safe (car vecs)) 'intv)
182          (nth 2 (math-fix-int-intv (car vecs)))          (nth 2 (math-fix-int-intv (car vecs)))
183        (math-reduce-many-vecs 'calcFunc-min 'calcFunc-vmin vecs        (math-reduce-many-vecs 'calcFunc-min 'calcFunc-vmin vecs
184                               '(var inf var-inf))))                               '(var inf var-inf)))))
 )  
185    
186  (defun math-reduce-many-vecs (func whole-func vecs ident)  (defun math-reduce-many-vecs (func whole-func vecs ident)
187    (let ((const-part nil)    (let ((const-part nil)
# Line 236  Line 214 
214            (if symb-part            (if symb-part
215                (funcall func const-part (cons whole-func symb-part))                (funcall func const-part (cons whole-func symb-part))
216              const-part))              const-part))
217        (if symb-part (cons whole-func symb-part) ident)))        (if symb-part (cons whole-func symb-part) ident))))
 )  
218    
219    
220  ;;; Return the number of data elements among the arguments.  ;;; Return the number of data elements among the arguments.
# Line 256  Line 233 
233                                      (symbol-value (nth 2 (car vecs)))))                                      (symbol-value (nth 2 (car vecs)))))
234                          (math-reject-arg (car vecs) 'numvecp))))                          (math-reject-arg (car vecs) 'numvecp))))
235              vecs (cdr vecs)))              vecs (cdr vecs)))
236      count)      count))
 )  
237    
238  (defun math-count-elements (vec)  (defun math-count-elements (vec)
239    (let ((count 0))    (let ((count 0))
# Line 265  Line 241 
241        (setq count (if (Math-vectorp (car vec))        (setq count (if (Math-vectorp (car vec))
242                        (+ count (math-count-elements (car vec)))                        (+ count (math-count-elements (car vec)))
243                      (1+ count))))                      (1+ count))))
244      count)      count))
 )  
245    
246    
247  (defun math-flatten-many-vecs (vecs)  (defun math-flatten-many-vecs (vecs)
# Line 285  Line 260 
260                                                       (nth 2 (car p))))                                                       (nth 2 (car p))))
261                               (math-reject-arg (car p) 'numvecp)))))                               (math-reject-arg (car p) 'numvecp)))))
262              p (cdr p)))              p (cdr p)))
263      vec)      vec))
 )  
264    
265  (defun calcFunc-vflat (&rest vecs)  (defun calcFunc-vflat (&rest vecs)
266    (math-flatten-many-vecs vecs)    (math-flatten-many-vecs vecs))
 )  
267    
268  (defun math-split-sdev-vec (vec zero-ok)  (defun math-split-sdev-vec (vec zero-ok)
269    (let ((means (list 'vec))    (let ((means (list 'vec))
# Line 317  Line 290 
290                        exact t))                        exact t))
291              (setq means (cons p means)))))              (setq means (cons p means)))))
292        (list (nreverse means)        (list (nreverse means)
293              (and wts (nreverse wts)))))              (and wts (nreverse wts))))))
 )  
294    
295    
296  ;;; Return the arithmetic mean of the argument numbers or vectors.  ;;; Return the arithmetic mean of the argument numbers or vectors.
# Line 344  Line 316 
316                                             (calcFunc-map '(var div var-div)                                             (calcFunc-map '(var div var-div)
317                                                           means sqrwts))                                                           means sqrwts))
318                            suminvsqrwts))                            suminvsqrwts))
319              (math-div (calcFunc-reduce '(var add var-add) means) len))))))              (math-div (calcFunc-reduce '(var add var-add) means) len)))))))
 )  
320    
321  (defun math-fix-int-intv (x)  (defun math-fix-int-intv (x)
322    (if (math-floatp x)    (if (math-floatp x)
323        x        x
324      (list 'intv 3      (list 'intv 3
325            (if (memq (nth 1 x) '(2 3)) (nth 2 x) (math-add (nth 2 x) 1))            (if (memq (nth 1 x) '(2 3)) (nth 2 x) (math-add (nth 2 x) 1))
326            (if (memq (nth 1 x) '(1 3)) (nth 3 x) (math-sub (nth 3 x) 1))))            (if (memq (nth 1 x) '(1 3)) (nth 3 x) (math-sub (nth 3 x) 1)))))
 )  
327    
328  ;;; Compute the mean with an error estimate.  ;;; Compute the mean with an error estimate.
329  (defun calcFunc-vmeane (&rest vecs)  (defun calcFunc-vmeane (&rest vecs)
# Line 390  Line 360 
360                                                             means                                                             means
361                                                             (math-neg mean)))                                                             (math-neg mean)))
362                                              2))                                              2))
363                               (math-mul len (1- len))))))))))                               (math-mul len (1- len)))))))))))
 )  
364    
365    
366  ;;; Compute the median of a list of values.  ;;; Compute the median of a list of values.
# Line 413  Line 382 
382          (setq flat (sort flat 'math-lessp))          (setq flat (sort flat 'math-lessp))
383          (if (= (% len 2) 0)          (if (= (% len 2) 0)
384              (math-div (math-add (nth (1- hlen) flat) (nth hlen flat)) 2)              (math-div (math-add (nth (1- hlen) flat) (nth hlen flat)) 2)
385            (nth hlen flat)))))            (nth hlen flat))))))
 )  
386    
387    
388  (defun calcFunc-vgmean (&rest vecs)  (defun calcFunc-vgmean (&rest vecs)
# Line 426  Line 394 
394          (let ((x (calcFunc-reduce '(var mul math-mul) flat)))          (let ((x (calcFunc-reduce '(var mul math-mul) flat)))
395            (if (= len 2)            (if (= len 2)
396                (math-sqrt x)                (math-sqrt x)
397              (math-pow x (list 'frac 1 len)))))))              (math-pow x (list 'frac 1 len))))))))
 )  
398    
399    
400  (defun calcFunc-agmean (a b)  (defun calcFunc-agmean (a b)
# Line 446  Line 413 
413                 (setq mean (math-mul-float (math-add-float a b) '(float 5 -1))                 (setq mean (math-mul-float (math-add-float a b) '(float 5 -1))
414                       b (math-sqrt-float (math-mul-float a b))                       b (math-sqrt-float (math-mul-float a b))
415                       a mean))                       a mean))
416               a))))               a)))))
 )  
417    
418    
419  (defun calcFunc-vhmean (&rest vecs)  (defun calcFunc-vhmean (&rest vecs)
# Line 458  Line 424 
424        (math-with-extra-prec 2        (math-with-extra-prec 2
425          (math-div len          (math-div len
426                    (calcFunc-reduce '(var add math-add)                    (calcFunc-reduce '(var add math-add)
427                                     (calcFunc-map '(var inv var-inv) flat))))))                                     (calcFunc-map '(var inv var-inv) flat)))))))
 )  
428    
429    
430    
# Line 471  Line 436 
436        (if (eq (car-safe (car vecs)) 'intv)        (if (eq (car-safe (car vecs)) 'intv)
437            (math-intv-variance (car vecs) nil)            (math-intv-variance (car vecs) nil)
438          (math-sqr (nth 2 (car vecs))))          (math-sqr (nth 2 (car vecs))))
439      (math-covariance vecs nil nil 0))      (math-covariance vecs nil nil 0)))
 )  
440    
441  (defun calcFunc-vsdev (&rest vecs)  (defun calcFunc-vsdev (&rest vecs)
442    (if (and (= (length vecs) 1)    (if (and (= (length vecs) 1)
# Line 483  Line 447 
447                          (math-sqrt-12))                          (math-sqrt-12))
448              (math-sqrt (calcFunc-vvar (car vecs))))              (math-sqrt (calcFunc-vvar (car vecs))))
449          (nth 2 (car vecs)))          (nth 2 (car vecs)))
450      (math-sqrt (math-covariance vecs nil nil 0)))      (math-sqrt (math-covariance vecs nil nil 0))))
 )  
451    
452  ;;; Compute the population variance or std deviation of numbers or vectors.  ;;; Compute the population variance or std deviation of numbers or vectors.
453  (defun calcFunc-vpvar (&rest vecs)  (defun calcFunc-vpvar (&rest vecs)
# Line 493  Line 456 
456        (if (eq (car-safe (car vecs)) 'intv)        (if (eq (car-safe (car vecs)) 'intv)
457            (math-intv-variance (car vecs) t)            (math-intv-variance (car vecs) t)
458          (math-sqr (nth 2 (car vecs))))          (math-sqr (nth 2 (car vecs))))
459      (math-covariance vecs nil t 0))      (math-covariance vecs nil t 0)))
 )  
460    
461  (defun calcFunc-vpsdev (&rest vecs)  (defun calcFunc-vpsdev (&rest vecs)
462    (if (and (= (length vecs) 1)    (if (and (= (length vecs) 1)
# Line 505  Line 467 
467                          (math-sqrt-12))                          (math-sqrt-12))
468              (math-sqrt (calcFunc-vpvar (car vecs))))              (math-sqrt (calcFunc-vpvar (car vecs))))
469          (nth 2 (car vecs)))          (nth 2 (car vecs)))
470      (math-sqrt (math-covariance vecs nil t 0)))      (math-sqrt (math-covariance vecs nil t 0))))
 )  
471    
472  (defun math-intv-variance (x pop)  (defun math-intv-variance (x pop)
473    (or (math-constp x) (math-reject-arg x 'constp))    (or (math-constp x) (math-reject-arg x 'constp))
# Line 521  Line 482 
482                    (calcFunc-sum '(^ (- (var X var-X) (/ 1 2)) 2)                    (calcFunc-sum '(^ (- (var X var-X) (/ 1 2)) 2)
483                                  '(var X var-X)                                  '(var X var-X)
484                                  (math-neg hlen) (math-add hlen 1)))                                  (math-neg hlen) (math-add hlen 1)))
485                  (if pop (math-add len 1) len))))                  (if pop (math-add len 1) len)))))
 )  
486    
487  ;;; Compute the covariance and linear correlation coefficient.  ;;; Compute the covariance and linear correlation coefficient.
488  (defun calcFunc-vcov (vec1 &optional vec2)  (defun calcFunc-vcov (vec1 &optional vec2)
489    (math-covariance (list vec1) (list vec2) nil 1)    (math-covariance (list vec1) (list vec2) nil 1))
 )  
490    
491  (defun calcFunc-vpcov (vec1 &optional vec2)  (defun calcFunc-vpcov (vec1 &optional vec2)
492    (math-covariance (list vec1) (list vec2) t 1)    (math-covariance (list vec1) (list vec2) t 1))
 )  
493    
494  (defun calcFunc-vcorr (vec1 &optional vec2)  (defun calcFunc-vcorr (vec1 &optional vec2)
495    (math-covariance (list vec1) (list vec2) nil 2)    (math-covariance (list vec1) (list vec2) nil 2))
 )  
496    
497    
498  (defun math-covariance (vec1 vec2 pop mode)  (defun math-covariance (vec1 vec2 pop mode)
# Line 621  Line 578 
578                 (if pop                 (if pop
579                     suminvsqrwts                     suminvsqrwts
580                   (math-div (math-mul suminvsqrwts (1- len)) len))                   (math-div (math-mul suminvsqrwts (1- len)) len))
581               (if pop len (1- len))))))))               (if pop len (1- len)))))))))
 )  
   
   
   
582    
583    ;;; calc-stat.el ends here

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26