;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: shakedown.lsp
;;;;    System: FIRE v1
;;;;    Author: Ken Forbus
;;;;   Created: February 9, 2004 09:46:18
;;;;   Purpose: Regression tests for FIRE
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Monday, February 9, 2004 at 10:28:33 by Kenneth Forbus
;;;; ---------------------------------------------------------------------------

(in-package :common-lisp-user)

;; This is a simple regression test that we should bulk up as needed.
;; (A "shakedown cruise" is what one takes on a ship to make sure everything is working.)

(defun shakedown-fire ()
  (let ((globally-okay? t) (okay? t))
    (format t "~%Opening KB...")
    (time (open-344-kb))
    (fire::structural-cache-stats)
    ;; ****** Need to implement some pure KB-level regression tests.
    ;; ****** Tricky, unless we do a small KB build from scratch.
    ;; ****** Maybe that's a seperate test.
    (format t "~%Creating reasoner for testing...")
    (time (make-344-reasoner))
    ;; ****** Any other reasoner tests?
    (setq okay? (time (evalfns-regression-test)))
    (cond (okay? (format t "~%No bugs with evaluation subsystem detected."))
          (t (setq globally-okay? nil)
             (format t "~%Evaluation subsystem failure.")))
    (format t "~%Testing analogical matching...")
    (setq okay? (time (test-analogy-reasoner)))
    (cond (okay? (format t "~%No analogical matching bugs detected."))
          (t (setq globally-okay? nil)
             (format t "~%Analogical matching failure.")))
    (format t "~%Testing similarity-based retrieval...")
    (setq okay? (time (quick-macfac-test)))
    (cond (okay? (format t "~%No similarity-based retrieval bugs detected."))
          (t (setq globally-okay? nil)
             (format t "~%Similarity-based retrieval bugs detected.")))
    (if globally-okay? (format t "~%No FIRE problems detected.")
      (format t "~%FIRE problems detected.  Please check your installation, KB, or code."))
    globally-okay?))

(defun evalfns-regression-test ()
  ;; Assumes reasoner is in place with standard evalfns
  ;; **** Add unit conversions once they are done from the KB
  (let ((okay? t)
        (answer nil))
    (setq answer (car (fire::ask-it '(evaluate ?x (PlusFn 4 5)))))
    (unless (and (numberp (cadr answer))
                 (= (cadr answer) 9))
      (warn "Addition error: ~A." answer)
      (setq okay? nil))
    (setq answer (car (fire::ask-it '(evaluate ?x (PlusFn 4 5 (TimesFn 4 5))))))
    (unless (and (numberp (cadr answer))
                 (= (cadr answer) 29))
      (warn "Compostion/Multiplication error: ~A, should be 29." answer)
      (setq okay? nil))
    (setq answer (car (fire::ask-it
                       '(evaluate ?x (PlusFn 4 5 (TimesFn 4 5) 30 
                                             (LengthOfListFn (TheList Foo Bar Baz)))))))
    (unless (and (numberp (cadr answer))
                 (= (cadr answer) 62))
      (warn "List length error: ~A, should be 62." answer)
      (setq okay? nil))
    (setq answer (car (fire::ask-it
                       '(evaluate ?x (ListFn
                                      (SublistFromToFn (TheList a b c d e f) 2 4)
                                      (PlusFn 100 200))))))
    (unless (equal (cadr answer) '(TheList (TheList b c d) 300))
      (warn "List construction error: ~A, should be (TheList (b c d) 300)." answer)
      (setq okay? nil))
    (setq answer (car (fire::ask-it '(evaluate ?x 
                                               (SublistFromToFn (TheList a b c d e f) 2 4)))))
    (unless (equal (cadr answer) '(TheList b c d))
      (warn "List extraction error: ~A, should be (TheList b c d)." answer))
    okay?))
    
    
    


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