1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
(defun histogram (a &key (index #'identity) (n-buckets 256))
(let ((hist (make-array n-buckets :element-type :integer))
(values (if (vectorp a) a (coerce a vector)))
j)
(dotimes (i (length values))
(setq j (funcall index (aref values i) n-buckets))
(incf (aref hist j)) )
hist) )
(defun limit-index (n max)
(if (>= n max) (1- max) (round n)))
(defun bargraph (vec &key ((:viewer vwr) *viewer*)
(color nil)
(vertical t)
(horizontal (null vertical)))
(let* ((num (length vec))
(vlist (coerce vec cons))
(vmin (float (apply #'min vlist)))
(vmax (float (apply #'max vlist)))
(x -1.0) (y)
(xinc (/ 2.0 num))
(val)
)
(dotimes (n num)
(setq val (float (elt vec n)))
(setq y (* 2.0 (/ val vmax)) )
(send vwr :draw-fill-rectangle-ndc ;point width height
(float-vector x (- y 1.0))
xinc y color)
(incf x xinc)
)
(send vwr :flush)
))
(defun find-n-max (vec &optional (n 1))
"vec is a histogram vector"
(let ((value-index-pairs))
(dotimes (i (length vec))
(push (list i (aref vec i)) value-index-pairs))
(sort value-index-pairs #'>= #'cadr)
(butlast value-index-pairs (- (length vec) n))))
|
