;;;;  Modified: Monday, February 9, 2004 at 17:17:40 by usher
;;;; File name: debug.lsp

;;; Various utilities for debugging


(in-package :fire)

;;; KB statistics

(eval-when (:compile-toplevel :load-toplevel :evaluate)
  (proclaim '(special *isas* *by-cadr* *by-third*)))

(defun isa-stats (&optional (stream *standard-output*))
  (let ((isas (retrieve-all '(data::isa ?x ?y) :coverage :ground))
        (by-cadr nil)
        (by-third nil))
    (format stream "~% ~D isas." (length isas))
    (dolist (s isas)
      (let ((entry (assoc (cadr s) by-cadr :test 'equal)))
        (unless entry (setq entry (cons (cadr s) nil))
          (push entry by-cadr))
        (push s (cdr entry)))
      (let ((entry (assoc (third s) by-third :test 'equal)))
        (unless entry (setq entry (cons (third s) nil))
          (push entry by-third))
        (push s (cdr entry))))
    (setq *isas* isas
        *by-cadr* by-cadr
        *by-third* by-third)
    (multiple-value-bind (min max average)
        (compute-alist-stats by-cadr)
      (format stream "~% Entities have ~D isas on average (~D min, ~D max)."
        average min max)
      (multiple-value-bind (min max average)
          (compute-alist-stats by-third)
              (format stream "~% Collections have ~D isas on average (~D min, ~D max)."
                average min max)))))

(defun compute-alist-stats (alist)
  (let ((min nil)
        (max nil)
        (sum 0.0)
        (count 0))
    (dolist (entry alist (values min max (/ sum count) count))
      (incf count)
      (let ((this (length (cdr entry))))
        (incf sum this)
        (if (numberp min)
          (if (< this min) (setq min this))
          (setq min this))
        (if (numberp max)
          (if (> this max) (setq max this))
          (setq max this))))))

(defun sort-alist-by-max (alist)
  (let ((new-alist (mapcar #'(lambda (entry) 
                               (cons (car entry)
                                     (cons (length (cdr entry))
                                           (cdr entry))))
                     alist)))
    (sort new-alist '> :key 'cadr)))

(defun try-isa-retrieves (n)
  (let ((count 0))
    (dolist (entry *by-cadr*) 
      (retrieve-isas (car entry))
      (incf count)
      (when (> count n) (return-from try-isa-retrieves (values))))))


(defun verify-kb-flatfiles-integrity ()
  ;; Relies on global list constructed by kb tools builder
  (let ((file-count 0)
        (form-count 0))
    (dolist (file-entry (qrg:runtime-call "list-kb-flat-files" :cl-user)
                        (values file-count form-count))
      (let ((file (car file-entry)))
        (incf file-count)
        (multiple-value-bind (okay? last-form count)
            (verify-flatfile-integrity file)
          (cond (okay? (incf form-count count))
                (t (format t "~%Error in ~A: ~%  ~D forms in, last = ~% ~A."
                     file count last-form)
                   (incf form-count count))))))))
          
(defun verify-flatfile-integrity (flat-file)
  (let ((unique (cons nil nil))
        (last-form nil)
        (counter 0))
    (handler-bind ((error #'(lambda (condition)
                              (declare (ignore condition))
                              (return-from verify-flatfile-integrity
                                (values nil last-form counter)))))
    (with-open-file (fin flat-file :direction :input)
      (do ((form (read fin nil unique) (read fin nil unique)))
          ((eq form unique) (values t last-form counter))
        (incf counter)
        (setq last-form form))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code