[bpt/emacs.git] / lisp / calc / calc-stat.el

;;; calc-stat.el --- statistical functions for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.

;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>

;; This file is part of GNU Emacs.

;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

;; This file is autoloaded from calc-ext.el.

(require 'calc-ext)
(require 'calc-macs)

;;; Statistical operations on vectors.

(defun calc-vector-count (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-vector-op "coun" 'calcFunc-vcount arg)))

(defun calc-vector-sum (arg)
  (interactive "P")
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (calc-vector-op "vprd" 'calcFunc-vprod arg)
     (calc-vector-op "vsum" 'calcFunc-vsum arg))))

(defun calc-vector-product (arg)
  (interactive "P")
  (calc-hyperbolic-func)
  (calc-vector-sum arg))

(defun calc-vector-max (arg)
  (interactive "P")
  (calc-slow-wrapper
   (if (calc-is-inverse)
       (calc-vector-op "vmin" 'calcFunc-vmin arg)
     (calc-vector-op "vmax" 'calcFunc-vmax arg))))

(defun calc-vector-min (arg)
  (interactive "P")
  (calc-invert-func)
  (calc-vector-max arg))

(defun calc-vector-mean (arg)
  (interactive "P")
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (if (calc-is-inverse)
	   (calc-vector-op "harm" 'calcFunc-vhmean arg)
	 (calc-vector-op "medn" 'calcFunc-vmedian arg))
     (if (calc-is-inverse)
	 (calc-vector-op "meae" 'calcFunc-vmeane arg)
       (calc-vector-op "mean" 'calcFunc-vmean arg)))))

(defun calc-vector-mean-error (arg)
  (interactive "P")
  (calc-invert-func)
  (calc-vector-mean arg))

(defun calc-vector-median (arg)
  (interactive "P")
  (calc-hyperbolic-func)
  (calc-vector-mean arg))

(defun calc-vector-harmonic-mean (arg)
  (interactive "P")
  (calc-invert-func)
  (calc-hyperbolic-func)
  (calc-vector-mean arg))

(defun calc-vector-geometric-mean (arg)
  (interactive "P")
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (calc-binary-op "geom" 'calcFunc-agmean arg)
     (calc-vector-op "geom" 'calcFunc-vgmean arg))))

(defun calc-vector-sdev (arg)
  (interactive "P")
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (if (calc-is-inverse)
	   (calc-vector-op "pvar" 'calcFunc-vpvar arg)
	 (calc-vector-op "var" 'calcFunc-vvar arg))
     (if (calc-is-inverse)
	 (calc-vector-op "psdv" 'calcFunc-vpsdev arg)
       (calc-vector-op "sdev" 'calcFunc-vsdev arg)))))

(defun calc-vector-pop-sdev (arg)
  (interactive "P")
  (calc-invert-func)
  (calc-vector-sdev arg))

(defun calc-vector-variance (arg)
  (interactive "P")
  (calc-hyperbolic-func)
  (calc-vector-sdev arg))

(defun calc-vector-pop-variance (arg)
  (interactive "P")
  (calc-invert-func)
  (calc-hyperbolic-func)
  (calc-vector-sdev arg))

(defun calc-vector-covariance (arg)
  (interactive "P")
  (calc-slow-wrapper
   (let ((n (if (eq arg 1) 1 2)))
     (if (calc-is-hyperbolic)
	 (calc-enter-result n "corr" (cons 'calcFunc-vcorr
					   (calc-top-list-n n)))
       (if (calc-is-inverse)
	   (calc-enter-result n "pcov" (cons 'calcFunc-vpcov
					     (calc-top-list-n n)))
	 (calc-enter-result n "cov" (cons 'calcFunc-vcov
					  (calc-top-list-n n))))))))

(defun calc-vector-pop-covariance (arg)
  (interactive "P")
  (calc-invert-func)
  (calc-vector-covariance arg))

(defun calc-vector-correlation (arg)
  (interactive "P")
  (calc-hyperbolic-func)
  (calc-vector-covariance arg))

(defun calc-vector-op (name func arg)
  (setq calc-aborted-prefix name
	arg (prefix-numeric-value arg))
  (if (< arg 0)
      (error "Negative arguments not allowed"))
  (calc-enter-result arg name (cons func (calc-top-list-n arg))))


;;; Useful statistical functions

;;; Sum, product, etc., of one or more values or vectors.
;;; Each argument must be either a number or a vector.  Vectors
;;; are flattened, but variables inside are assumed to represent
;;; non-vectors.

(defun calcFunc-vsum (&rest vecs)
  (math-reduce-many-vecs 'calcFunc-add 'calcFunc-vsum vecs 0))

(defun calcFunc-vprod (&rest vecs)
  (math-reduce-many-vecs 'calcFunc-mul 'calcFunc-vprod vecs 1))

(defun calcFunc-vmax (&rest vecs)
  (if (eq (car-safe (car vecs)) 'sdev)
      '(var inf var-inf)
    (if (eq (car-safe (car vecs)) 'intv)
	(nth 3 (math-fix-int-intv (car vecs)))
      (math-reduce-many-vecs 'calcFunc-max 'calcFunc-vmax vecs
			     '(neg (var inf var-inf))))))

(defun calcFunc-vmin (&rest vecs)
  (if (eq (car-safe (car vecs)) 'sdev)
      '(neg (var inf var-inf))
    (if (eq (car-safe (car vecs)) 'intv)
	(nth 2 (math-fix-int-intv (car vecs)))
      (math-reduce-many-vecs 'calcFunc-min 'calcFunc-vmin vecs
			     '(var inf var-inf)))))

(defun math-reduce-many-vecs (func whole-func vecs ident)
  (let ((const-part nil)
	(symb-part nil)
	val vec)
    (let ((calc-internal-prec (+ calc-internal-prec 2)))
      (while vecs
	(setq val (car vecs))
	(and (eq (car-safe val) 'var)
	     (eq (car-safe (calc-var-value (nth 2 val))) 'vec)
	     (setq val (symbol-value (nth 2 val))))
	(cond ((Math-vectorp val)
	       (setq vec (append (and const-part (list const-part))
				 (math-flatten-vector val)))
	       (setq const-part (if vec
				    (calcFunc-reducer
				     (math-calcFunc-to-var func)
				     (cons 'vec vec))
				  ident)))
	      ((or (Math-objectp val) (math-infinitep val))
	       (setq const-part (if const-part
				    (funcall func const-part val)
				  val)))
	      (t
	       (setq symb-part (nconc symb-part (list val)))))
	(setq vecs (cdr vecs))))
    (if const-part
	(progn
	  (setq const-part (math-normalize const-part))
	  (if symb-part
	      (funcall func const-part (cons whole-func symb-part))
	    const-part))
      (if symb-part (cons whole-func symb-part) ident))))


;;; Return the number of data elements among the arguments.
(defun calcFunc-vcount (&rest vecs)
  (let ((count 0))
    (while vecs
      (setq count (if (Math-vectorp (car vecs))
		      (+ count (math-count-elements (car vecs)))
		    (if (Math-objectp (car vecs))
			(1+ count)
		      (if (and (eq (car-safe (car vecs)) 'var)
			       (eq (car-safe (calc-var-value
					      (nth 2 (car vecs))))
				   'vec))
			  (+ count (math-count-elements
				    (symbol-value (nth 2 (car vecs)))))
			(math-reject-arg (car vecs) 'numvecp))))
	    vecs (cdr vecs)))
    count))

(defun math-count-elements (vec)
  (let ((count 0))
    (while (setq vec (cdr vec))
      (setq count (if (Math-vectorp (car vec))
		      (+ count (math-count-elements (car vec)))
		    (1+ count))))
    count))


(defun math-flatten-many-vecs (vecs)
  (let ((p vecs)
	(vec (list 'vec)))
    (while p
      (setq vec (nconc vec
		       (if (Math-vectorp (car p))
			   (math-flatten-vector (car p))
			 (if (Math-objectp (car p))
			     (list (car p))
			   (if (and (eq (car-safe (car p)) 'var)
				    (eq (car-safe (calc-var-value
						   (nth 2 (car p)))) 'vec))
			       (math-flatten-vector (symbol-value
						     (nth 2 (car p))))
			     (math-reject-arg (car p) 'numvecp)))))
	    p (cdr p)))
    vec))

(defun calcFunc-vflat (&rest vecs)
  (math-flatten-many-vecs vecs))

(defun math-split-sdev-vec (vec zero-ok)
  (let ((means (list 'vec))
	(wts (list 'vec))
	(exact nil)
	(p vec))
    (while (and (setq p (cdr p))
		(not (and (consp (car p))
			  (eq (car (car p)) 'sdev)))))
    (if (null p)
	(list vec nil)
      (while (setq vec (cdr vec))
	(if (and (consp (setq p (car vec)))
		 (eq (car p) 'sdev))
	    (or exact
		(setq means (cons (nth 1 p) means)
		      wts (cons (nth 2 p) wts)))
	  (if zero-ok
	      (setq means (cons (nth 1 p) means)
		    wts (cons 0 wts))
	    (or exact
		(setq means (list 'vec)
		      wts nil
		      exact t))
	    (setq means (cons p means)))))
      (list (nreverse means)
	    (and wts (nreverse wts))))))


;;; Return the arithmetic mean of the argument numbers or vectors.
;;; (If numbers are error forms, computes the weighted mean.)
(defun calcFunc-vmean (&rest vecs)
  (let* ((split (math-split-sdev-vec (math-flatten-many-vecs vecs) nil))
	 (means (car split))
	 (wts (nth 1 split))
	 (len (1- (length means))))
    (if (= len 0)
	(math-reject-arg nil "*Must be at least 1 argument")
      (if (and (= len 1) (eq (car-safe (nth 1 means)) 'intv))
	  (let ((x (math-fix-int-intv (nth 1 means))))
	    (calcFunc-vmean (nth 2 x) (nth 3 x)))
	(math-with-extra-prec 2
	  (if (and wts (> len 1))
	      (let* ((sqrwts (calcFunc-map '(var mul var-mul) wts wts))
		     (suminvsqrwts (calcFunc-reduce
				    '(var add var-add)
				    (calcFunc-map '(var div var-div)
						  1 sqrwts))))
		(math-div (calcFunc-reduce '(var add var-add)
					   (calcFunc-map '(var div var-div)
							 means sqrwts))
			  suminvsqrwts))
	    (math-div (calcFunc-reduce '(var add var-add) means) len)))))))

(defun math-fix-int-intv (x)
  (if (math-floatp x)
      x
    (list 'intv 3
	  (if (memq (nth 1 x) '(2 3)) (nth 2 x) (math-add (nth 2 x) 1))
	  (if (memq (nth 1 x) '(1 3)) (nth 3 x) (math-sub (nth 3 x) 1)))))

;;; Compute the mean with an error estimate.
(defun calcFunc-vmeane (&rest vecs)
  (let* ((split (math-split-sdev-vec (math-flatten-many-vecs vecs) nil))
	 (means (car split))
	 (wts (nth 1 split))
	 (len (1- (length means))))
    (if (= len 0)
	(math-reject-arg nil "*Must be at least 1 argument")
      (math-with-extra-prec 2
	(if wts
	    (let* ((sqrwts (calcFunc-map '(var mul var-mul) wts wts))
		   (suminvsqrwts (calcFunc-reduce
				  '(var add var-add)
				  (calcFunc-map '(var div var-div)
						1 sqrwts))))
	      (math-make-sdev
	       (math-div (calcFunc-reduce '(var add var-add)
					  (calcFunc-map '(var div var-div)
							means sqrwts))
			 suminvsqrwts)
	       (list 'calcFunc-sqrt (math-div 1 suminvsqrwts))))
	  (let ((mean (math-div (calcFunc-reduce '(var add var-add) means)
				len)))
	    (math-make-sdev
	     mean
	     (list 'calcFunc-sqrt
		   (math-div (calcFunc-reducer
			      '(var add var-add)
			      (calcFunc-map '(var pow var-pow)
					    (calcFunc-map '(var abs var-abs)
							  (calcFunc-map
							   '(var add var-add)
							   means
							   (math-neg mean)))
					    2))
			     (math-mul len (1- len)))))))))))


;;; Compute the median of a list of values.
(defun calcFunc-vmedian (&rest vecs)
  (let* ((flat (copy-sequence (cdr (math-flatten-many-vecs vecs))))
	 (p flat)
	 (len (length flat))
	 (hlen (/ len 2)))
    (if (= len 0)
	(math-reject-arg nil "*Must be at least 1 argument")
      (if (and (= len 1) (memq (car-safe (car flat)) '(sdev intv)))
	  (calcFunc-vmean (car flat))
	(while p
	  (if (eq (car-safe (car p)) 'sdev)
	      (setcar p (nth 1 (car p))))
	  (or (Math-anglep (car p))
	      (math-reject-arg (car p) 'anglep))
	  (setq p (cdr p)))
	(setq flat (sort flat 'math-lessp))
	(if (= (% len 2) 0)
	    (math-div (math-add (nth (1- hlen) flat) (nth hlen flat)) 2)
	  (nth hlen flat))))))


(defun calcFunc-vgmean (&rest vecs)
  (let* ((flat (math-flatten-many-vecs vecs))
	 (len (1- (length flat))))
    (if (= len 0)
	(math-reject-arg nil "*Must be at least 1 argument")
      (math-with-extra-prec 2
	(let ((x (calcFunc-reduce '(var mul math-mul) flat)))
	  (if (= len 2)
	      (math-sqrt x)
	    (math-pow x (list 'frac 1 len))))))))


(defun calcFunc-agmean (a b)
  (cond ((Math-equal a b) a)
	((math-zerop a) a)
	((math-zerop b) b)
	(calc-symbolic-mode (math-inexact-result))
	((not (Math-realp a)) (math-reject-arg a 'realp))
	((not (Math-realp b)) (math-reject-arg b 'realp))
	(t
	 (math-with-extra-prec 2
	   (setq a (math-float (math-abs a))
		 b (math-float (math-abs b)))
	   (let (mean)
	     (while (not (math-nearly-equal-float a b))
	       (setq mean (math-mul-float (math-add-float a b) '(float 5 -1))
		     b (math-sqrt-float (math-mul-float a b))
		     a mean))
	     a)))))


(defun calcFunc-vhmean (&rest vecs)
  (let* ((flat (math-flatten-many-vecs vecs))
	 (len (1- (length flat))))
    (if (= len 0)
	(math-reject-arg nil "*Must be at least 1 argument")
      (math-with-extra-prec 2
	(math-div len
		  (calcFunc-reduce '(var add math-add)
				   (calcFunc-map '(var inv var-inv) flat)))))))


;;; Compute the sample variance or standard deviation of numbers or vectors.
;;; (If the numbers are error forms, only the mean part of them is used.)
(defun calcFunc-vvar (&rest vecs)
  (if (and (= (length vecs) 1)
	   (memq (car-safe (car vecs)) '(sdev intv)))
      (if (eq (car-safe (car vecs)) 'intv)
	  (math-intv-variance (car vecs) nil)
	(math-sqr (nth 2 (car vecs))))
    (math-covariance vecs nil nil 0)))

(defun calcFunc-vsdev (&rest vecs)
  (if (and (= (length vecs) 1)
	   (memq (car-safe (car vecs)) '(sdev intv)))
      (if (eq (car-safe (car vecs)) 'intv)
	  (if (math-floatp (car vecs))
	      (math-div (math-sub (nth 3 (car vecs)) (nth 2 (car vecs)))
			(math-sqrt-12))
	    (math-sqrt (calcFunc-vvar (car vecs))))
	(nth 2 (car vecs)))
    (math-sqrt (math-covariance vecs nil nil 0))))

;;; Compute the population variance or std deviation of numbers or vectors.
(defun calcFunc-vpvar (&rest vecs)
  (if (and (= (length vecs) 1)
	   (memq (car-safe (car vecs)) '(sdev intv)))
      (if (eq (car-safe (car vecs)) 'intv)
	  (math-intv-variance (car vecs) t)
	(math-sqr (nth 2 (car vecs))))
    (math-covariance vecs nil t 0)))

(defun calcFunc-vpsdev (&rest vecs)
  (if (and (= (length vecs) 1)
	   (memq (car-safe (car vecs)) '(sdev intv)))
      (if (eq (car-safe (car vecs)) 'intv)
	  (if (math-floatp (car vecs))
	      (math-div (math-sub (nth 3 (car vecs)) (nth 2 (car vecs)))
			(math-sqrt-12))
	    (math-sqrt (calcFunc-vpvar (car vecs))))
	(nth 2 (car vecs)))
    (math-sqrt (math-covariance vecs nil t 0))))

(defun math-intv-variance (x pop)
  (or (math-constp x) (math-reject-arg x 'constp))
  (if (math-floatp x)
      (math-div (math-sqr (math-sub (nth 3 x) (nth 2 x))) 12)
    (let* ((x (math-fix-int-intv x))
	   (len (math-sub (nth 3 x) (nth 2 x)))
	   (hlen (math-quotient len 2)))
      (math-div (if (math-evenp len)
		    (calcFunc-sum '(^ (var X var-X) 2) '(var X var-X)
				  (math-neg hlen) hlen)
		  (calcFunc-sum '(^ (- (var X var-X) (/ 1 2)) 2)
				'(var X var-X)
				(math-neg hlen) (math-add hlen 1)))
		(if pop (math-add len 1) len)))))

;;; Compute the covariance and linear correlation coefficient.
(defun calcFunc-vcov (vec1 &optional vec2)
  (math-covariance (list vec1) (list vec2) nil 1))

(defun calcFunc-vpcov (vec1 &optional vec2)
  (math-covariance (list vec1) (list vec2) t 1))

(defun calcFunc-vcorr (vec1 &optional vec2)
  (math-covariance (list vec1) (list vec2) nil 2))


(defun math-covariance (vec1 vec2 pop mode)
  (or (car vec2) (= mode 0)
      (progn
	(if (and (eq (car-safe (car vec1)) 'var)
		 (eq (car-safe (calc-var-value (nth 2 (car vec1)))) 'vec))
	    (setq vec1 (symbol-value (nth 2 (car vec1))))
	  (setq vec1 (car vec1)))
	(or (math-matrixp vec1) (math-dimension-error))
	(or (= (length (nth 1 vec1)) 3) (math-dimension-error))
	(setq vec2 (list (math-mat-col vec1 2))
	      vec1 (list (math-mat-col vec1 1)))))
  (math-with-extra-prec 2
    (let* ((split1 (math-split-sdev-vec (math-flatten-many-vecs vec1) nil))
	   (means1 (car split1))
	   (wts1 (nth 1 split1))
	   split2 means2 (wts2 nil)
	   (sqrwts nil)
	   suminvsqrwts
	   (len (1- (length means1))))
      (if (< len (if pop 1 2))
	  (math-reject-arg nil (if pop
				   "*Must be at least 1 argument"
				 "*Must be at least 2 arguments")))
      (if (or wts1 wts2)
	  (setq sqrwts (math-add
			(if wts1
			    (calcFunc-map '(var mul var-mul) wts1 wts1)
			  0)
			(if wts2
			    (calcFunc-map '(var mul var-mul) wts2 wts2)
			  0))
		suminvsqrwts (calcFunc-reduce
			      '(var add var-add)
			      (calcFunc-map '(var div var-div) 1 sqrwts))))
      (or (= mode 0)
	  (progn
	    (setq split2 (math-split-sdev-vec (math-flatten-many-vecs vec2)
					      nil)
		  means2 (car split2)
		  wts2 (nth 2 split1))
	    (or (= len (1- (length means2))) (math-dimension-error))))
      (let* ((diff1 (calcFunc-map
		     '(var add var-add)
		     means1
		     (if sqrwts
			 (math-div (calcFunc-reduce
				    '(var add var-add)
				    (calcFunc-map '(var div var-div)
						  means1 sqrwts))
				   (math-neg suminvsqrwts))
		       (math-div (calcFunc-reducer '(var add var-add) means1)
				 (- len)))))
	     (diff2 (if (= mode 0)
			diff1
		      (calcFunc-map
		       '(var add var-add)
		       means2
		       (if sqrwts
			   (math-div (calcFunc-reduce
				      '(var add var-add)
				      (calcFunc-map '(var div var-div)
						    means2 sqrwts))
				     (math-neg suminvsqrwts))
			 (math-div (calcFunc-reducer '(var add var-add) means2)
				   (- len))))))
	     (covar (calcFunc-map '(var mul var-mul) diff1 diff2)))
	(if sqrwts
	    (setq covar (calcFunc-map '(var div var-div) covar sqrwts)))
	(math-div
	 (calcFunc-reducer '(var add var-add) covar)
	 (if (= mode 2)
	     (let ((var1 (calcFunc-map '(var mul var-mul) diff1 diff1))
		   (var2 (calcFunc-map '(var mul var-mul) diff2 diff2)))
	       (if sqrwts
		   (setq var1 (calcFunc-map '(var div var-div) var1 sqrwts)
			 var2 (calcFunc-map '(var div var-div) var2 sqrwts)))
	       (math-sqrt
		(math-mul (calcFunc-reducer '(var add var-add) var1)
			  (calcFunc-reducer '(var add var-add) var2))))
	   (if sqrwts
	       (if pop
		   suminvsqrwts
		 (math-div (math-mul suminvsqrwts (1- len)) len))
	     (if pop len (1- len)))))))))

(provide 'calc-stat)

;; arch-tag: 423858e9-8513-489c-9f35-710cd9d9c307
;;; calc-stat.el ends here
Commit	Line	Data
3132f345 CW	1	;;; calc-stat.el --- statistical functions for Calc
3132f345 CW	2
58ba2f8f	3	;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
8b72699e	4	;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
3132f345 CW	5
3132f345 CW	6	;; Author: David Gillespie <daveg@synaptics.com>
e8fff8ed	7	;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
136211a9 EZ	8
	9	;; This file is part of GNU Emacs.
	10
662c9c64	11	;; GNU Emacs is free software: you can redistribute it and/or modify
7c671b23	12	;; it under the terms of the GNU General Public License as published by
662c9c64 GM	13	;; the Free Software Foundation, either version 3 of the License, or
662c9c64 GM	14	;; (at your option) any later version.
7c671b23	15
136211a9	16	;; GNU Emacs is distributed in the hope that it will be useful,
7c671b23 GM	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
662c9c64	22	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
136211a9	23
3132f345	24	;;; Commentary:
136211a9	25
3132f345	26	;;; Code:
136211a9 EZ	27
136211a9 EZ	28	;; This file is autoloaded from calc-ext.el.
136211a9	29
01a2939c	30	(require 'calc-ext)
136211a9 EZ	31	(require 'calc-macs)
136211a9 EZ	32
136211a9 EZ	33	;;; Statistical operations on vectors.
	34
	35	(defun calc-vector-count (arg)
	36	(interactive "P")
	37	(calc-slow-wrapper
bf77c646	38	(calc-vector-op "coun" 'calcFunc-vcount arg)))
136211a9 EZ	39
	40	(defun calc-vector-sum (arg)
	41	(interactive "P")
	42	(calc-slow-wrapper
	43	(if (calc-is-hyperbolic)
	44	(calc-vector-op "vprd" 'calcFunc-vprod arg)
bf77c646	45	(calc-vector-op "vsum" 'calcFunc-vsum arg))))
136211a9 EZ	46
	47	(defun calc-vector-product (arg)
	48	(interactive "P")
	49	(calc-hyperbolic-func)
bf77c646	50	(calc-vector-sum arg))
136211a9 EZ	51
	52	(defun calc-vector-max (arg)
	53	(interactive "P")
	54	(calc-slow-wrapper
	55	(if (calc-is-inverse)
	56	(calc-vector-op "vmin" 'calcFunc-vmin arg)
bf77c646	57	(calc-vector-op "vmax" 'calcFunc-vmax arg))))
136211a9 EZ	58
	59	(defun calc-vector-min (arg)
	60	(interactive "P")
	61	(calc-invert-func)
bf77c646	62	(calc-vector-max arg))
136211a9 EZ	63
	64	(defun calc-vector-mean (arg)
	65	(interactive "P")
	66	(calc-slow-wrapper
	67	(if (calc-is-hyperbolic)
	68	(if (calc-is-inverse)
	69	(calc-vector-op "harm" 'calcFunc-vhmean arg)
	70	(calc-vector-op "medn" 'calcFunc-vmedian arg))
	71	(if (calc-is-inverse)
	72	(calc-vector-op "meae" 'calcFunc-vmeane arg)
bf77c646	73	(calc-vector-op "mean" 'calcFunc-vmean arg)))))
136211a9 EZ	74
	75	(defun calc-vector-mean-error (arg)
	76	(interactive "P")
	77	(calc-invert-func)
bf77c646	78	(calc-vector-mean arg))
136211a9 EZ	79
	80	(defun calc-vector-median (arg)
	81	(interactive "P")
	82	(calc-hyperbolic-func)
bf77c646	83	(calc-vector-mean arg))
136211a9 EZ	84
	85	(defun calc-vector-harmonic-mean (arg)
	86	(interactive "P")
	87	(calc-invert-func)
	88	(calc-hyperbolic-func)
bf77c646	89	(calc-vector-mean arg))
136211a9 EZ	90
	91	(defun calc-vector-geometric-mean (arg)
	92	(interactive "P")
	93	(calc-slow-wrapper
	94	(if (calc-is-hyperbolic)
	95	(calc-binary-op "geom" 'calcFunc-agmean arg)
bf77c646	96	(calc-vector-op "geom" 'calcFunc-vgmean arg))))
136211a9 EZ	97
	98	(defun calc-vector-sdev (arg)
	99	(interactive "P")
	100	(calc-slow-wrapper
	101	(if (calc-is-hyperbolic)
	102	(if (calc-is-inverse)
	103	(calc-vector-op "pvar" 'calcFunc-vpvar arg)
	104	(calc-vector-op "var" 'calcFunc-vvar arg))
	105	(if (calc-is-inverse)
	106	(calc-vector-op "psdv" 'calcFunc-vpsdev arg)
bf77c646	107	(calc-vector-op "sdev" 'calcFunc-vsdev arg)))))
136211a9 EZ	108
	109	(defun calc-vector-pop-sdev (arg)
	110	(interactive "P")
	111	(calc-invert-func)
bf77c646	112	(calc-vector-sdev arg))
136211a9 EZ	113
	114	(defun calc-vector-variance (arg)
	115	(interactive "P")
	116	(calc-hyperbolic-func)
bf77c646	117	(calc-vector-sdev arg))
136211a9 EZ	118
	119	(defun calc-vector-pop-variance (arg)
	120	(interactive "P")
	121	(calc-invert-func)
	122	(calc-hyperbolic-func)
bf77c646	123	(calc-vector-sdev arg))
136211a9 EZ	124
	125	(defun calc-vector-covariance (arg)
	126	(interactive "P")
	127	(calc-slow-wrapper
	128	(let ((n (if (eq arg 1) 1 2)))
	129	(if (calc-is-hyperbolic)
	130	(calc-enter-result n "corr" (cons 'calcFunc-vcorr
	131	(calc-top-list-n n)))
	132	(if (calc-is-inverse)
	133	(calc-enter-result n "pcov" (cons 'calcFunc-vpcov
	134	(calc-top-list-n n)))
	135	(calc-enter-result n "cov" (cons 'calcFunc-vcov
bf77c646	136	(calc-top-list-n n))))))))
136211a9 EZ	137
	138	(defun calc-vector-pop-covariance (arg)
	139	(interactive "P")
	140	(calc-invert-func)
bf77c646	141	(calc-vector-covariance arg))
136211a9 EZ	142
	143	(defun calc-vector-correlation (arg)
	144	(interactive "P")
	145	(calc-hyperbolic-func)
bf77c646	146	(calc-vector-covariance arg))
136211a9 EZ	147
	148	(defun calc-vector-op (name func arg)
	149	(setq calc-aborted-prefix name
	150	arg (prefix-numeric-value arg))
	151	(if (< arg 0)
	152	(error "Negative arguments not allowed"))
bf77c646	153	(calc-enter-result arg name (cons func (calc-top-list-n arg))))
136211a9 EZ	154
	155
	156
	157
	158	;;; Useful statistical functions
	159
	160	;;; Sum, product, etc., of one or more values or vectors.
	161	;;; Each argument must be either a number or a vector. Vectors
	162	;;; are flattened, but variables inside are assumed to represent
	163	;;; non-vectors.
	164
	165	(defun calcFunc-vsum (&rest vecs)
bf77c646	166	(math-reduce-many-vecs 'calcFunc-add 'calcFunc-vsum vecs 0))
136211a9 EZ	167
136211a9 EZ	168	(defun calcFunc-vprod (&rest vecs)
bf77c646	169	(math-reduce-many-vecs 'calcFunc-mul 'calcFunc-vprod vecs 1))
136211a9 EZ	170
	171	(defun calcFunc-vmax (&rest vecs)
	172	(if (eq (car-safe (car vecs)) 'sdev)
	173	'(var inf var-inf)
	174	(if (eq (car-safe (car vecs)) 'intv)
	175	(nth 3 (math-fix-int-intv (car vecs)))
	176	(math-reduce-many-vecs 'calcFunc-max 'calcFunc-vmax vecs
bf77c646	177	'(neg (var inf var-inf))))))
136211a9 EZ	178
	179	(defun calcFunc-vmin (&rest vecs)
	180	(if (eq (car-safe (car vecs)) 'sdev)
	181	'(neg (var inf var-inf))
	182	(if (eq (car-safe (car vecs)) 'intv)
	183	(nth 2 (math-fix-int-intv (car vecs)))
	184	(math-reduce-many-vecs 'calcFunc-min 'calcFunc-vmin vecs
bf77c646	185	'(var inf var-inf)))))
136211a9 EZ	186
	187	(defun math-reduce-many-vecs (func whole-func vecs ident)
	188	(let ((const-part nil)
	189	(symb-part nil)
	190	val vec)
	191	(let ((calc-internal-prec (+ calc-internal-prec 2)))
	192	(while vecs
	193	(setq val (car vecs))
	194	(and (eq (car-safe val) 'var)
	195	(eq (car-safe (calc-var-value (nth 2 val))) 'vec)
	196	(setq val (symbol-value (nth 2 val))))
	197	(cond ((Math-vectorp val)
	198	(setq vec (append (and const-part (list const-part))
	199	(math-flatten-vector val)))
	200	(setq const-part (if vec
	201	(calcFunc-reducer
	202	(math-calcFunc-to-var func)
	203	(cons 'vec vec))
	204	ident)))
	205	((or (Math-objectp val) (math-infinitep val))
	206	(setq const-part (if const-part
	207	(funcall func const-part val)
	208	val)))
	209	(t
	210	(setq symb-part (nconc symb-part (list val)))))
	211	(setq vecs (cdr vecs))))
	212	(if const-part
	213	(progn
	214	(setq const-part (math-normalize const-part))
	215	(if symb-part
	216	(funcall func const-part (cons whole-func symb-part))
	217	const-part))
bf77c646	218	(if symb-part (cons whole-func symb-part) ident))))
136211a9 EZ	219
	220
	221	;;; Return the number of data elements among the arguments.
	222	(defun calcFunc-vcount (&rest vecs)
	223	(let ((count 0))
	224	(while vecs
	225	(setq count (if (Math-vectorp (car vecs))
	226	(+ count (math-count-elements (car vecs)))
	227	(if (Math-objectp (car vecs))
	228	(1+ count)
	229	(if (and (eq (car-safe (car vecs)) 'var)
	230	(eq (car-safe (calc-var-value
	231	(nth 2 (car vecs))))
	232	'vec))
	233	(+ count (math-count-elements
	234	(symbol-value (nth 2 (car vecs)))))
	235	(math-reject-arg (car vecs) 'numvecp))))
	236	vecs (cdr vecs)))
bf77c646	237	count))
136211a9 EZ	238
	239	(defun math-count-elements (vec)
	240	(let ((count 0))
	241	(while (setq vec (cdr vec))
	242	(setq count (if (Math-vectorp (car vec))
	243	(+ count (math-count-elements (car vec)))
	244	(1+ count))))
bf77c646	245	count))
136211a9 EZ	246
	247
	248	(defun math-flatten-many-vecs (vecs)
	249	(let ((p vecs)
	250	(vec (list 'vec)))
	251	(while p
	252	(setq vec (nconc vec
	253	(if (Math-vectorp (car p))
	254	(math-flatten-vector (car p))
	255	(if (Math-objectp (car p))
	256	(list (car p))
	257	(if (and (eq (car-safe (car p)) 'var)
	258	(eq (car-safe (calc-var-value
	259	(nth 2 (car p)))) 'vec))
	260	(math-flatten-vector (symbol-value
	261	(nth 2 (car p))))
	262	(math-reject-arg (car p) 'numvecp)))))
	263	p (cdr p)))
bf77c646	264	vec))
136211a9 EZ	265
136211a9 EZ	266	(defun calcFunc-vflat (&rest vecs)
bf77c646	267	(math-flatten-many-vecs vecs))
136211a9 EZ	268
	269	(defun math-split-sdev-vec (vec zero-ok)
	270	(let ((means (list 'vec))
	271	(wts (list 'vec))
	272	(exact nil)
	273	(p vec))
	274	(while (and (setq p (cdr p))
	275	(not (and (consp (car p))
	276	(eq (car (car p)) 'sdev)))))
	277	(if (null p)
	278	(list vec nil)
	279	(while (setq vec (cdr vec))
	280	(if (and (consp (setq p (car vec)))
	281	(eq (car p) 'sdev))
	282	(or exact
	283	(setq means (cons (nth 1 p) means)
	284	wts (cons (nth 2 p) wts)))
	285	(if zero-ok
	286	(setq means (cons (nth 1 p) means)
	287	wts (cons 0 wts))
	288	(or exact
	289	(setq means (list 'vec)
	290	wts nil
	291	exact t))
	292	(setq means (cons p means)))))
	293	(list (nreverse means)
bf77c646	294	(and wts (nreverse wts))))))
136211a9 EZ	295
	296
	297	;;; Return the arithmetic mean of the argument numbers or vectors.
	298	;;; (If numbers are error forms, computes the weighted mean.)
	299	(defun calcFunc-vmean (&rest vecs)
	300	(let* ((split (math-split-sdev-vec (math-flatten-many-vecs vecs) nil))
	301	(means (car split))
	302	(wts (nth 1 split))
	303	(len (1- (length means))))
	304	(if (= len 0)
	305	(math-reject-arg nil "*Must be at least 1 argument")
	306	(if (and (= len 1) (eq (car-safe (nth 1 means)) 'intv))
	307	(let ((x (math-fix-int-intv (nth 1 means))))
	308	(calcFunc-vmean (nth 2 x) (nth 3 x)))
	309	(math-with-extra-prec 2
	310	(if (and wts (> len 1))
	311	(let* ((sqrwts (calcFunc-map '(var mul var-mul) wts wts))
	312	(suminvsqrwts (calcFunc-reduce
	313	'(var add var-add)
	314	(calcFunc-map '(var div var-div)
	315	1 sqrwts))))
	316	(math-div (calcFunc-reduce '(var add var-add)
	317	(calcFunc-map '(var div var-div)
	318	means sqrwts))
	319	suminvsqrwts))
bf77c646	320	(math-div (calcFunc-reduce '(var add var-add) means) len)))))))
136211a9 EZ	321
	322	(defun math-fix-int-intv (x)
	323	(if (math-floatp x)
	324	x
	325	(list 'intv 3
	326	(if (memq (nth 1 x) '(2 3)) (nth 2 x) (math-add (nth 2 x) 1))
bf77c646	327	(if (memq (nth 1 x) '(1 3)) (nth 3 x) (math-sub (nth 3 x) 1)))))
136211a9 EZ	328
	329	;;; Compute the mean with an error estimate.
	330	(defun calcFunc-vmeane (&rest vecs)
	331	(let* ((split (math-split-sdev-vec (math-flatten-many-vecs vecs) nil))
	332	(means (car split))
	333	(wts (nth 1 split))
	334	(len (1- (length means))))
	335	(if (= len 0)
	336	(math-reject-arg nil "*Must be at least 1 argument")
	337	(math-with-extra-prec 2
	338	(if wts
	339	(let* ((sqrwts (calcFunc-map '(var mul var-mul) wts wts))
	340	(suminvsqrwts (calcFunc-reduce
	341	'(var add var-add)
	342	(calcFunc-map '(var div var-div)
	343	1 sqrwts))))
	344	(math-make-sdev
	345	(math-div (calcFunc-reduce '(var add var-add)
	346	(calcFunc-map '(var div var-div)
	347	means sqrwts))
	348	suminvsqrwts)
	349	(list 'calcFunc-sqrt (math-div 1 suminvsqrwts))))
	350	(let ((mean (math-div (calcFunc-reduce '(var add var-add) means)
	351	len)))
	352	(math-make-sdev
	353	mean
	354	(list 'calcFunc-sqrt
	355	(math-div (calcFunc-reducer
	356	'(var add var-add)
	357	(calcFunc-map '(var pow var-pow)
	358	(calcFunc-map '(var abs var-abs)
	359	(calcFunc-map
	360	'(var add var-add)
	361	means
	362	(math-neg mean)))
	363	2))
bf77c646	364	(math-mul len (1- len)))))))))))
136211a9 EZ	365
	366
	367	;;; Compute the median of a list of values.
	368	(defun calcFunc-vmedian (&rest vecs)
	369	(let* ((flat (copy-sequence (cdr (math-flatten-many-vecs vecs))))
	370	(p flat)
	371	(len (length flat))
	372	(hlen (/ len 2)))
	373	(if (= len 0)
	374	(math-reject-arg nil "*Must be at least 1 argument")
	375	(if (and (= len 1) (memq (car-safe (car flat)) '(sdev intv)))
	376	(calcFunc-vmean (car flat))
	377	(while p
	378	(if (eq (car-safe (car p)) 'sdev)
	379	(setcar p (nth 1 (car p))))
	380	(or (Math-anglep (car p))
	381	(math-reject-arg (car p) 'anglep))
	382	(setq p (cdr p)))
	383	(setq flat (sort flat 'math-lessp))
	384	(if (= (% len 2) 0)
	385	(math-div (math-add (nth (1- hlen) flat) (nth hlen flat)) 2)
bf77c646	386	(nth hlen flat))))))
136211a9 EZ	387
	388
	389	(defun calcFunc-vgmean (&rest vecs)
	390	(let* ((flat (math-flatten-many-vecs vecs))
	391	(len (1- (length flat))))
	392	(if (= len 0)
	393	(math-reject-arg nil "*Must be at least 1 argument")
	394	(math-with-extra-prec 2
	395	(let ((x (calcFunc-reduce '(var mul math-mul) flat)))
	396	(if (= len 2)
	397	(math-sqrt x)
bf77c646	398	(math-pow x (list 'frac 1 len))))))))
136211a9 EZ	399
	400
	401	(defun calcFunc-agmean (a b)
	402	(cond ((Math-equal a b) a)
	403	((math-zerop a) a)
	404	((math-zerop b) b)
	405	(calc-symbolic-mode (math-inexact-result))
	406	((not (Math-realp a)) (math-reject-arg a 'realp))
	407	((not (Math-realp b)) (math-reject-arg b 'realp))
	408	(t
	409	(math-with-extra-prec 2
	410	(setq a (math-float (math-abs a))
	411	b (math-float (math-abs b)))
	412	(let (mean)
	413	(while (not (math-nearly-equal-float a b))
	414	(setq mean (math-mul-float (math-add-float a b) '(float 5 -1))
	415	b (math-sqrt-float (math-mul-float a b))
	416	a mean))
bf77c646	417	a)))))
136211a9 EZ	418
	419
	420	(defun calcFunc-vhmean (&rest vecs)
	421	(let* ((flat (math-flatten-many-vecs vecs))
	422	(len (1- (length flat))))
	423	(if (= len 0)
	424	(math-reject-arg nil "*Must be at least 1 argument")
	425	(math-with-extra-prec 2
	426	(math-div len
	427	(calcFunc-reduce '(var add math-add)
bf77c646	428	(calcFunc-map '(var inv var-inv) flat)))))))
136211a9 EZ	429
	430
	431
	432	;;; Compute the sample variance or standard deviation of numbers or vectors.
	433	;;; (If the numbers are error forms, only the mean part of them is used.)
	434	(defun calcFunc-vvar (&rest vecs)
	435	(if (and (= (length vecs) 1)
	436	(memq (car-safe (car vecs)) '(sdev intv)))
	437	(if (eq (car-safe (car vecs)) 'intv)
	438	(math-intv-variance (car vecs) nil)
	439	(math-sqr (nth 2 (car vecs))))
bf77c646	440	(math-covariance vecs nil nil 0)))
136211a9 EZ	441
	442	(defun calcFunc-vsdev (&rest vecs)
	443	(if (and (= (length vecs) 1)
	444	(memq (car-safe (car vecs)) '(sdev intv)))
	445	(if (eq (car-safe (car vecs)) 'intv)
	446	(if (math-floatp (car vecs))
	447	(math-div (math-sub (nth 3 (car vecs)) (nth 2 (car vecs)))
	448	(math-sqrt-12))
	449	(math-sqrt (calcFunc-vvar (car vecs))))
	450	(nth 2 (car vecs)))
bf77c646	451	(math-sqrt (math-covariance vecs nil nil 0))))
136211a9 EZ	452
	453	;;; Compute the population variance or std deviation of numbers or vectors.
	454	(defun calcFunc-vpvar (&rest vecs)
	455	(if (and (= (length vecs) 1)
	456	(memq (car-safe (car vecs)) '(sdev intv)))
	457	(if (eq (car-safe (car vecs)) 'intv)
	458	(math-intv-variance (car vecs) t)
	459	(math-sqr (nth 2 (car vecs))))
bf77c646	460	(math-covariance vecs nil t 0)))
136211a9 EZ	461
	462	(defun calcFunc-vpsdev (&rest vecs)
	463	(if (and (= (length vecs) 1)
	464	(memq (car-safe (car vecs)) '(sdev intv)))
	465	(if (eq (car-safe (car vecs)) 'intv)
	466	(if (math-floatp (car vecs))
	467	(math-div (math-sub (nth 3 (car vecs)) (nth 2 (car vecs)))
	468	(math-sqrt-12))
	469	(math-sqrt (calcFunc-vpvar (car vecs))))
	470	(nth 2 (car vecs)))
bf77c646	471	(math-sqrt (math-covariance vecs nil t 0))))
136211a9 EZ	472
	473	(defun math-intv-variance (x pop)
	474	(or (math-constp x) (math-reject-arg x 'constp))
	475	(if (math-floatp x)
	476	(math-div (math-sqr (math-sub (nth 3 x) (nth 2 x))) 12)
	477	(let* ((x (math-fix-int-intv x))
	478	(len (math-sub (nth 3 x) (nth 2 x)))
	479	(hlen (math-quotient len 2)))
	480	(math-div (if (math-evenp len)
	481	(calcFunc-sum '(^ (var X var-X) 2) '(var X var-X)
	482	(math-neg hlen) hlen)
	483	(calcFunc-sum '(^ (- (var X var-X) (/ 1 2)) 2)
	484	'(var X var-X)
	485	(math-neg hlen) (math-add hlen 1)))
bf77c646	486	(if pop (math-add len 1) len)))))
136211a9 EZ	487
	488	;;; Compute the covariance and linear correlation coefficient.
	489	(defun calcFunc-vcov (vec1 &optional vec2)
bf77c646	490	(math-covariance (list vec1) (list vec2) nil 1))
136211a9 EZ	491
136211a9 EZ	492	(defun calcFunc-vpcov (vec1 &optional vec2)
bf77c646	493	(math-covariance (list vec1) (list vec2) t 1))
136211a9 EZ	494
136211a9 EZ	495	(defun calcFunc-vcorr (vec1 &optional vec2)
bf77c646	496	(math-covariance (list vec1) (list vec2) nil 2))
136211a9 EZ	497
	498
	499	(defun math-covariance (vec1 vec2 pop mode)
	500	(or (car vec2) (= mode 0)
	501	(progn
	502	(if (and (eq (car-safe (car vec1)) 'var)
	503	(eq (car-safe (calc-var-value (nth 2 (car vec1)))) 'vec))
	504	(setq vec1 (symbol-value (nth 2 (car vec1))))
	505	(setq vec1 (car vec1)))
	506	(or (math-matrixp vec1) (math-dimension-error))
	507	(or (= (length (nth 1 vec1)) 3) (math-dimension-error))
	508	(setq vec2 (list (math-mat-col vec1 2))
	509	vec1 (list (math-mat-col vec1 1)))))
	510	(math-with-extra-prec 2
	511	(let* ((split1 (math-split-sdev-vec (math-flatten-many-vecs vec1) nil))
	512	(means1 (car split1))
	513	(wts1 (nth 1 split1))
	514	split2 means2 (wts2 nil)
	515	(sqrwts nil)
	516	suminvsqrwts
	517	(len (1- (length means1))))
	518	(if (< len (if pop 1 2))
	519	(math-reject-arg nil (if pop
	520	"*Must be at least 1 argument"
	521	"*Must be at least 2 arguments")))
	522	(if (or wts1 wts2)
	523	(setq sqrwts (math-add
	524	(if wts1
	525	(calcFunc-map '(var mul var-mul) wts1 wts1)
	526	0)
	527	(if wts2
	528	(calcFunc-map '(var mul var-mul) wts2 wts2)
	529	0))
	530	suminvsqrwts (calcFunc-reduce
	531	'(var add var-add)
	532	(calcFunc-map '(var div var-div) 1 sqrwts))))
	533	(or (= mode 0)
	534	(progn
	535	(setq split2 (math-split-sdev-vec (math-flatten-many-vecs vec2)
	536	nil)
	537	means2 (car split2)
	538	wts2 (nth 2 split1))
	539	(or (= len (1- (length means2))) (math-dimension-error))))
	540	(let* ((diff1 (calcFunc-map
	541	'(var add var-add)
	542	means1
	543	(if sqrwts
	544	(math-div (calcFunc-reduce
	545	'(var add var-add)
	546	(calcFunc-map '(var div var-div)
	547	means1 sqrwts))
	548	(math-neg suminvsqrwts))
	549	(math-div (calcFunc-reducer '(var add var-add) means1)
	550	(- len)))))
	551	(diff2 (if (= mode 0)
	552	diff1
	553	(calcFunc-map
	554	'(var add var-add)
	555	means2
	556	(if sqrwts
	557	(math-div (calcFunc-reduce
	558	'(var add var-add)
	559	(calcFunc-map '(var div var-div)
	560	means2 sqrwts))
561	(math-neg suminvsqrwts))
562	(math-div (calcFunc-reducer '(var add var-add) means2)
563	(- len))))))
564	(covar (calcFunc-map '(var mul var-mul) diff1 diff2)))
565	(if sqrwts
566	(setq covar (calcFunc-map '(var div var-div) covar sqrwts)))
567	(math-div
568	(calcFunc-reducer '(var add var-add) covar)
569	(if (= mode 2)
570	(let ((var1 (calcFunc-map '(var mul var-mul) diff1 diff1))
571	(var2 (calcFunc-map '(var mul var-mul) diff2 diff2)))
572	(if sqrwts
573	(setq var1 (calcFunc-map '(var div var-div) var1 sqrwts)
574	var2 (calcFunc-map '(var div var-div) var2 sqrwts)))
575	(math-sqrt
576	(math-mul (calcFunc-reducer '(var add var-add) var1)
577	(calcFunc-reducer '(var add var-add) var2))))
578	(if sqrwts
579	(if pop
580	suminvsqrwts
581	(math-div (math-mul suminvsqrwts (1- len)) len))
bf77c646	582	(if pop len (1- len)))))))))
136211a9	583
01a2939c JB	584	(provide 'calc-stat)
01a2939c JB	585
cbee283d	586	;; arch-tag: 423858e9-8513-489c-9f35-710cd9d9c307
bf77c646	587	;;; calc-stat.el ends here