;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: case-graphs.lsp
;;;;    System: Case Viewer
;;;;    Author: Shawn Nicholson
;;;;   Created: May 14, 2003 20:15:36
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Wednesday, May 28, 2003 at 14:45:57 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :zgraph-case-display)


(defclass attribute-edge (zgraph:edge)
  ())

(defclass relation-edge (zgraph:edge)
  ())

(defclass function-edge (zgraph:edge)
  ())



(defclass collection-vertex (zgraph:vertex)
  ())

(defclass entity-vertex (zgraph:vertex)
  ())


(defun build-case-graph (case-name &optional (reasoner fire:*reasoner*))
  ;; Note- These graphs need to be able to support n-ary relations
  ;;   which means special types of edges. 
  (flet ((make-relation-edge (relation origin terminus vertices edge-type
                                       &key (edge-style :solid))
                             (let ((label (sme::predicate-exp relation))
                                   (start (find origin vertices :key #'zgraph:element-data))
                                   (end (find terminus vertices :key #'zgraph:element-data)))
                               (zgraph:make-edge :edge-type edge-type
                                                 :element-label (zgraph::ensure-string label)
                                                 :element-data relation
                                                 :directed-edge? t
                                                 :edge-style edge-style
                                                 :edge-origin start
                                                 :edge-terminus end)))
         (get-isa-entity (isa-expr) (second isa-expr))
         (get-isa-collection (isa-expr) 
                             (if (fire:isa-statement? isa-expr)
                               (third isa-expr)
                               (first isa-expr))))
    (let* ((vertices-list (fire::case-individuals case-name :reasoner reasoner))
           (vertices (mapcar #'(lambda (vert)
                                 (zgraph:make-vertex :vertex-type 'entity-vertex
                                                     :element-label (zgraph::ensure-string vert)
                                                     :element-data vert))
                       vertices-list))
           (exprs (fire::case-expressions case-name :reasoner reasoner))
           (edges nil)
           (graph-name (format nil "Graphical Representation of the case: ~A" case-name)))
      (dolist (expr exprs)
        (let ((pred-type (fire:predicate-type (sme::predicate-exp expr))))
          (when (fire:isa-statement? expr) (setf pred-type :attribute))
          (case pred-type
            (:attribute
             (let ((ent (get-isa-entity expr))
                   (coll (get-isa-collection expr)))
               (pushnew (zgraph:make-vertex :vertex-type 'collection-vertex
                                            :element-label (zgraph::ensure-string coll)
                                            :element-data coll)
                        vertices
                        :key 'zgraph:element-data)
               (push (make-relation-edge expr ent coll vertices 'attribute-edge
                                         :edge-style :dash)
                     edges)))
            (:relation
             ;; here is where we will eventually need to handle more than binary 
             ;;  relations
             (let ((ent1 (second expr))
                   (ent2 (third expr)))
               (push (make-relation-edge expr ent1 ent2 vertices 'relation-edge)
                     edges)))
            (:function
             ;; ignore functions for now...
             ))))
      (zgraph:make-graph :element-label graph-name
                         :initial-vertices vertices
                         :initial-edges edges
                         :description graph-name))))


;;;;;;;;;;;;;;;;;
;; Testing
;;;;;;;;;;;;;;;;;

(defun test-case-graph (&key (case-name 'Motorcycle-Simple)
                             (kb-name "qrg-darpa")
                             (kb-path "d:\\qrg\\knowledge tools\\case-mapper\\v3\\kbs\\qrg-darpa-6.2\\"))
  (unless fire:*kb*
    (fire::open-or-create-kb :kb-name kb-name :kb-path kb-path))
  (let ((casename (fire::ensure-tagged case-name)))
    (unless (fire::case-loaded-in-WM? casename :reasoner fire:*reasoner*)
      (fire::load-case-from-KB casename :reasoner fire:*reasoner*))
    (build-case-graph casename)))
                                  
                                  
;; add a special filters list which takes a label and a function to call
;;  and have that show up in a right click menu on the graph
;; In this case I want to be able to show/hide the Isa links or the relation 
;;  links


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