;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10 -*- ;;;; --------------------------------------------------------------------------- ;;;; File name: macfac.lsp ;;;; System: FIRE ;;;; Version: 1.0 ;;;; Author: Ken Forbus ;;;; Created: December 31, 2000 18:59:11 ;;;; Purpose: Implements MAC/FAC similarity-based reminding algorithm ;;;; --------------------------------------------------------------------------- ;;;; Modified: Sunday, February 8, 2004 at 23:50:58 by Kenneth Forbus ;;;; --------------------------------------------------------------------------- (in-package :fire) ;; N.B. Reintroduced a datastructure to hold the results of a retrieval because ;; we really need to leave behind more information for debugging purposes. ;; However, this is not yet installed. Watch this space :-) ;; ;; ***** We probably want to set up assertions that control these ;; ***** in the KB or WM. The system ought to be able to "try harder" ;; ***** or focus/defocus based on the results obtained. ;; ***** Same thing with SME parameters (defvar *mac-maximum-output* 10) (defvar *mac-selector-width* 0.1) (defvar *fac-maximum-output* 3) (defvar *fac-selector-width* 0.1) (defclass macfac () ((id :type integer :initarg :id :reader id :documentation "Integer ID used for lookup") (case-library :type t :initarg :case-library :accessor case-library :documentation "Case library used in this retrieval") (probe :type sme::description :initarg :probe :reader probe) ;; Parameters for the algorithm (mac-selector-width :type float :initarg :mac-selector-width :initform *mac-selector-width* :accessor mac-selector-width :documentation "Results must be within X% of the best to be output.") (mac-maximum-output :type integer :initarg :mac-maximum-output :initform *mac-maximum-output* :accessor mac-maximum-output :documentation "Upper bound on # of results returned by MAC stage.") (fac-selector-width :type float :initarg :fac-selector-width :initform *fac-selector-width* :accessor fac-selector-width :documentation "Results must be within X% of the best to be output.") (fac-maximum-output :type integer :initarg :fac-maximum-output :initform *fac-maximum-output* :accessor fac-maximum-output :documentation "Upper bound on # of results returned by FAC stage.") (fac-match-filter :type t :initarg :fac-match-filter :accessor fac-match-filter :documentation "Filter procedure used in all SME's in the FAC stage.") (fac-sme-type :type t :initarg :fac-sme-type :accessor fac-sme-type :documentation "Type of SME object to create for this retrieval.") ;; MAC stage (mac-results :type t :initform nil :accessor mac-results :documentation "Alist of ( . )") (mac-output-size :type t :initform 0 :accessor mac-output-size :documentation "Current size of MAC output") (mac-max-score :type t :initform 0.0 :accessor mac-max-score :documentation "Largest score found so far in MAC stage.") (mac-output :type t :initform nil :accessor mac-output :documentation "Subset of MAC results submitted to FAC") ;; FAC stage (fac-results :type t :initform nil :accessor fac-results :documentation "List of SME's whose base domains are memory items and whose target is the probe.") (fac-output-size :type t :initform 0 :accessor fac-output-size :documentation "Current size of FAC output") (fac-max-score :type t :initform 0.0 :accessor fac-max-score :documentation "Largest score found so far in FAC stage.") (fac-output :type t :initform nil :accessor fac-output :documentation "Subset of FAC results which are the retrieval output"))) (defun macfac (probe-term case-library-term source &optional (cases-to-ignore nil)) (let* ((case-library (get-case-library case-library-term source)) (probe (get-dgroup probe-term source)) (probe-cv (make-normalized-cv-from-dgroup probe source))) ;; Use the dgroup for the probe cv facts because we'll need to cons it up ;; anyway for the FAC stage, and some case construction methods are expensive. (let ((mac-results (calculate-mac probe-cv case-library cases-to-ignore))) (calculate-fac probe (mapcar #'(lambda (mac-output) (get-dgroup (cdr mac-output) source)) mac-results) source)))) ;;; MAC (defun calculate-mac (cv case-library cases-to-ignore) ;; Assume the content vector cache is up to date. (let ((results nil)) ;; For debugging, we're going back to the old "keep all intermediate results" ;; algorithm. We'll do the weave version later. (dolist (entry (get-case-library-cvectors case-library) (prune-mac-results results)) ;; Entries have the form ( . ) (unless (member (case-term entry) cases-to-ignore :test 'equal) (let ((mac-value (cv-dot-product cv entry))) (setq results (merge 'list (list (cons mac-value (case-term entry))) results '> :key 'car))))))) (defun prune-mac-results (results) (cond ((null results) nil) (t (cons (car results) (pruned-mac-results (cdr results) (* (- 1.0 *mac-selector-width*) (caar results)) 1))))) (defun pruned-mac-results (results threshold count) (cond ((null results) nil) ((< (caar results) threshold) nil) ((> count *mac-maximum-output*) nil) (t (cons (car results) (pruned-mac-results (cdr results) threshold (1+ count)))))) ;;; FAC (defun calculate-fac (probe cases source) (declare (ignore source)) ;; Passing in the source so that we can pass in the default type of SME ;; in the near future. (let ((results nil)) (dolist (case cases (prune-fac-results results)) (let ((sme (sme::define-sme case probe))) (sme::match sme) (when (sme::mapping? (car (sme::mappings sme))) ;; sometimes we come up dry (setq results (merge 'list (list (list (sme::score (car (sme::mappings sme))) case sme)) results '> :key 'car))))))) (defun prune-fac-results (results) (cond ((null results) nil) (t (cons (car results) (pruned-fac-results (cdr results) (* (- 1.0 *fac-selector-width*) (caar results)) 1))))) (defun pruned-fac-results (results threshold count) (cond ((null results) nil) ((< (caar results) threshold) nil) ((> count *fac-maximum-output*) nil) (t (cons (car results) (pruned-fac-results (cdr results) threshold (1+ count)))))) ;;;; --------------------------------------------------------------------------- ;;; END OF CODE