;; DIG: Description Logic Interface
;; some of the dig queries that can't currently be done in sparql
;; descendants, ancestors, parents, children, instances, types
;; following code in DIGAskHandler.java, and DIGHandler.java

;; But, class expressions are given in the lisp abstract syntax for owl

;; DIG spec http://dl-web.man.ac.uk/dig/2003/02/interface.pdf

;; TODO hasvalue

;; e.g. (descendants (restriction !go:go_isa (some-values-from !go:GO_0000060)))

(defun descendants (expression &optional (kb *default-kb*))
  (process-dig-query-results (#"getSubClasses" (kb-kb kb) (to-concept expression kb) nil)))

(defun equivalents (expression &optional (kb *default-kb*))
  (process-dig-query-results 
   (#"getAllEquivalentClasses" (kb-kb kb) (to-concept expression kb) ) 
   nil))

(defun sames (individual &optional (kb *default-kb*))
  (process-dig-query-results 
   (#"getSames" (kb-kb kb) (to-concept individual kb) ) 
   nil))

(defun same-properties (property &optional (kb *default-kb*))
  (process-dig-query-results 
   (#"getEquivalentProperties" (kb-kb kb) (get-entity property kb))
   nil))

(defun subclasses  (expression &optional (kb *default-kb*))
  (union (descendants expression kb) (equivalents expression kb)))

(defun children (expression &optional (kb *default-kb*))
  (process-dig-query-results (#"getSubClasses" (kb-kb kb) (to-concept expression kb) t)))

(defun ancestors (expression &optional (kb *default-kb*))
  (process-dig-query-results (#"getSuperClasses" (kb-kb kb) (to-concept expression kb) nil)))

(defun parents (expression &optional (kb *default-kb*))
  (process-dig-query-results (#"getSuperClasses" (kb-kb kb) (to-concept expression kb) t)))

(defun instances (expression  &optional (kb *default-kb*))
  (process-dig-query-results (#"getInstances" (kb-kb kb) (to-concept expression kb)) :instance))

(defun direct-instances (expression  &optional (kb *default-kb*))
  (set-difference
   (process-dig-query-results (#"getInstances" (kb-kb kb) (to-concept expression kb)) :instance)
   (apply 'append (mapcar (lambda(c) (instances c kb)) (children expression kb)))))

(defun all-types (expression  &optional (kb *default-kb*))
  (process-dig-query-results (#"getTypes" (kb-kb kb) (to-concept expression kb) nil) ))

(defun direct-types (expression  &optional (kb *default-kb*))
  (process-dig-query-results (#"getTypes" (kb-kb kb) (to-concept expression kb) t) ))

(defun to-concept (expression kb)
  (labels 
      ((aterm-list (elements)
	 (loop for el in elements 
	    with list = (get-java-field 'ATermUtils "EMPTY_LIST")
	    do (setq list (#0"append" list  el))
	    finally (return list)))
       (to-concept-1 (expression)
	 (cond ((java-object-p expression) expression)
	       ((uri-p expression)
		(let ((name (uri-full expression)))
		  (if (search "urn:blank:" name)
		      (or (ignore-errors (get-entity name kb))
			  (get-entity (#"replaceAll" name "urn:blank:" "bNode") kb)
			  )
		      (get-entity name kb))))
	       ((eq (car expression) :intersection-of)
		(#"makeAnd" 'ATermUtils (aterm-list (mapcar #'to-concept-1 (rest expression)))))
	       ((eq (car expression) :union-of)
		(#"makeOr" 'ATermUtils (aterm-list (mapcar #'to-concept-1 (rest expression)))))
	       ((eq (car expression) :complement-of)
		(assert (null (cddr expression)) () "Not takes only one arg: ~a" expression)
		(#"makeNot" 'ATermUtils (to-concept-1 (second expression))))
	       ((and (eq (car expression) :restriction)
		     (eq (car (third expression)) :min-cardinality))
		(#"makeMin" 'ATermUtils (to-concept-1 (second expression)) (second (third expression))))
	       ((and (eq (car expression) :restriction)
		     (eq (car (third expression)) :max-cardinality))
		(#"makeMax" 'ATermUtils (to-concept-1 (second expression)) (second (third expression))))
	       ((and (eq (car expression) :restriction)
		     (eq (car (third expression)) :cardinality))
		(to-concept-1 (intersection-of (restriction (second expression)
							    (max-cardinality (second (third expression))))
					       (restriction (second expression)
							    (min-cardinality (second (third expression)))))))
	       ((and (eq (car expression) :restriction)
		     (eq (car (third expression)) :some-values-from))
		(#"makeSomeValues" 'ATermUtils (to-concept-1 (second expression)) 
				   (to-concept-1 (second (third expression)))))
	       ((and (eq (car expression) :restriction)
		     (eq (car (third expression)) :all-values-from))
		(#"makeAllValues" 'ATermUtils (to-concept-1 (second expression)) 
				  (to-concept-1 (second (third expression)))))
	       ((and (eq (car expression) :restriction)
		     (eq (car (third expression)) :value))
		(let ((value (second (third expression))))
		  (if (and (consp value) (eq (car value) :literal))
		      (#"makeHasValue" 'ATermUtils (to-concept-1 (second expression)) 
				       (if (consp value)
					   (#"makeTypedLiteral" 'ATermUtils 
								(princ-to-string (second value))
								(uri-full (third value)))
					   (#"makePlainLiteral" 'ATermUtils (princ-to-string (second value)))))
		      (#"makeHasValue" 'ATermUtils (to-concept-1 (second expression))  (to-concept-1 value)))))
	       ((eq (car expression) :one-of)
		(#"makeOr"
		 'ATermUtils 
		 (aterm-list
		  (loop for el in (cdr expression)
		     collect (#"makeValue" 'ATermUtils (get-entity el kb))))))
	       (t (let ((*print-circle* nil)) (print-db expression))
		  (break))
	       
	       )))
    (to-concept-1  expression)))


(defun satisfiable-concept? (expression &optional (kb *default-kb*))
  (#"isSatisfiable" (kb-kb kb) (to-concept expression kb)))

(defun subsumes? (super sub &optional (kb *default-kb*))
  (#"isSubClassOf" (kb-kb kb) (to-concept sub kb) (to-concept super kb)))

;; (defun domain-expression (property kb)
;;   (let ((raw-domain (#"getDomain" (#"getRole" (#"getRBox" (kb-kb kb)) (get-entity property kb)))))
;;     (if raw-domain
;; 	(aterm-sexp-to-class-expression
;; 	 (aterm-to-sexp
;; 	  (#"nnf" 'ATermUtils raw-domain)))
;; 	!owl:Thing)))

;; (defun range-expression (property kb)
;;   (let ((raw-range (#"getRange" (#"getRole" (#"getRBox" (kb-kb kb)) (get-entity property kb)))))
;;     (if raw-range
;; 	(aterm-sexp-to-class-expression
;; 	 (aterm-to-sexp
;; 	  (#"nnf" 'ATermUtils raw-range)))
;; 	!owl:Thing)))


(defun get-pellet-domains (property kb)
  (if (> (pellet-major-version) 1)
      (set-to-list (#"getDomains" (#"getRole" (#"getRBox" (kb-kb kb)) (get-entity property kb))))
      (let ((it (#"getDomain" (#"getRole" (#"getRBox" (kb-kb kb)) (get-entity property kb)))))
	(and it (list it)))))

(defun get-pellet-ranges (property kb)
  (if (> (pellet-major-version) 1)
      (set-to-list (#"getRanges" (#"getRole" (#"getRBox" (kb-kb kb)) (get-entity property kb))))
      (let ((it (#"getRange" (#"getRole" (#"getRBox" (kb-kb kb)) (get-entity property kb)))))
	(and it (list it)))))
  
(defun class-in-domain-of (class property kb)
  (let ((domains (get-pellet-domains property kb)))
    (if (null domains)
	t
	(some (lambda(e) (subsumes? e class kb)) domains))))

(defun class-subsumes-domain-of (class property kb)
  (let ((domains (get-pellet-domains property kb)))
    (if (null domains)
	t
	(some (lambda(e) (subsumes? class e kb)) domains))))

(defun class-might-be-in-domain-of (class property kb)
  (let ((domains (get-pellet-domains property kb)))
    (if (null domains)
	t
	(some (lambda(e) (satisfiable-concept? (intersection-of e class) kb)) domains)
	)))

(defun class-in-range-of (class property kb)
  (let ((ranges (get-pellet-ranges property kb)))
    (if (null ranges)
	t
	(some (lambda(e) (subsumes? e class kb)) ranges))))

(defun class-subsumes-range-of (class property kb)
  (let ((ranges (get-pellet-ranges property kb)))
    (if (null ranges)
	t
	(some (lambda(e) (subsumes? class e kb)) ranges))))

(defun class-might-be-in-range-of (class property kb)
  (let ((ranges (get-pellet-ranges property kb)))
    (if (null ranges)
	t
	(some (lambda(e) (satisfiable-concept? (intersection-of class e) kb)) ranges))))

;; (defun class-in-range-of (class property kb)
;;   (multiple-value-bind (aterm type) (get-entity property kb)
;;     (if (eq  type :datatype-property)
;; 	(equal (eval (range-expression property kb)) class) 
;; 	(subsumes? (eval (range-expression property kb)) class kb))))

(defun process-dig-query-results (jresult &optional (result-type :multi))
  (mapcar (lambda(u)
	    (make-uri (#"replaceAll" u "^bNode" *blankprefix*)))
	  (set-difference 
	   (mapcar (lambda(s) (#"toString" s))
		   (if (eq result-type :multi)
		       (mapcan 'set-to-list 
			   (set-to-list jresult))
		       (set-to-list jresult)))
	   '("not(_TOP_)" "_TOP_") :test 'equal)))

(defparameter *noise-properties* 
  (list !protegeowl:FROM !protegeowl:SLOT-CONSTRAINTS !protegeowl:TO !protegeowl:PAL-NAME !protegeowl:PAL-STATEMENT !protegeowl:PAL-DESCRIPTION !protegeowl:PAL-RANGE))

(defun properties-that-can-have-as-subject (class kb)
  (loop for prop in (set-difference (append (all-datatype-properties kb) (all-object-properties kb))
				    *noise-properties*)
     if (class-in-domain-of class prop kb) collect prop into yes
     else if (class-subsumes-domain-of class prop kb) collect prop into super
     else if (class-might-be-in-domain-of class  prop kb) collect prop into maybe
     finally (return (values yes super maybe))))

(defun properties-that-can-have-as-object (class kb)
  (loop for prop in (set-difference (all-object-properties kb) *noise-properties*)
     if (class-in-range-of class prop kb) collect prop into yes
     else if (class-subsumes-range-of class prop kb) collect prop into super
     else if (class-might-be-in-range-of class  prop kb) collect prop into maybe
     finally (return (values yes super maybe))))
       

(defun classdef (class &optional (kb *default-kb*))
  (let ((*uri-name-is-uri-hack* t))
    (coalesce-disjoints (pretty-aterm-sexp
			 (mapcar 
			  'aterm-to-sexp
			  (setq axioms 
				(set-to-list 
				 (#"getAxioms" (#"getTBox" (kb-kb kb)) (get-entity class kb)))))))))

(defun get-terms-referenced-by-class (class kb)
  (labels ((just-terms (expr)
	     (cond ((uri-p expr)
		    (list expr))
		   ((consp expr)
		    (apply 'append (mapcar #'just-terms expr)))
		   (t nil))))
    (just-terms
     (mapcar 'aterm-to-sexp
	     (set-to-list 
	      (#"getAxioms" (#"getTBox" (kb-kb kb)) (get-entity class kb)))))))


;; (#"getSubClasses" (kb-kb (kb existential-hierarchy)) 
;; 		  (to-concept (eval-uri-reader-macro '(some !go:go_isa !go:GO_0000060)) (kb existential-hierarchy)) t)

;; 	((eq (car expression) 'oneof)
;; 	 (#"makeOr" 'ATermUtils (mapcar (lambda(a) (to-concept (#"makeValue"
	 
;; 	for(int i = nodes.getLength() - 1; i >= 0; i--) {
;;                 Element node = nodes.item( i );
                
;;                 list = list.append( ATermUtils.makeValue( individual( node ) ) );
;;             }
            
;;             term = ATermUtils.makeOr( list );


;;     public ATermAppl concept( Element c ) {
;;         String type = getTagName( c );
        
;;         ATermAppl term = null;
;;         if( type.equals( DIGConstants.TOP ) ) {
;;             term = ATermUtils.TOP;
;;         }
;;         else if( type.equals( DIGConstants.BOTTOM ) ) {
;;             term = ATermUtils.BOTTOM;
;;         }
;;         else if( type.equals( DIGConstants.CATOM ) ) {
;;             term = getNameTerm( c );
;;         }
;;         else if( type.equals( DIGConstants.AND ) ) {
;;             ElementList nodes = getElements( c );

;;             ATermList list = ATermUtils.EMPTY_LIST;
;;             for(int i = nodes.getLength() - 1; i >= 0; i--) {
;;                 Element node = nodes.item( i );
                
;;                 list = list.append( concept( node ) );
;;             }
            
;;             term = ATermUtils.makeAnd( list );
;;         }
;;         else if( type.equals( DIGConstants.OR ) ) {
;;             ElementList nodes = getElements( c );

;;             ATermList list = ATermUtils.EMPTY_LIST;
;;             for(int i = nodes.getLength() - 1; i >= 0; i--) {
;;                 Element node = nodes.item( i );
                
;;                 list = list.append( concept( node ) );
;;             }
            
;;             term = ATermUtils.makeOr( list );
;;         }
;;         else if( type.equals( DIGConstants.NOT ) ) {
;;             Element node = getElement( c );
            
;;             term = ATermUtils.makeNot( concept( node ) );
;;         }        
;;         else if( type.equals( DIGConstants.ALL ) ) {
;;             ElementList nodes = getElements( c );
            
;;             ATermAppl prop = property( nodes.item( 0 ) ) ;
;;             ATermAppl allValues = concept( nodes.item( 1 ) );
            
;;             term = ATermUtils.makeAllValues( prop, allValues );
;;         }
;;         else if( type.equals( DIGConstants.SOME ) ) {
;;             ElementList nodes = getElements( c );
            
;;             ATermAppl prop = property( nodes.item( 0 ) ) ;
;;             ATermAppl someValues = concept( nodes.item( 1 ) );
            
;;             term = ATermUtils.makeSomeValues( prop, someValues );
;;         }
;;         else if( type.equals( DIGConstants.ATMOST ) ) {
;;             ElementList nodes = getElements( c );
            
;;             int num = getNum( c );
;;             ATermAppl prop = property( nodes.item( 0 ) ) ;
;;             ATermAppl top = concept( nodes.item( 1 ) );
            
;;             if( !top.equals( ATermUtils.TOP ) )
;;                 throw new RuntimeException( "Qualified number restrictions are not allowed!" );
            
;;             term = ATermUtils.makeMax( prop, num );
;;         }
;;         else if( type.equals( DIGConstants.ATLEAST ) ) {
;;             ElementList nodes = getElements( c );
            
;;             int num = getNum( c );
;;             ATermAppl prop = property( nodes.item( 0 ) ) ;
;;             ATermAppl top = concept( nodes.item( 1 ) );
            
;;             if( !top.equals( ATermUtils.TOP ) )
;;                 throw new RuntimeException( "Qualified number restrictions are not allowed!" );
            
;;             term = ATermUtils.makeMin( prop, num );
;;         }
;;         else if( type.equals( DIGConstants.ISET ) ) {
;;             ElementList nodes = getElements( c );

;;             ATermList list = ATermUtils.EMPTY_LIST;
;;             for(int i = nodes.getLength() - 1; i >= 0; i--) {
;;                 Element node = nodes.item( i );
                
;;                 list = list.append( ATermUtils.makeValue( individual( node ) ) );
;;             }
            
;;             term = ATermUtils.makeOr( list );
;;         }
;;         else if( type.equals( DIGConstants.INTEQUALS ) ) {
;;             Element node = getElement( c );
            
;;             String val = String.valueOf( getIntVal( c ) );
;;             ATermAppl prop = property( node ) ;

;;             ATermAppl value = ATermUtils.makeTypedLiteral( val, Namespaces.XSD + "int" );
            
;;             term = ATermUtils.makeHasValue( prop, value );
;;         }       
;;         else if( type.equals( DIGConstants.STRINGEQUALS ) ) {
;;             Element node = getElement( c );
            
;;             String val = getVal( c );
;;             ATermAppl prop = property( node ) ;

;;             ATermAppl value = ATermUtils.makePlainLiteral( val );
            
;;             term = ATermUtils.makeHasValue( prop, value );
;;         }
;;         else
;;             throw new RuntimeException( "Invalid concept constructor " + type );
        
;;         return term;
;;     }


;; (#"getSubClasses" (kb-kb (kb existential-hierarchy)) 
;; 		  (#"makeSomeValues" 'ATermUtils (get-entity !go:go_isa (kb existential-hierarchy)) (get-entity !go:GO_0000060 (kb existential-hierarchy))) t)