;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                    -*-
;;;; ---------------------------------------------------------------------
;;;; File name: context-vector-debug.lsp
;;;;    System: FIRE
;;;;    Author: Praveen Paritosh
;;;;   Created: August 29, 2002 14:37:03
;;;;   Purpose: Temporary, Experimental ideas, debugging tools for context vectors
;;;; ---------------------------------------------------------------------
;;;;  Modified: Friday, September 20, 2002 at 16:26:37 by paritosh
;;;; ---------------------------------------------------------------------

(in-package :fire)

;; One way to invoke context vectors is to start with a list of symbols and
;; then build an assoc matrix such that any entry in the assoc matrix has 
;; the dot product for the symbols in the corresponding row/column. Assuming 
;; that we have done such a computation, this function tries to find the 
;; interesting parts of this matrix for us. 

(defparameter *min-normal-assoc-threshold* 0.5)
(defparameter *min-basic-assoc-threshold* 50)

(defun print-real-associations (symlist basic-assoc-matrix normalized-assoc-matrix)
  (let ((num (length symlist))
        (real-associations nil))
    (dotimes (i num)
      (let ((sym1 (nth i symlist))
            (associated-to-sym1 nil)
            (sorted-associated-to-sym1 nil))
        (dotimes (j num)
          (if (and (not (eql i j))
                   (> (aref normalized-assoc-matrix i j) *min-normal-assoc-threshold*))
            ;;(> (aref basic-assoc-matrix i j) *min-basic-assoc-threshold*))
            (push (list (nth j symlist) (aref normalized-assoc-matrix i j)) associated-to-sym1)))
        (if (not (null associated-to-sym1)) ;; we did find some good associations, Hurray!
          (setq sorted-associated-to-sym1 (sort associated-to-sym1 '> :key 'second))
          (push (cons sym1 sorted-associated-to-sym1) real-associations))))
    (values real-associations)))
              

;; Prints the retrieved-references, basic context vector and normalized context vectorsis to 
;; to the stream. The context vectors are printed as sorted alists (they are actually
;; hash-tables). 

(defun debug-context-vectors (sym &key (reasoner *reasoner*)
                                  (retrieve-refs-cache *retrieve-refs-cache*)
                                  (basic-context-vectors-cache *basic-context-vectors-cache*)
                                  (normalized-context-vectors-cache *normalized-context-vectors-cache*)
                                  (stream t))
  (multiple-value-bind (cxv present-p) (gethash sym basic-context-vectors-cache)
    (if (null present-p)
      (setq cxv (compute-and-cache-context-vector sym)))
    (format stream "Facts: ~%") 
    (pprint (retrieve-references-using-cache sym :kb (kb reasoner) :retrieve-refs-cache retrieve-refs-cache) stream)
    (format stream "~%~%Basic Context Vector:")
    (pprint (sort (hash-table->alist cxv) '> :key 'cdr) stream)
    (format stream "~%~%Normalized Context Vector:")
    (pprint (sort (hash-table->alist (gethash sym normalized-context-vectors-cache)) '> :key 'cdr) stream)))

;; Saves the information given by DEBUG-CONTEXT-VECTORS above for a list 
;; of symbols to file. Useful for debugging assoc matrices. 

(defun save-debug-context-vectors (symlist file &optional (comment ""))
  (with-open-file (filestr file :direction :output :if-exists :supersede)

    (format filestr comment)
    (dolist (sym symlist)
      (format filestr "~%~%****** ~A ***** ~%" sym)
      (debug-context-vectors sym :stream filestr))))


;; Since the normalized ot products dont really tell how big were the vectors to 
;; start with, there is a bias. Trying out some heuristic to discover the "real 
;; associations"
;;;(defparameter *min-magnitude-threshold-for-assoc* 100)
;;;(defun find-real-associations (symlist basic-assoc-matrix normalized-assoc-matrix)
;;;  (let ((num (length symlist))
;;;        (all-real-associations nil))
;;;    (dotimes (i num)
;;;      (if (> (aref basic-assoc-matrix i i) *min-magnitude-threshold-for-assoc*) ;; This concept is rich enough
;;;        (let ((real-associations nil))
;;;          (dotimes (j num)
;;;            (if (and (> (aref basic-assoc-matrix j j) *min-magnitude-threshold-for-assoc*) ;; This is also rich
;;;                     (> (aref basic-assoc-matrix i j) *min-magnitude-threshold-for-assoc*)) ;; The dot product also sensible
;;;              (let ((sym1 (nth i symlist))
;;;                    (sym2 (nth j symlist)))
;;;                (push (list sym2 (aref basic-assoc-matrix i j) (aref normalized-assoc-matrix i j)) real-associations)))
;;;            ****
;;;            ))))))