;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10 -*- ;;;; --------------------------------------------------------------------------- ;;;; File name: dt-cyc-loader.lsp ;;;; System: ;;;; Author: Jin Yan ;;;; Created: August 8, 2003 11:56:45 ;;;; Purpose: ;;;; --------------------------------------------------------------------------- ;;;; Modified: Thursday, January 15, 2004 at 10:48:26 by jinyan ;;;; --------------------------------------------------------------------------- (in-package :fire) (defparameter *current-dt* 'data::NaiveSteamDomainTheory "Domain theory into which facts will be loaded.") ;;; Forms used in defining domain theories ;; set-dt-name ;; defConstant ;; defUniversalFact ;; defEntity ;; defRelation ;; defPredicate ;; defUnit ;; defReifiableFunction ;; defQuantityFunction ;; ForAll ;; defEvalFn ;; defSuggestion (defun flat-file->kb (file-name &key (kb *kb*) (verbose? t) (dt *current-dt*) (legacy? nil) (primitive? nil) callback-fn (check-for-mt-type nil)) (declare (ignore check-for-mt-type)) ;; only used for cyc meld files (let ((*current-dt* dt) (eof? (cons file-name nil)) (data-package (find-package :data)) (count 0)) (with-open-file (fin file-name :direction :input) (do* ((form (trap-error (condition nil) (read-in-package fin nil eof? nil data-package)) (trap-error (condition nil) (read-in-package fin nil eof? nil data-package))) (translation (process-flat-file-form% form eof? :kb kb :verbose? verbose?) (process-flat-file-form% form eof? :kb kb :verbose? verbose?))) ((eq form eof?) count) (when callback-fn (funcall callback-fn form fin)) (if (and translation (listp translation) (every 'listp translation)) (dolist (assertion translation) (incf count) (if legacy? (setq assertion (sme->fire-expression assertion))) (if primitive? (setq assertion (attribute->isa-statement assertion))) (store-no-testing assertion kb) ;;; KDF: I removed this because we're going to do something fancier in dbex ;;; when we move to a context system. ;;; (store-no-testing ;;; (make-dt-membership *current-dt* assertion) kb) )))) ;; Clear genls cache for safety (reset-genls-cache kb) ;; Mark files as stale (mark-genls-cache-files-stale kb) :done)) (defun attribute->isa-statement (exp) (cond ((not (listp exp)) exp) ((= (length exp) 2) (make-isa (cadr exp) (car exp))) (t exp))) (defun flat-file->assertions (file-name &key (kb *kb*) (verbose? t) (legacy? nil)(primitive? nil)) (let ((*current-dt* *current-dt*) (data-package (find-package :data)) (eof? (cons file-name nil))) (with-open-file (fin file-name :direction :input :if-does-not-exist nil) (when fin (do* ((form (trap-error (condition nil) (read-in-package fin nil eof? nil data-package)) (trap-error (condition nil) (read-in-package fin nil eof? nil data-package))) (translation (process-flat-file-form% form eof? :kb kb :verbose? verbose?) (process-flat-file-form% form eof? :kb kb :verbose? verbose?)) (assertions nil)) ((eq form eof?) assertions) (when (and (listp translation) (every 'listp translation)) (when legacy? (setq assertions (mapcar #'(lambda (exp) (sme->fire-expression exp)) assertions))) (when primitive? (setq assertions (mapcar #'(lambda (exp) (attribute->isa-statement exp)) assertions))) (setq assertions (nconc assertions translation)))))))) (defun process-flat-file-form% (form eof-val &key (kb *kb*) (verbose? t)) "Wrapper for use with flat-file->kb and flat-file->assertions." (cond ((and (eq form eof-val) verbose?) (format t "~%Done loading ~A." (car eof-val)) nil) ((eq form eof-val) nil) (t (process-flat-file-form form :kb kb :verbose? verbose?)))) (defun process-flat-file-form (form &key (kb *kb*) (verbose? t)) (cond ((not (listp form)) (if verbose? (format t "~% Unknown form in flat file: ~A." form))) (t (case (car form) (data::set-dt-name ;; this should be lambda-bound above somewhere (setq *current-dt* (cadr form))) (data::defcmlconstant (defcmlconstant->cycl-assertions form kb)) (data::defuniversalfact (defuniversalfact->cycl-assertions form kb)) (data::defentity (defentity->cycl-assertions form kb)) (data::defrelation (defrelation->cycl-assertions form kb)) (data::defpredicate (defpredicate->cycl-assertions form kb)) (data::defunit (defunit->cycl-assertions form kb)) (data::defreifiablefunction (defreifiablefunction->cycl-assertions form kb)) (data::defquantityfunction (defquantityfunction->cycl-assertions form kb)) ((data::forall data::=>>) (list form)) (data::deffunction (deffunction->assertions form kb)) (data::defEvalFn (defEvalFn->assertions form kb)) (data::defmodelfragment (defmodelfragment->cycl-assertions form kb)) (data::defSuggestion (defSuggestion->assertions form kb)) ((data::in-package data::delete-item data::format) nil) (data::defobject (defobject->assertions form kb)) (data::defscenario (defscenario->assertions form kb)) ((data::defdescription sme::defdescription) (defdescription->assertions form kb)) (sme::defentity nil) (data::with-undefined-scenario-objects (process-flat-file-form (cadr form) :kb kb :verbose? verbose?)) (dte-db::add-pidgin-string (add-pidgin-string->assertions form)) (sme::defpredicate (sme-defpredicate->assertions form)) (t (when verbose? (format t "~%Unexpected form type: ~A::~A." (if (and (consp form) (symbolp (car form))) (symbol-package (car form)) "ERROR") (car form)) (pprint form)) nil))))) (defun substitute-for-self (thing form) (cond ((eq form :self) thing) ((not (consp form)) form) (t (cons (substitute-for-self thing (car form)) (substitute-for-self thing (cdr form)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defcmlconstant :documentation ) (defun defcmlconstant->cycl-assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (fact &key documentation) (cdr form) (let* ((constant (convert-to-cyc fact)) (assertions (list (make-in-dt (make-qp-constant constant))))) (push (make-case-fact *current-dt* form) assertions) ;; for explicit-case-fn ;;; (when documentation ;;; (push (make-comment-statement fact documentation) assertions)) assertions)))) ;;;8-10-03. Question: e.g., we have constant statement like: (defcmlconstant Liquid) ;;;Besides assert (isa Liquid Collection), we can't really add any more knowledge about this ;;;constant in our KB, e.g., (genls Liquid Phase). This is impossible to be done during the ;;; translation, it seems more dependent on Cycl's (or our KB's) default knowledge. ;;; (defuniversalfact :documentation ) (defun defuniversalfact->cycl-assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (fact &key documentation) (cdr form) (let ((assertions (list (make-in-dt (make-qp-univ fact))))) (push (make-case-fact *current-dt* form) assertions) ;;; (when documentation ;;; (push (make-comment-statement fact documentation) assertions)) assertions)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defobject :documentation ) ;;;(defun defobject->assertions (form &optional (kb *kb*)) ;;; (with-kb kb ;;; (destructuring-bind (individual &key documentation) (cdr form) ;;; (let ((assertions (list (make-individual individual)))) ;;; (when documentation ;;; (push (make-comment-statement individual documentation) assertions)) ;;; assertions)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defquantityfunction :documentation ) ;;; E.g.: ;;; (defquantityfunction estimated-unit-speed (?unit ?area) ;;; :documentation "quantification of estimates for unit speeds given ;;; terrain classes") (defun defquantityfunction->cycl-assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (qp-quantity-fn arglist &key documentation) (cdr form) (let* ((qp-quantity-fn (convert-to-cyc qp-quantity-fn)) (assertions (list (make-physical-quantity qp-quantity-fn) (make-attribute-declaration qp-quantity-fn) ;;returns -> (isa ,qp-quantity-fn Collection) (make-in-dt (make-qp-quantity qp-quantity-fn)) (make-arity (make-qp-quantity-fn qp-quantity-fn) (length arglist))))) (do ((x 0 (incf x))) ((eql x (length arglist))) (push (make-arg-isa (1+ x) (make-qp-quantity-fn qp-quantity-fn) (nth x arglist)) assertions)) (when documentation (push (make-comment-statement qp-quantity-fn documentation) assertions)) (push (make-case-fact *current-dt* form) assertions) assertions)))) ;;;((genls pressure PyhsicalQuantity) ;;; (inDomainTheory base-kb (qpQuantity pressure)) ;;; (arity (qpQuantityFn pressure) 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (deffunction := :axiom ;;; E.g.: ;;; (defFunction max-cruising-range (?car) ;;; := (* (max-fuel-level ?car) (gas-milage ?car))) ;;; (deffunction fastest-unrestricted-travel-to-location ;;; (?location ?set-of-movable-objects) ;;; :axiom (result-isa fastest-to-location modern-military-unit--deployable)) (defun deffunction->assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (predicate arglist &key = axiom) (cdr form) (let ((assertions (list (make-function-declaration predicate) (make-arity predicate (length arglist))))) (when = (push (make-function-expression (cons predicate arglist) =) assertions)) (when axiom (push axiom assertions)) assertions)))) (defun defEvalFn->assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (name &key args lispcode axioms documentation) (cdr form) (let* ((arity (get-arity-from-args args)) (arglist (get-arglist-from-args args)) (assertions nil)) ;; Add the mapping between the predicate and the lisp form to ;; the evalfn-table. Should this be done here? (add-to-evalfn-table *kb* name arity arglist lispcode) (push (make-eval-function-declaration name) assertions) (push (make-lisp-definition name (list arity arglist lispcode)) assertions) (push (make-comment-statement name documentation) assertions) (values (append assertions axioms)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defreifiablefunction ;;; :documentation :result-isa ;;; :arg-isas ) ;;; E.g.: ;;; (defreifiablefunction agent-case-fn (?agent) ;;; :result-isa case ;;; :documentation ;;; "Creates a Case by finding all the relations that reference ?agent, ;;; plus all relations between objects in that first set of relations. ;;; (Designed with ?agent being of type agent.)") (defun defreifiablefunction->assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (predicate arglist &key result-isa arg-isas documentation) (cdr form) (let ((assertions (list (make-function-declaration predicate) (make-arity predicate (length arglist))))) (when documentation (push (make-comment-statement predicate documentation) assertions)) (when result-isa (push (make-result-type predicate result-isa) assertions)) (when arg-isas (setq assertions (nconc (translate-defreifiablefunction-arg-isas predicate arg-isas) assertions))) assertions)))) (defun translate-defreifiablefunction-arg-isas (predicate arg-isas) (when (or arg-isas (not (listp arg-isas))) ;; Punt if not there (let ((index 1) (result nil)) (dolist (col arg-isas (nreverse result)) (push (list (intern (format nil "arg~DIsa" index) (find-package :data)) predicate col) result) (incf index))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defrelation ;;; :subclass-of ;;; :=> ;;; :function ;;; :n-ary? ;;; :documentation (defun defrelation->cycl-assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (predicate arglist &key subclass-of => function n-ary? documentation) (cdr form) (let* ((predicate (convert-to-cyc predicate t)) (assertions (list (make-in-dt (make-qp-relation predicate)) (make-pred predicate) (make-arity predicate (length arglist))))) (do ((x 0 (incf x))) ((eql x (length arglist))) (push (make-arg-isa (1+ x) predicate (nth x arglist)) assertions)) ;;; (if function ;;; (push (make-function-declaration predicate) assertions) ;;; (push (make-relation-declaration predicate) assertions)) (if n-ary? (push (make-n-ary predicate) assertions) (push (make-arity predicate (length arglist)) assertions)) (dolist (super subclass-of) (push (make-relation-subclass predicate (convert-to-cyc super t)) assertions)) (when => (push (make-relation-implies predicate (gizmo->fire =>)) assertions)) (when documentation (push (make-comment-statement (convert-to-cyc predicate 1) documentation) assertions)) (push (make-case-fact *current-dt* form) assertions) assertions)))) ;;;in QP: ;;;(defrelation can-contain-substance (?can ?sub ?ph) ;;; :=> (:and (quantity (tboil ?sub ?can)) ;;; (> (tboil ?sub ?can) 0))) ;;;in CYCL: ;;;(#$inDomainTheory #$NaiveSteamDomainTheory (#$qpRelation #$canContainSubstance)) ;;; ;;;(#$isa #$canContainSubstance #$Predicate) ;;;(#$arity #$canContainSubstance 3) ;;;(#$arg1Isa #$canContainSubstance #$Can) ;;;(#$arg2Isa #$canContainSubstance #$Substance) ;;;(#$arg3Isa #$canContainSubstance #$Phase) ;;; ;;;(#$qpRelationImplies #$canContainSubstance ;;; (#$and (#$isa ((#$QpQuantityFn #$TBoil) ?sub ?can) #$Quantity) ;;; (#$> ((#$QpQuantityFn #$TBoil) ?can ?sub) 0))) ;;; Test input: Be aware of the cases here. Quantity, Tboil. ;;;cl-user(48): (fire::defrelation->cycl-assertions ;;; '(defrelation can-contain-substance (?can ?sub ?ph) :=> ;;; (:and (Quantity (Tboil ?sub ?can)) (> (Tboil ?sub ?can) 0)))) ;;; Test Output: ;;;((qpRelationImplies can-contain-substance ;;; (and (genls ((qpQuantityFn Tboil) ?sub ?can) Quantity) ;;; (> ((qpQuantityFn Tboil) ?sub ?can) 0))) ;;; (arity can-contain-substance 3) ;;; (isa can-contain-substance Relation) ;;from function make-relation-declaration; do we need this? ;;; (arg3Isa can-contain-substance Phase) ;;; (arg2Isa can-contain-substance Substance) ;;; (arg1Isa can-contain-substance Can) ;;; (inDomainTheory base-kb (qpRelation can-contain-substance)) ;;; (isa can-contain-substance Predicate) ;;; (arity can-contain-substance 3)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defpredicate ;;; :n-ary? ;;; :commutative? ;;; :documentation ;;; :expression-type ) ;;; E.g.: ;;; (defpredicate perpendicular-corner ((line1 Line-Segment) ;;; (line2 Line-Segment)) ;;; relation :commutative? T ;;; :documentation "Line segments are both perpendicular to one another ;;; and form a corner.") (defun defpredicate->assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (predicate arglist pred-type &key n-ary? commutative? documentation expression-type) (cdr form) (let ((assertions nil) (arg-count 0)) (case pred-type (data::relation (push (make-relation-declaration predicate) assertions)) (data::function (push (make-function-declaration predicate) assertions) (when expression-type (push (make-result-type predicate expression-type) assertions))) (data::attribute (push (make-attribute-declaration predicate) assertions)) (t (format t "~%Unknown assertion type: ~A, ~A; ~A." pred-type predicate arglist))) (dolist (arg-entry arglist) (when (consp arg-entry) (push (make-arg-type predicate (second arg-entry) (incf arg-count)) assertions))) (if n-ary? (push (make-n-ary predicate) assertions) (push (make-arity predicate (length arglist)) assertions)) (when commutative? (push (make-commutative predicate) assertions)) (when documentation (push (make-comment-statement predicate documentation) assertions)) assertions)))) ;;;In QP: ;;;1.(defentity container ;;; :quantities ((bottom-height ;;; :type bottom-height) ;;; (top-height ;;; :type top-height)) ;;; :consequences ;;; ((> top-height bottom-height))) ;;;In Cycl: ;;;(#$inDomainTheory #$NaiveSteamDomainTheory (#$qpEntity #$Container)) ;;;(#$qpEntityQuantity #$Container #$BottomHeight) ;;;(#$qpEntityQuantityType #$Container #$BottomHeight (#$QpQuantityFn #$BottomHeight)) ;;;(#$qpEntityQuantity #$Container #$TopHeight) ;;;(#$qpEntityQuantityType #$Container #$TopHeight (#$QpQuantityFn #$TopHeight)) ;;;(#$qpEntityConsequence #$Container (#$> #$TopHeight #$BottomHeight)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defentity ;;; :subclass-of ;;; :consequences ;;; :quantities ;;; :documentation ;;;(defun defentity->cycl-assertions (form &optional (kb *kb*)) ;;; (with-kb kb ;;; (destructuring-bind (name &key subclass-of consequences ;;; quantities documentation) ;;; (cdr form) ;;; (let ((assertions (list (make-attribute-declaration name) ;;; (make-in-dt (make-qp-entity name))))) ;;; (dolist (super subclass-of) ;;; (push (make-entity-subclass name super) assertions)) ;;; ;;jy: maybe we could have one predicate: qpSubclass to represent the relationship ;;; ;;for both entities and MFs, instead of defining seperately as qpEntitySubclass ;;; ;;and qpMFSubclass. ;;; (when quantities ;;; (push (make-forAll '(data::?x) ;;; (make-implies ;;; (make-isa 'data::?x (convert-to-cyc name)) ;;; (if consequences ;;; (apply 'make-conjunction ;;; (append (gen-quantities-exps quantities) ;;; (convert-to-cyc (substitute-for-self 'data::?x consequences)))) ;;; (apply 'make-conjunction ;;; (gen-quantities-exps quantities))))) assertions)) ;;; (when documentation ;;; (push (make-comment-statement (convert-to-cyc name) documentation) assertions)) ;;; (push (make-case-fact *current-dt* form) assertions) ;;; assertions)))) (defun defentity->cycl-assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (name &key subclass-of consequences quantities documentation) (cdr form) (let* ((entity (convert-to-cyc name)) (assertions (list (make-attribute-declaration entity) (make-in-dt (make-qp-entity entity))))) (dolist (super subclass-of) (push (make-entity-subclass entity (convert-to-cyc super)) assertions)) ;;jy: maybe we could have one predicate: qpSubclass to represent the relationship ;;for both entities and MFs, instead of defining seperately as qpEntitySubclass ;;and qpMFSubclass. (when quantities (push (make-forAll '(data::?x) (make-implies (make-isa 'data::?x entity) (if consequences (apply 'make-conjunction (append (gen-quantities-exps quantities) (convert-to-cyc (substitute-for-self 'data::?x consequences)))) (apply 'make-conjunction (gen-quantities-exps quantities))))) assertions)) (when documentation (push (make-comment-statement entity documentation) assertions)) (push (make-case-fact *current-dt* form) assertions) assertions)))) (defun gen-quantities-exps (quantities) (mapcar #'(lambda (q) (make-isa (list (make-qp-quantity-fn (car q)) 'data::?x) 'data::Quantity)) quantities)) (defparameter *test-defentity* (->data `(defentity armored-unit--military-specialty :subclass-of (modern-military-unit--deployable) :quantities ((typical-unit-speed)) :consequences ((default-nvalue (typical-speed :self terrain-unrestricted) 24) (default-nvalue (typical-speed :self terrain-restricted) 16) (default-nvalue (typical-speed :self terrain-severely-restricted) 1)) :documentation "The collection of all military units that employ motorized vehicles engineered to resist penetration by explosives and projectile weapons. In modern armed forces, it usually entails the presence of tanks and heavy artillery."))) ;;; (add-pidgin-string ) ;;; E.g.: ;;; (dte-db:add-pidgin-string 'nvalue "the value of ?thing is ?value") (defun add-pidgin-string->assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (predicate template) (cdr form) (list (make-pidgin predicate template))))) ;;; (FORALL) ;;; Just pass these through. ;;; (=>>) ;;; Just pass these through as well. Forward chaining rules? ;;; (defunit :dimension ) ;;; E.g.: ;;; (defunit milliseconds-duration :dimension time-dimension) (defun defunit->assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (unit &key dimension) (cdr form) (let ((assertions (list (make-units unit)))) (when dimension (push (make-dimension unit dimension) assertions)) assertions)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (DEFMODELFRAGMENT :CONSEQUENCES :CONDITIONS :PARTICIPANTS :QUANTITIES :SUBCLASS-OF) ;;;(defun defmodelfragment->cycl-assertions (form &optional (kb *kb*)) ;;; (with-kb kb ;;; (let ((mf (cadr form)) ;;; (assertions (list (make-model-fragment mf) ;;; (make-attribute-declaration mf) ;;; (make-in-dt (make-qp-mf mf))))) ;;; (do* ((keys (cddr form) (cddr keys)) ;;; (key (car keys) (car keys)) ;;; (value (cadr keys) (cadr keys))) ;;; ((null keys) assertions) ;;; (case key ;;; (:subclass-of (dolist (super value) ;;; (push (make-mf-subclass mf super) assertions))) ;;; (:participants ;;; (setf assertions (append (gen-mf-participants-assertions mf value) assertions))) ;;; (:quantities ;;; (setf assertions (append (gen-mf-quantities-assertions mf value) assertions))) ;;; (:consequences ;;; (setf assertions (append (gen-mf-consequences-assertions mf value) assertions))) ;;; (:conditions (setf assertions (append (gen-mf-conditions-assertions mf value) assertions))) ;;; (:documentation (setf assertions (append (list (make-comment-statement (convert-to-cyc mf) value)) assertions))) ;;; (t (format t "~%Unknown keyword in defModelFragment: ~A in ~A." ;;; key mf)))) ;;; (push (make-case-fact *current-dt* form) assertions)))) (defun defmodelfragment->cycl-assertions (form &optional (kb *kb*)) (with-kb kb (let* ((mf (convert-to-cyc (cadr form))) (assertions (list (make-model-fragment mf) (make-attribute-declaration mf) (make-in-dt (make-qp-mf mf))))) (do* ((keys (cddr form) (cddr keys)) (key (car keys) (car keys)) (value (cadr keys) (cadr keys))) ((null keys) assertions) (case key (:subclass-of (dolist (super value) (push (make-mf-subclass mf super) assertions))) (:participants (setf assertions (append (gen-mf-participants-assertions mf value) assertions))) (:quantities (setf assertions (append (gen-mf-quantities-assertions mf value) assertions))) (:consequences (setf assertions (append (gen-mf-consequences-assertions mf value) assertions))) (:conditions (setf assertions (append (gen-mf-conditions-assertions mf value) assertions))) (:documentation (setf assertions (append (list (make-comment-statement mf value)) assertions))) (t (format t "~%Unknown keyword in defModelFragment: ~A in ~A." key mf)))) (push (make-case-fact *current-dt* form) assertions)))) ;;;(defun gen-mf-participants-assertions (mf value &aux assertions) ;;; (dolist (participant value) ;;; ;;; (do ((x (cdr participant) (cddr x)) ;;; ;;; (k (car x) (car x)) ;;; ;;; (v (cadr x) (cadr x))) ;;; ;;; ((null x))) ;;; (push (make-qp-mf-participant mf (car participant)) assertions) ;;; (push (make-qp-mf-participant-type mf (car participant) (caddr participant)) assertions) ;;; (when (> (length participant) 3) ;;; (dolist (constraint (car (last participant))) ;;; (push (make-qp-mf-participant-constraint mf (car participant) constraint) assertions)))) ;;; assertions) (defun gen-mf-participants-assertions (mf value &aux assertions) (dolist (participant value) ;;; (do ((x (cdr participant) (cddr x)) ;;; (k (car x) (car x)) ;;; (v (cadr x) (cadr x))) ;;; ((null x))) (let ((p (convert-to-cyc (car participant))) (p-type (convert-to-cyc (caddr participant)))) (push (make-qp-mf-participant mf p) assertions) (push (make-qp-mf-participant-type mf p p-type) assertions) (when (> (length participant) 3) (dolist (constraint (car (last participant))) (push (make-qp-mf-participant-constraint mf p (convert-to-cyc constraint)) assertions))))) assertions) ;;;(defun gen-mf-quantities-assertions (mf value &aux assertions) ;;; (dolist (quantity value) ;;; (destructuring-bind (name &key type arguments) quantity ;;; (push (make-qp-mf-quantity mf name) assertions) ;;; (when type ;;; (push (make-qp-mf-quantity-type mf name (make-qp-quantity-fn type)) assertions)) ;;; (push (make-qp-mf-quantity-arguments mf name arguments) assertions) ;;;;;; (dolist (argument arguments) ;;;;;; (push (make-qp-mf-quantity-argument mf name argument) assertions)) ;;;;;; (when (> (length quantity) 3) ;;;;;; (dolist (argument (car (last quantity))) ;;;;;; (push (make-qp-mf-quantity-argument mf (car quantity) argument) assertions)))) ;;; )) ;;; assertions) (defun gen-mf-quantities-assertions (mf value &aux assertions) (dolist (quantity value) (destructuring-bind (name &key type arguments) quantity (let ((quantity (convert-to-cyc name)) (q-type (convert-to-cyc type)) (q-arguments nil)) (push (make-qp-mf-quantity mf quantity) assertions) (when arguments (dolist (arg arguments) (push (convert-to-cyc arg) q-arguments)) (setf q-arguments (reverse q-arguments)) ;;cheesy way... (push (make-qp-mf-quantity-arguments mf quantity q-arguments) assertions)) (when type (push (make-qp-mf-quantity-type mf quantity (make-qp-quantity-fn q-type)) assertions))))) assertions) ;;;(defun gen-mf-consequences-assertions (mf value &aux assertions) ;;; (dolist (consequence (gizmo->fire value)) ;;; (push (make-qp-mf-consequence mf consequence) assertions)) ;;; assertions) (defun gen-mf-consequences-assertions (mf value &aux assertions) (dolist (consequence (gizmo->fire value)) (push (make-qp-mf-consequence mf (convert-to-cyc consequence)) assertions)) assertions) ;;;(defun gen-mf-conditions-assertions (mf value &aux assertions) ;;; (dolist (condition (gizmo->fire value)) ;;; (push (make-qp-mf-condition mf condition) assertions)) ;;; assertions) (defun gen-mf-conditions-assertions (mf value &aux assertions) (dolist (condition (gizmo->fire value)) (push (make-qp-mf-condition mf (convert-to-cyc condition)) assertions)) assertions) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; *** This is obsolete. Changed drastically. Add documentation here *** ;;; becomes the following two axioms in the KB. The first one tells when ;;; the suggestion is valid, and the second one is the content of ;;; the suggestion. ;;;`(implies ,test ;;; (suggestFor ,goal ;;; (try ,name ,goal))) ;;; If there is no test, then we just assert the consequent of the ;;; above statement. ;;; Note that (try ,name ,goal) is the op-instance and the goal in ;;; form here is bound to the specific problem that led to the ;;; instantiation of this operator. ;;; ;;; (ContentOfSuggestion (try ,name ,goal) ;;; ((subgoals ,subgoals) ;; all subgoals un-ordered-and ;;; (result-step ,result-step))) ;;; ;;;(defun defSuggestion->assertions (form &optional (kb *kb*)) ;;; (with-kb kb ;;; (destructuring-bind (name goal &key documentation test subgoals result-step) ;;; (cdr form) ;;; (let (assertions) ;;; (push (->data (make-suggestion-type name)) assertions) ;;; (push (->data (make-suggestion-comment-stmt name documentation)) assertions) ;;; (push (->data (make-suggest-for-axiom name goal test)) assertions) ;;; (push (->data (make-content-of-suggestion-axiom ;;; name goal subgoals result-step)) assertions) ;;; (values assertions))))) ;; Note the change from result-step to result-steps, and the new keyword ;; :answer-variables. ;;; (DEFSUGGESTION NAME GOAL :ANSWER-VARIABLES :TEST :SUBGOALS :RESULT-STEPS) (defun defSuggestion->assertions (form &optional (kb *kb*)) (with-kb kb (destructuring-bind (name goal &key documentation ordered? test answer-variables subgoals result-steps) ;; *** This is an advanced idea, will come back to this later. ;; Convert all the variables into keywords ala SubLKeywords in Cyc. ;; (keywordize-vars-in-form (cdr form)) (cdr form) ;; A suggestion has to have a name, goal, answer-variables, subgoals and result-steps. ;; If any of this is missing, we quit. The following are optional - documentation and test. (if (or (null name) (null goal) (null answer-variables) (null subgoals)) (return-from defSuggestion->assertions)) (let (assertions) (push (->data (make-suggestion-type name)) assertions) (push (->data (make-suggestion-order-stmt name ordered?)) assertions) (push (->data (make-suggest-for-axiom name goal test answer-variables)) assertions) (push (->data (make-suggestion-form name goal answer-variables)) assertions) (push (->data (make-suggestion-subgoals-stmt name subgoals)) assertions) (if (not (null result-steps)) (push (->data (make-suggestion-result-steps-stmt name result-steps)) assertions)) (if (not (null documentation)) (push (->data (make-suggestion-comment-stmt name documentation)) assertions)) ;; create an ist-Asserted SuggestionMT statement for each of the assertions ;; so we later can grab all suggestions in one go. (values (append (mapcar #'make-ist-suggestion-stmt assertions) assertions)))))) (defparameter *test-defsuggestion-popcorn* '(defSuggestion VolumeStrategyForCount (CounContained ?contained ?container ?count) :documentation "strategy for finding the count using volumes" :test (and (containsExpression ?criteria (physicallyContains ?container ?contained)) (hasAttributes ?container Volume) (hasAttributes ?contained Volume)) :answer-variables (?count) :subgoals ((volumeOfObject ?container ?vol-container) (volumeOfObject ?contained ?vol-contained)) :result-steps ((evaluate ?count (QuotientFn ?vol-container ?vol-contained))))) ;;; (DEFSCENARIO :INITIALLY :DOCUMENTATION :INDIVIDUALS :THROUGHOUT) (defun defscenario->assertions (form &optional (kb *kb*)) (with-kb kb (let* ((sc (cadr form)) (assertions (list (make-scenario sc)))) (do* ((keys (cddr form) (cddr keys)) (key (car keys) (car keys)) (value (cadr keys) (cadr keys))) ((null keys) assertions) (case key (:subclass-of (dolist (super value) (push (make-genls sc super) assertions))) (:initially (push (make-scenario-initially sc value) assertions)) (:throughout (push (make-scenario-throughout sc value) assertions)) (:individuals (push (make-scenario-individuals sc value) assertions)) (:documentation (push (make-comment-statement sc value) assertions)) (t (format t "~%Unknown keyword in defScenario: ~A in ~A." key sc))))))) ;;; (sme::defdescription . ) ;;; (sme::defdescription entities ;;; expressions ) ;;; where entries are either ;;; ;;; ( :name ) ;;; In the latter case, symbolic names can be used freely as shorthand in ;;; other expressions. (defun defdescription->assertions (form &optional (kb *kb*)) (with-kb kb (let* ((case-name (cadr form)) (contents (cddr form)) (keyword-format? (or (member 'data::entities contents) (member :entities contents))) (expressions (cond (keyword-format? (let ((exps (member 'data::expressions contents))) (cond (exps (cadr exps)) (t (setq exps (member :expressions contents)) (unless exps (error "No expressions in dgroup: ~A." form)) (cadr exps))))) (t contents)))) (when keyword-format? (setq expressions (sme::perform-dgroup-name-substitutions expressions))) (setq expressions (find-root-expressions expressions)) (cons (make-isa case-name 'data::Case) (mapcar #'(lambda (fact) (make-case-fact case-name fact)) expressions))))) (defun find-root-expressions (expressions) "Finds all top-level expressions in the set of expressions given." (remove-if #'(lambda (exp) (some #'(lambda (other) (and (not (equal exp other)) (subexpression-of exp other))) expressions)) expressions)) (defun subexpression-of (x y) (cond ((null y) nil) ((equal x y) t) ;; may need version that handles floats well from ltre or sme ((not (listp y)) nil) (t (or (subexpression-of x (car y)) (subexpression-of x (cdr y)))))) (defun sme-defpredicate->assertions (form) (let ((pred-name (cadr form)) (arglist (third form)) (type (fourth form)) (keywords (cddddr form)) (assertions nil)) (ecase type (data::attribute (push (make-attribute-declaration pred-name) assertions)) ((data::relation data::taxonomy) (push (make-relation-declaration pred-name) assertions)) (data::logical (push (make-connective-declaration pred-name) assertions)) (data::function (push (make-function-declaration pred-name) assertions))) (push (make-arity-assertion pred-name arglist keywords) assertions) (let ((commutative? (member :commutative? keywords))) (when (cadr commutative?) (push (make-commutative pred-name) assertions))) assertions)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Creating test KB for debugging (defparameter *test-kb-flat-files* (list (make-full-file-spec (make-qrg-path "FIRE" "flat-files") "base-theory" ".lsp") (make-full-file-spec (make-qrg-path "FIRE" "flat-files") "analogy-dt" ".lsp") (make-full-file-spec (make-qrg-path "FIRE" "flat-files") "countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "FIRE" "flat-files") "populations" ".lsp"))) (defparameter *test-dgroup-files* (nconc (list (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data") "sys2lang" ".vcb") (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data") "solar" ".dgr") (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data") "ruther" ".dgr") (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data") "swater" ".dgr") (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data") "sheat" ".dgr") ;;; (make-full-file-spec (make-qrg-path "FIRE" "flat-files" ;;; "MACFAC Test Data") ;;; "buying-person" ".dgr") ;;; (make-full-file-spec (make-qrg-path "FIRE" "flat-files" ;;; "MACFAC Test Data") ;;; "buying-robot" ".dgr") ;; MAC/FAC thermodynamics examples (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data" "Thermo") "cpad" ".vcb")) (directory (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data" "Thermo") "*" ".dgr")) ;; Is-like study examples (directory (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data" "islike") "*" ".dgr")) ;; syslit study examples (directory (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data" "syslit") "*" ".dgr")) (list (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data") "test-case-libraries" ".lsp")))) (defun make-bootstrap-kb () (make-kb *test-kb-path* *test-kb-name* :new? t :force-update? t :predicate-style :hyphen) (open-kb) (dolist (flat-file *test-kb-flat-files*) (format t "~%Loading ~A." flat-file) (flat-file->kb flat-file :legacy? t)) (dolist (case-file *test-dgroup-files*) (format t "~%Loading ~A." case-file) (flat-file->kb case-file :legacy? t))) (defun make-case-library-forms (library-name case-list) (format t "~%(defuniversalfact (case-library (case-library-fn ~S)))" library-name) (dolist (case case-list) (format t "~%(defuniversalfact (element-of (case-library-fn ~S) (explicit-case-fn ~S)))" library-name case))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Gathering information about KB flat files (defun gather-form-types-from-files (file-list) (let ((table nil) (end (cons nil nil))) (dolist (file file-list table) (with-open-file (fin file :direction :input) (do ((form (read fin nil end) (read fin nil end))) ((eq form end)) (when (listp form) (pushnew (car form) table))))))) (defparameter *dt-directories* (list (make-qrg-path "dte" "databases") (make-qrg-path "dte" "databases" "RKF") (make-qrg-path "dte" "databases" "coas") (make-qrg-path "dte" "databases" "coas" "COA Cases") (make-qrg-path "dte" "databases" "coas" "COA Critiques") (make-qrg-path "dte" "databases" "factbook") (make-qrg-path "dte" "databases" "tdc") (make-qrg-path "dte" "databases" "pidgen") (make-qrg-path "dte" "databases" "nuSketch") (make-qrg-path "dte" "databases" "gas-model") (make-qrg-path "dte" "databases" "factbook"))) ;;; (unless (find-package :dte-db) ;;; (make-package dte-db :use '("COMMON-LISP" "COMMON-LISP-USER"))) ;;; ;;; (defun dte-db::add-pidgin-string (&rest args) args) ;;; (export 'dte-db::add-pidgin-string (find-package 'cl-user)) ;;; Quick utility for generalizing paths (defun generalize-pathname-to-qrg (pathname) `(qrg::make-full-file-spec (qrg::make-qrg-path ,@ (cddr (pathname-directory pathname))) ,(pathname-name pathname) ,(pathname-type pathname))) ;;; (defparameter *dt-files* ;;; (list ;;; #p"D:\\qrg\\dte\\databases\\factbook\\cia_populations.lsp" ;;; #p"D:\\qrg\\dte\\databases\\factbook\\cia_countries_and_borders.lsp" ;;; #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-5.lsp" ;;; #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-4.lsp" ;;; #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-3.lsp" ;;; #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\gas-model\\constants.lsp" ;;; #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-icces-specific.lsp" ;;; #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-hpkb-specific.lsp" ;;; #p"D:\\qrg\\dte\\databases\\nuSketch\\ink-vocabulary.lsp" ;;; #p"D:\\qrg\\dte\\databases\\nuSketch\\debug-app-vocabulary.lsp" ;;; #p"D:\\qrg\\dte\\databases\\nuSketch\\debug-app-facts-vocabulary.lsp" ;;; #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-app-vocabulary.lsp" ;;; #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-app-facts-vocabulary.lsp" ;;; #p"D:\\qrg\\dte\\databases\\tdc\\TDC-defs-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\factbook\\cia_populations.lsp" ;;; #p"D:\\qrg\\dte\\databases\\factbook\\cia_countries_and_borders.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\coa-critique-rules.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-defs-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-cases-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\coa-force-ratio-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\coa-choke-points-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-7.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-6.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-5.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-4.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-3.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\previously-undefined.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-ubiq-preds.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-5-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-2-3.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-2-2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-2-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-1-3.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-1-2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-1-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-5.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-4.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-3.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-4.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-4-phased.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-3.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5-extra-facts.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5-1-extra-facts.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-4.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-4-extra-facts.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-3.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-3-extra-facts.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-2-extra-facts.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-1.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-1-extra-facts.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\previously-undefined-coa-preds-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\critique-defs-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\critique-cases-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\coa-ubiq-preds.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\coa-genl-cases.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\coa-force-ratio-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\coas\\coa-choke-points-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\RKF\\spider-oxygen-circulation-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\RKF\\recirculated-water-heating-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\RKF\\orig-forced-air-heating-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\RKF\\forced-air-heating-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\RKF\\fish-oxygen-circulation-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\qrg-pidgen.lsp" ;;; #p"D:\\qrg\\dte\\databases\\visual-figures.lsp" ;;; #p"D:\\qrg\\dte\\databases\\units.lsp" ;;; #p"D:\\qrg\\dte\\databases\\units-dt-x.lsp" ;;; #p"D:\\qrg\\dte\\databases\\military-movement-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\mil-units2-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\macros-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\hpkp-upper-v2.lsp" ;;; #p"D:\\qrg\\dte\\databases\\georep-rules-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\georep-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\geography-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\dtde-demo.lsp" ;;; #p"D:\\qrg\\dte\\databases\\DQ-analysis-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\dq-analysis-cyc-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\CYC-NEW-AXIOMS.LSP" ;;; #p"D:\\qrg\\dte\\databases\\control-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\cia_populations.lsp" ;;; #p"D:\\qrg\\dte\\databases\\cia_countries_and_borders.lsp" ;;; #p"D:\\qrg\\dte\\databases\\battlespace1-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\base-theory.lsp" ;;; #p"D:\\qrg\\dte\\databases\\analytical-factors-dt.lsp" ;;; #p"D:\\qrg\\dte\\databases\\analogy-dt.lsp"))" (defparameter *dt-files* (list (make-full-file-spec (make-qrg-path "dte" "databases") "base-theory" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "hpkp-upper-v2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "battlespace1-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "analytical-factors-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_populations" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "georep-rules-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "georep-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "geography-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "analogy-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "DQ-analysis-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "dq-analysis-cyc-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "CYC-NEW-AXIOMS" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "control-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "cia_populations" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "cia_countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-icces-specific" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-hpkb-specific" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "ink-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "debug-app-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "debug-app-facts-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-app-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-app-facts-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "tdc") "TDC-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_populations" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "visual-figures" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "units" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "units-dt-x" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "military-movement-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "mil-units2-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "macros-dt" ".lsp") ;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model") ;;; "natural-gas-5" ".lsp") ;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model") ;;; "natural-gas-4" ".lsp") ;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model") ;;; "natural-gas-3" ".lsp") ;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model") ;;; "natural-gas-2" ".lsp") ;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model") ;;; "natural-gas-1" ".lsp") ;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model") ;;; "constants" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-critique-rules" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-cases-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-force-ratio-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-choke-points-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-7" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-6" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "previously-undefined" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-ubiq-preds" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-5-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-2-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-2-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-2-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-1-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-1-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-1-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-4-phased" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5-1-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-4-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-3-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-2-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-1-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "previously-undefined-coa-preds-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-cases-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-ubiq-preds" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "coa-genl-cases" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "coa-force-ratio-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "coa-choke-points-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "spider-oxygen-circulation-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "recirculated-water-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "orig-forced-air-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "forced-air-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "fish-oxygen-circulation-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "qrg-pidgen" ".lsp") )) (defparameter *pruned-dt-files* (list (make-full-file-spec (make-qrg-path "dte" "databases") "base-theory" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "hpkp-upper-v2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "battlespace1-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "analytical-factors-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_populations" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "georep-rules-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "georep-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "geography-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "analogy-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "CYC-NEW-AXIOMS" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "control-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "cia_populations" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "cia_countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-icces-specific" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-hpkb-specific" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "ink-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "debug-app-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "debug-app-facts-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-app-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-app-facts-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "tdc") "TDC-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_populations" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "visual-figures" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "units" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "units-dt-x" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "military-movement-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "mil-units2-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "macros-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "gas-model") "natural-gas-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "gas-model") "constants" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-critique-rules" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-cases-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-force-ratio-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-choke-points-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-7" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-6" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "previously-undefined" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-ubiq-preds" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-5-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-2-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-2-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-2-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-1-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-1-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-4-1-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-3-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-4-phased" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-2-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-5-1-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-4" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-4-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-3" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-3-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-2-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-1" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-1-1-extra-facts" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "previously-undefined-coa-preds-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-cases-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Cases") "coa-ubiq-preds" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "coa-genl-cases" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "coa-force-ratio-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas") "coa-choke-points-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "spider-oxygen-circulation-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "recirculated-water-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "orig-forced-air-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "forced-air-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "fish-oxygen-circulation-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "qrg-pidgen" ".lsp") )) (defun gather-dt-files (directories) (mapcan #'(lambda (directory) (directory (concatenate 'string directory "*.lsp"))) directories)) (defun gather-keywords-from-files (file-list) (let ((table nil) (end (cons nil nil))) (dolist (file file-list table) (with-open-file (fin file :direction :input) (do ((form (trap-error (condition nil) (read fin nil end)) (trap-error (condition nil) (read fin nil end)))) ((eq form end)) (when (listp form) (let ((entry (assoc (car form) table))) (unless entry (push (setq entry (cons (car form) nil)) table)) (dolist (arg form) (when (keywordp arg) (pushnew arg (cdr entry))))))))))) ;; What is used in the DTE flat files: ;;; ((DEFMODELFRAGMENT :CONSEQUENCES :CONDITIONS :PARTICIPANTS) ;;; (DEFFUNCTION := :AXIOM) (DELETE-FACT) (=>>) (DEFUNIT :DIMENSION) ;;; (DEFSCENARIO :INITIALLY :DOCUMENTATION :INDIVIDUALS :THROUGHOUT) ;;; (DEFREIFIABLEFUNCTION :DOCUMENTATION :RESULT-ISA) ;;; (WITH-UNDEFINED-SCENARIO-OBJECTS) (ADD-PIDGIN-STRING) (FORALL) ;;; (CG:BEEP) (QUOTE) (NIL) (DEFRELATION :=> :FUNCTION :DOCUMENTATION) ;;; (DEFPREDICATE :N-ARY? :COMMUTATIVE? :DOCUMENTATION :EXPRESSION-TYPE) ;;; (FORMAT) (DELETE-ITEM) (DEFOBJECT) ;;; (DEFENTITY :CONSEQUENCES :QUANTITIES :DOCUMENTATION :SUBCLASS-OF) ;;; (IN-PACKAGE :COMMON-LISP-USER :CL-USER) ;;; (DEFUNIVERSALFACT :DOCUMENTATION) ;;; (DEFQUANTITYFUNCTION :DOCUMENTATION) (SET-DT-NAME)) (defparameter *test-dt-files* (list (make-full-file-spec (make-qrg-path "dte" "databases") "base-theory" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "hpkp-upper-v2" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "battlespace1-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "analytical-factors-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_populations" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "factbook") "cia_countries_and_borders" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-icces-specific" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-hpkb-specific" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "ink-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "debug-app-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "debug-app-facts-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-app-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch") "coa-app-facts-vocabulary" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "tdc") "TDC-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "visual-figures" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "units" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "units-dt-x" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "military-movement-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "mil-units2-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "gas-model") "natural-gas-5" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "gas-model") "constants" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "oil-model") "constants" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "oil-model") "eia-dt-7" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "oil-model") "production-consumption" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-critique-rules" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "critique-defs-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-force-ratio-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "coas" "COA Critiques") "coa-choke-points-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "spider-oxygen-circulation-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "recirculated-water-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "orig-forced-air-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "forced-air-heating-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases" "RKF") "fish-oxygen-circulation-dt" ".lsp") (make-full-file-spec (make-qrg-path "dte" "databases") "qrg-pidgen" ".lsp"))) (defun load-legacy-domain-theories (&key (kb *kb*) (files *test-dt-files*)) (dolist (file files) (load-domain-theory file :kb kb :legacy? t))) (defun load-domain-theory (file &key (kb *kb*) (legacy? nil)) (format t "~% Processing ~A..." file) (cond ((probe-file file) (format t "~% ~D assertions." (time (flat-file->kb file :kb kb :legacy? legacy?)))) (t (format t "~% Skipping ~A, not on this machine." file)))) ;;; Loading the integral dt, for playing with suggestions.. ;;;(defparameter *integral-dt* ;;; (make-full-file-spec (make-qrg-path "fire" "v1" "sarq" "integral") ;;; "integral-dt" ".lsp")) ;;;(defun load-integral-dt (&key (kb *kb*) ;;; (file *integral-dt*)) ;;; (load-domain-theory file :kb kb :legacy? nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; End of Code