;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: build-carve-cases.lsp
;;;;    System: 
;;;;    Author: Praveen Paritosh
;;;;   Created: February 3, 2004 13:47:06
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Wednesday, February 11, 2004 at 14:16:04 by paritosh
;;;; ---------------------------------------------------------------------------

(in-package :fire)

;; Extracting facts from CYC KB to create explicit cases for countries for 
;; experimenting with Carve. 

;; To make this whole thing fast, we need to cache all the countries facts. 

;; get all african countries from the Cyc KB

(defun get-all-african-countries-from-cyc (&optional (kb *kb*))
  (let ((bindings (ask-it `(data::and (data::geographicalSubRegions data::ContinentOfAfrica ?c)
                                      (data::isa ?c data::Country)) 
                          :response :bindings :number :all)))
    (mapcar #'cdar bindings)))

;; Building Dgroups

(defun build-dgroup-for-country (country analogy-source)
  (let* ((facts (extract-facts-from-cyc-cache country))
         (dim-facts (extract-dimensional-facts country))
         (good-facts nil))
    (dolist (fact facts)
      (if (not (filter-fact? fact analogy-source :minimalQuantCaseFn))
        (push fact good-facts)))
    ;; Now lets go through the dimensional facts. Since SME wont 
    ;; recognize these, we have to define each explicit combination
    ;; so we can build the dgroups we want.
    (dolist (dim-fact dim-facts)
      (sc-update-add 'data::isa (list (third dim-fact) 'data::Collection) *kb*)
      (push dim-fact good-facts))
    (data::save-facts country good-facts "D:\\qrg\\fire\\v1\\carve\\data\\countrydata\\finaldgroupfacts.lsp")
    (format t "Building dgroup for ~A: ~A facts ~A dim facts ~A total facts~%" 
      country (length facts) (length dim-facts) (length good-facts))
    (make-dgroup-from-facts (symbol-name country) good-facts analogy-source)))

(defun extract-dimensional-facts (country &optional (wfb-dimensional-facts data::*wfb-dimensional-facts*))
  (let (dim-facts)
    (dolist (fact wfb-dimensional-facts)
      (if (eql (second fact) country)
        (push fact dim-facts)))
    dim-facts))
      
;; build all dgroups 

(defun build-dgroups-for-all-africa (analogy-source)
  (let (dgroups)
    (dolist (country cl-user::*wfb-africa-countries*)
      (push (build-dgroup-for-country country analogy-source) dgroups))
    dgroups))

;; Dump dgroup to disk

(defparameter *dgroup-directory* "D:\\QRG\\FIRE\\V1\\carve\\data\\CountryData\\Dgroups\\")

(defun dump-dgroup (dgroup directory)
  (let ((filename (format nil "~A~A.dgr" directory (sme::name dgroup))))
    (with-open-file (fout filename 
                          :direction :output
                          :if-exists :overwrite
                          :if-does-not-exist :create)
      (sme::sme-dumper dgroup fout))))
        
;; Filtering out bad facts 

(defmethod filter-fact? (fact source (filter-style (eql :minimalQuantCaseFn)))
  ;; For minimal case fun, you simply take every expression except
  ;;  for the ones with bookkeeping predicates
  (or (contains-bad-cyc-predicate? fact)
      (member (fact-predicate fact) *special-filter-predicates*)
      (book-keeping-fact? fact)
      ;; Heuristic: most facts that contain strings dont seem to be relevant
      (contains-string? fact)))

(defun contains-string? (fact)
  (cond ((null fact) nil)
        ((stringp fact) t)
        ((not (consp fact)) nil)
        (t (or (contains-string? (car fact))
               (contains-string? (cdr fact))))))



(defun extract-facts-from-cyc-cache (country &optional (all-facts data::*africa-cyc-facts*))
  (cadar (member country all-facts :key #'car)))



(defun save-case (casename facts file-name &optional (if-exists :append))
  "Dump case to a flat file to in a format amenable to re-loading"
  (with-open-file (fout file-name 
                        :direction :output
                        :if-exists if-exists
                        :if-does-not-exist :create)
    (princ (make-isa casename 'data::Case) fout)
    (terpri fout)
    (dolist (fact facts)
      (pprint `(data::ist-Information (data::ExplicitCaseFn ,casename) ,fact) fout))
    (terpri fout)
    (finish-output fout)))

;;; Here we try to convert from the clusters found on the quantitative dimensions
;;; to symbolic representations. 


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