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

Contents of /bayescl/filter.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show 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 ;; $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