Mercurial > emacs
changeset 108618:2f98c61bd2c1
calc-vec.el (calc-histogram):
(calcFunc-histogram): Allow vectors as inputs.
(math-vector-avg): New function.
calc.texi (Manipulating Vectors): Mention that vectors can be used to
determine bins for `calc-histogram'.
| author | Jay Belanger <jay.p.belanger@gmail.com> |
|---|---|
| date | Sat, 15 May 2010 23:43:09 -0500 |
| parents | 429144ae3b54 |
| children | 77227c6520c3 |
| files | doc/misc/ChangeLog doc/misc/calc.texi lisp/ChangeLog lisp/calc/README lisp/calc/calc-vec.el |
| diffstat | 5 files changed, 78 insertions(+), 20 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Sat May 15 21:18:52 2010 -0500 +++ b/doc/misc/ChangeLog Sat May 15 23:43:09 2010 -0500 @@ -1,6 +1,11 @@ +2010-05-16 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi (Manipulating Vectors): Mention that vectors can + be used to determine bins for `calc-histogram'. + 2010-05-13 Jay Belanger <jay.p.belanger@gmail.com> - * calc.texi: Remove "\turnoffactive" commands througout. + * calc.texi: Remove "\turnoffactive" commands throughout. 2010-05-08 Štěpán Němec <stepnem@gmail.com> (tiny change)
--- a/doc/misc/calc.texi Sat May 15 21:18:52 2010 -0500 +++ b/doc/misc/calc.texi Sat May 15 23:43:09 2010 -0500 @@ -20030,6 +20030,20 @@ that the counts in the result vector don't add up to the length of the input vector.) +If no prefix is given, then you will be prompted for a vector which +will be used to determine the bins. (If a positive integer is given at +this prompt, it will be still treated as if it were given as a +prefix.) Each bin will consist of the interval of numbers closest to +the corresponding number of this new vector; if the vector +@expr{[a, b, c, ...]} is entered at the prompt, the bins will be +@expr{(-inf, (a+b)/2]}, @expr{((a+b)/2, (b+c)/2]}, etc. The result of +this command will be a vector counting how many elements of the +original vector are in each bin. + +The result will then be a vector with the same length as this new vector; +each element of the new vector will be replaced by the number of +elements of the original vector which are closest to it. + @kindex H v H @kindex H V H With the Hyperbolic flag, @kbd{H V H} pulls two vectors from the stack.
--- a/lisp/ChangeLog Sat May 15 21:18:52 2010 -0500 +++ b/lisp/ChangeLog Sat May 15 23:43:09 2010 -0500 @@ -1,5 +1,9 @@ 2010-05-16 Jay Belanger <jay.p.belanger@gmail.com> + * calc/calc-vec.el (calc-histogram): + (calcFunc-histogram): Allow vectors as inputs. + (math-vector-avg): New function. + * calc/calc-ext.el (math-group-float): Have the number of digits being grouped depend on the radix (Bug#6189).
--- a/lisp/calc/README Sat May 15 21:18:52 2010 -0500 +++ b/lisp/calc/README Sat May 15 23:43:09 2010 -0500 @@ -74,6 +74,8 @@ Emacs 24.1 +* Gave `calc-histogram' the option of using a vector to determine the bins. + * Added "O" option prefix. * Used "O" prefix to "d r" (`calc-radix') to turn on twos-complement mode.
--- a/lisp/calc/calc-vec.el Sat May 15 21:18:52 2010 -0500 +++ b/lisp/calc/calc-vec.el Sat May 15 23:43:09 2010 -0500 @@ -451,16 +451,18 @@ (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1)))))) (defun calc-histogram (n) - (interactive "NNumber of bins: ") + (interactive "P") + (unless (natnump n) + (setq n (math-read-expr (read-string "Centers of bins: ")))) (calc-slow-wrapper (if calc-hyperbolic-flag (calc-enter-result 2 "hist" (list 'calcFunc-histogram (calc-top-n 2) (calc-top-n 1) - (prefix-numeric-value n))) + n)) (calc-enter-result 1 "hist" (list 'calcFunc-histogram (calc-top-n 1) - (prefix-numeric-value n)))))) + n))))) (defun calc-transpose (arg) (interactive "P") @@ -1135,22 +1137,53 @@ (if (Math-vectorp wts) (or (= (length vec) (length wts)) (math-dimension-error))) - (or (natnump n) - (math-reject-arg n 'fixnatnump)) - (let ((res (make-vector n 0)) - (vp vec) - (wvec (Math-vectorp wts)) - (wp wts) - bin) - (while (setq vp (cdr vp)) - (setq bin (car vp)) - (or (natnump bin) - (setq bin (math-floor bin))) - (and (natnump bin) - (< bin n) - (aset res bin (math-add (aref res bin) - (if wvec (car (setq wp (cdr wp))) wts))))) - (cons 'vec (append res nil)))) + (cond ((natnump n) + (let ((res (make-vector n 0)) + (vp vec) + (wvec (Math-vectorp wts)) + (wp wts) + bin) + (while (setq vp (cdr vp)) + (setq bin (car vp)) + (or (natnump bin) + (setq bin (math-floor bin))) + (and (natnump bin) + (< bin n) + (aset res bin + (math-add (aref res bin) + (if wvec (car (setq wp (cdr wp))) wts))))) + (cons 'vec (append res nil)))) + ((Math-vectorp n) ;; n is a vector of midpoints + (let* ((bds (math-vector-avg n)) + (res (make-vector (1- (length n)) 0)) + (vp (cdr vec)) + (wvec (Math-vectorp wts)) + (wp wts) + num) + (while vp + (setq num (car vp)) + (let ((tbds (cdr bds)) + (i 0)) + (while (and tbds (Math-lessp (car tbds) num)) + (setq i (1+ i)) + (setq tbds (cdr tbds))) + (aset res i + (math-add (aref res i) + (if wvec (car (setq wp (cdr wp))) wts)))) + (setq vp (cdr vp))) + (cons 'vec (append res nil)))) + (t + (math-reject-arg n "*Expecting an integer or vector")))) + +;;; Replace a vector [a b c ...] with a vector of averages +;;; [(a+b)/2 (b+c)/2 ...] +(defun math-vector-avg (vec) + (let ((vp (cdr vec)) + (res nil)) + (while (and vp (cdr vp)) + (setq res (cons (math-div (math-add (car vp) (cadr vp)) 2) res) + vp (cdr vp))) + (cons 'vec (reverse res)))) ;;; Set operations.