(in-package :fwoar.counter) (defclass counter () ((%counts :type hash-table :accessor item-counts) (%test :initarg :test :initform 'eql :accessor counter-test) (%key :initarg :key :initform 'identity :accessor counter-key))) (defmethod initialize-instance :after ((counter counter) &rest initargs &key test) (declare (ignorable initargs)) (setf (item-counts counter) (make-hash-table :test test))) (defgeneric count-sequence (sequence &key test key) (:documentation "take a sequence, count it using test to compare elements and key to extract values from them")) (defgeneric update-counts (counter sequence) (:documentation "given a sequence, update a counter")) (defgeneric extract-count (counter item) (:documentation "Given a counter and an item, return the number of times that item has been counted.")) (defgeneric format-counts (counter stream) (:documentation "Given a counter and a stream, format the counter's counts to that stream")) (defmethod extract-count ((counter counter) item) (gethash (funcall (counter-key counter) item) (item-counts counter) 0)) (defmethod count-sequence ((sequence string) &key (test 'eql) (key 'identity)) (let ((result (make-instance 'counter :test test :key key))) (prog1 result (map 'list (lambda (c) (incf (gethash (funcall key c) (item-counts result) 0))) sequence)))) (defmethod format-counts ((counter counter) (stream stream)) (let ((result '())) (maphash (lambda (key val) (push (list key val) result)) (item-counts counter)) (format t "~:{~s: ~2d~%~}" (stable-sort result #'< :key #'cadr)))) (defmethod update-counts ((counter counter) sequence) (with-accessors ((item-counts item-counts) (test counter-test) (key counter-key)) counter (maphash (lambda (key value) (incf (gethash key item-counts 0) value)) (item-counts (count-sequence sequence :test test :key key)))))