/[bayescl]/bayescl/bucket.lisp
ViewVC logotype

Contents of /bayescl/bucket.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Tue Nov 25 15:55:34 2003 UTC (10 years, 4 months ago) by aventimiglia
Branch point for: aventimiglia, MAIN
Initial revision
1 aventimiglia 1.1 ;; $Id: bucket.lisp,v 1.1 2003/11/25 15:55:34 aventimiglia Exp $
2     ;;
3     ;; bayescl - A Common Lisp Bayesian Filtering Library
4     ;; (c) 2003 Anthony J Ventimiglia.
5     ;;
6     ;; This library is free software; you can redistribute it and/or
7     ;; modify it under the terms of the terms of the Lisp Lesser GNU
8     ;; Public License, known as the LLGPL
9     ;;
10     ;; This library is distributed in the hope that it will be useful,
11     ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12     ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13     ;;
14     ;; You should have received a copy of the Lisp Lesser General Public
15     ;; License along with this library; if not, please see
16     ;; http://opensource.franz.com/preamble.html.
17     ;;
18     ;; email: aventimiglia@common-lisp.net
19     ;; HomePage: http://common-lisp.net/project/bayescl
20    
21     (in-package #:net.common-lisp.bayescl)
22    
23     (defvar *minimum-score* 1/10000)
24    
25     (defclass bucket ()
26     ((name :reader bucket-name
27     :type (or symbol string)
28     :initarg :name
29     :documentation "An identifying name")
30     (map :accessor bucket-map
31     :type hash-table
32     :initarg :map)
33     (token-count :accessor bucket-count
34     :type (unsigned-byte 32)
35     :initform 0))
36     (:documentation "Used to store and retrieve token data for use by a filter object"))
37    
38     (defun make-bucket (name &optional (test 'eq))
39     "This is the public way to create Bayesian buckets, Do not use
40     MAKE-INSTANCE, since it does not initialize the internal hash table."
41     (declare (type (or symbol string) name)
42     (type symbol test))
43     (make-instance 'bucket :name name
44     :map (make-hash-table :test test)))
45    
46     (defmethod add-token ((self bucket) token &optional (count 1))
47     (declare (type bucket self)
48     (type (unsigned-byte 32) count))
49     "Add COUNT TOKENs to SELF bucket"
50     (let ((map (bucket-map self)))
51     (setf (gethash token map) (+ count (gethash token map 0))
52     (bucket-count self) (+ count (bucket-count self)))))
53    
54     (defmethod score-token ((self bucket) token)
55     (let ((total (bucket-count self)))
56     (if (zerop total) *minimum-score*
57     (/ (gethash token (bucket-map self) 0) total))))
58    
59     (defun save-bucket (bucket &optional directory)
60     "Saves BUCKET for later loading using the LOAD method. If DIRECTORY
61     is given save to that directory, otherwise saves to the current
62     working directory. The Bucket will be saved with the the bucket's name
63     with the extension"
64     (let ((filename (if directory (merge-pathnames directory
65     (bucket-name bucket))
66     (bucket-name bucket))))
67     (with-open-file (stream filename :direction :output)
68     (format stream "(~S ~S)~%" (bucket-name bucket)
69     (hash-table-test (bucket-map bucket)))
70     (format stream "~S~%"
71     (with-hash-table-iterator (next-token (bucket-map bucket))
72     (loop for item = (multiple-value-list (next-token))
73     while (car item)
74     collect (list (cadr item) (caddr item))))))))
75    
76     (defun load-bucket (pathname)
77     "Load and return a SAVEd bucket"
78     (let (bucket
79     (eof (gensym)))
80     (with-open-file (stream pathname :direction :input)
81     (let ((bucket-info (read stream nil eof)))
82     ;; Need error checking, this assumes the file is the right format
83     (setq bucket (make-bucket (car bucket-info) (cadr bucket-info))))
84     (loop for item in (read stream nil eof)
85     do (add-token bucket (car item) (cadr item))))
86     bucket))
87    

  ViewVC Help
Powered by ViewVC 1.1.5