;;;; File name: mt-tests.lsp
;;;;  Modified: Thursday, February 26, 2004 at 18:45:37 by forbus

;;;; Unit testing for microtheory-related FIRE code.

(in-package :cl-user)

;;;Notes on genlMt data in QRG-GENERAL, as of 2/26/04.
;;;
;;;17,975 genlMt statements.
;;;4,669 of them (genlMt ?x BaseKb)
;;; But 4,694 Mts, including BaseKB.
;;; 24 non-ground.

(defun list-microtheories-in-kb ()
  (let ((mts nil))
    (dolist (form (fire::retrieve '(genlMt ?x ?y)) mts)
      (pushnew (cadr form) mts :test 'equal)
      (pushnew (third form) mts :test 'equal))))

(defun tabulate-allgenlmts-in-kb ()
  (let ((table nil))
    (dolist (form (fire::retrieve '(genlMt ?x ?y)) table)
      ;; Entries in table have the form: 
      ;; (<mt> <genls> <subs> <allgenls>)
      (let* ((sub (cadr form))
             (super (third form))
             (sub-entry (assoc sub table :test 'equal))
             (super-entry (assoc super table :test 'equal)))
        (unless sub-entry
          (push (setq sub-entry (list sub nil nil nil))
                table))
        (unless super-entry
          (push (setq super-entry (list super nil nil nil))
                table))
        (pushnew sub (third super-entry) :test 'equal)
        (pushnew super (cadr sub-entry) :test 'equal)))
    (compute-allgenlmts-in-table table)))

(defun compute-allgenlmts-in-table (table)
  ;; Table entries = (<Mt> <genlMts> <subMts> <allGenlMts>)
  ;; We're going to assume that it's not very deep, and just propagate
  ;; downward from each Mt that has a sub, recursively.
  (dolist (entry table table)
    (format t "~% Propagating from ~A: ~A." (car entry) (third entry))
    (propagate-allgenlmts-through-table entry table)))

(defun propagate-allgenlmts-through-table (entry table)
  ;; entry = (<mt> <genlMts> <subMts> <allGenlMts>)
  (let ((current (car entry)))
    (do ((queue (copy-list (third entry)) (append (cdr queue) new))
         (new nil nil))
        ((null queue))
      (let* ((sub (car queue))
             (sub-entry (assoc sub table :test 'equal)))
        (when sub-entry ;; Probably should whine if not
          (cond ((member current (fourth sub-entry) :test 'equal))
                ;; Do nothing, was here before.  But otherwise,
                (t (pushnew current (fourth sub-entry) :test 'equal)
                   (dolist (second-down (third sub-entry))
                     (unless (or (member second-down queue :test 'equal)
                                 (member second-down new :test 'equal))
                       (push second-down new))))))))))

(defun dump-mt-table-stats (table file-name)
  ;; Designed for spreadsheet input
  (with-open-file (fout file-name
                        :direction :output
                        :if-exists :supersede)
    (format fout "Microtheory,#genlMts,#subMts,#allGenlMts,BaseKB?")
    (dolist (entry table)
      (format fout "~%~S,~D,~D,~D,~A"
        (car entry) ;; Collection itself
        (length (cadr entry)) ;; Number of direct genls
        (length (third entry)) ;; Number of subs
        (length (fourth entry)) ;; Number of genlMts
        (if (member 'BaseKB (fourth entry)) 1 0)))))