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

Contents of /bayescl/filter.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (vendor branch)
Tue Nov 25 15:55:34 2003 UTC (10 years, 4 months ago) by aventimiglia
Branch: aventimiglia, MAIN
CVS Tags: start, HEAD
Changes since 1.1: +0 -0 lines
Initial Transfer to Common-lisp.net repository
1 aventimiglia 1.1 ;; $Id: filter.lisp,v 1.1.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     (defclass filter ()
24     ((buckets :accessor buckets
25     :type list
26     :initarg :buckets
27     :documentation "A list of buckets used for filtering")))
28    
29     (defun make-filter (buckets)
30     (if (< (length buckets) 2) 'error
31     (make-instance 'filter :buckets buckets)))
32    
33     (defmethod score-token ((self filter) token)
34     "Returns an a list of scores for each bucket in the filter"
35     (let ((bucket-ct (length (buckets self))))
36     (let (; Prior probabilities
37     (P[Hx] (make-array bucket-ct
38     :element-type 'rational
39     :initial-element (/ 1 bucket-ct)))
40     ; Conditional probabilities
41     (P[D/Hx] (make-array bucket-ct :element-type 'rational
42     :initial-contents
43     (loop for bucket in (buckets self)
44     collect (score-token bucket token)))))
45     (let ((dividend (apply #'+
46     (loop for i from 0 to (1- bucket-ct)
47     collect (* (aref P[Hx] i)
48     (aref P[D/Hx] i))))))
49     ;; Return all posterior probabilities
50     (loop for i from 0 to (1- bucket-ct)
51     collect (if (zerop dividend) *minimum-score*
52     (/ (* (aref P[Hx] i) (aref P[D/Hx] i))
53     dividend)))))))
54    
55    

  ViewVC Help
Powered by ViewVC 1.1.5