Author: lgiessmann Date: Sat Nov 27 11:40:38 2010 New Revision: 355 Log: TM-SPARQL: fixed ticket #86 => requests without FILTERs can be processed Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/model/datamodel.lisp trunk/src/model/trivial-queries.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Sat Nov 27 11:40:38 2010 @@ -11,10 +11,33 @@ (:use :cl :datamodel :base-tools :exceptions :constants) (:export :SPARQL-Query)) +;;TODO: +;; *handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html (in-package :TM-SPARQL) -(defvar *empty-label* "_empty_label_symbol") +(defvar *empty-label* "_empty_label_symbol" "A label symobl for empyt prefix labels") + +(defvar *equal-operators* nil "A Table taht contains tuples of + classes and equality operators.") + +(defun init-*equal-operators* () + (setf *equal-operators* + (list (list :class 'Boolean :operator #'eql) + (list :class 'String :operator #'string=) + (list :class 'Number :operator #'=)))) + + +(init-*equal-operators*) + + +(defun get-equal-operator (value) + (let ((entry + (find-if #'(lambda(entry) + (typep value (getf entry :class))) + *equal-operators*))) + (when entry + (getf entry :operator)))) (defclass SPARQL-Triple-Elem() @@ -37,11 +60,12 @@ :initform nil :type String :documentation "Contains the @lang attribute of a literal") - (literal-type :initarg :literal-type - :accessor literal-type - :type String - :initform nil - :documentation "Contains the datatype of the literal, e.g. xml:string")) + (literal-datatype :initarg :literal-datatype + :accessor literal-datatype + :type String + :initform nil + :documentation "Contains the datatype of the literal, + e.g. xml:string")) (:documentation "Represents one element of an RDF-triple.")) @@ -195,36 +219,495 @@ (variables construct)))))) - - -;;TODO: -;; -;; find-triples (subject predicate object) -;; * var var var => return the entire graph (all subjects) -;; * var var object -;; * var predicate var -;; * var predicate object -;; * subject var var -;; * subject var object -;; * subject predicate var -;; * subject predicate object => return subject predicate object if true otherweise nil -;; handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html - -(defgeneric set-result (construct) +(defgeneric set-results (construct &key revision) (:documentation "Calculates the result of a triple and set all the values in the passed object.") + (:method ((construct SPARQL-Triple) &key (revision d:*TM-REVISION*)) + (declare (Integer revision)) + (set-tm-constructs construct :revision revision) + (when (not (iri-not-found-p construct)) ;there is only a result if all IRIs were found + (let ((results (or (filter-by-given-subject construct :revision revision) + (filter-by-given-predicate construct :revision revision) + (filter-by-given-object construct :revision revision)))) + (map 'list #'(lambda(result) + (push (getf result :subject) (subject construct)) + (push (getf result :predicate) (predicate construct)) + (push (getf result :object) (object construct))) + ;;literal-datatype is not used and is not returned, since + ;;the values are returned as object of their specific type, e.g. + ;;integer, boolean, string, ... + results))))) + + +(defgeneric filter-by-given-object (construct &key revision) + (:documentation "Returns a list representing a triple that is the result + of a given object.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (unless (variable-p (object construct)) + (cond ((literal-p (object construct)) + (filter-by-characteristic-value (value (object construct)) + (literal-datatype (object construct)) + :revision revision)) + ((iri-p (object construct)) + (filter-by-otherplayer (value (object construct)) + :revision revision)))))) + + +(defun filter-by-characteristic-value (literal-value literal-datatype + &key (revision *TM-REVISION*)) + "Returns a triple where the passed value is a charvalue in a occurrence + or name. The subject is the owner topic and the predicate is the + characteristic's type." + (declare (Integer revision) + (String literal-value literal-datatype)) + (let ((chars + (cond ((string= literal-datatype *xml-string*) + (remove-if #'(lambda(elem) + (string/= (charvalue elem) literal-value)) + (append + (elephant:get-instances-by-value + 'OccurrenceC 'charvalue literal-value) + (elephant:get-instances-by-value + 'NameC 'charvalue literal-value)))) + ((and (string= literal-datatype *xml-boolean*) + (eql literal-value t)) + (remove-if #'(lambda(elem) + (string/= (charvalue elem) "true")) + (elephant:get-instances-by-value + 'OccurrenceC 'charvalue "true"))) + ((and (string= literal-datatype *xml-boolean*) + (eql literal-value nil)) + (remove-if #'(lambda(elem) + (string/= (charvalue elem) "false")) + (elephant:get-instances-by-value + 'OccurrenceC 'charvalue "false"))) + ((or (string= literal-datatype *xml-double*) + (string= literal-datatype *xml-decimal*) + (string= literal-datatype *xml-integer*)) + (let ((occs + (remove-if #'(lambda(occ) + (string/= (datatype occ) literal-datatype)) + (elephant:get-instances-by-value + 'OccurrenceC 'datatype literal-datatype)))) + (remove-if #'(lambda(occ) + (not (literal= (charvalue occ) literal-value))) + occs)))))) + (remove-null + (map 'list #'(lambda(char) + (let ((subj (when-do top (parent char :revision revision) + (any-id top :revision revision))) + (pred (when-do top (instance-of char :revision revision) + (any-id top :revision revision)))) + (when (and subj pred) + (list :subject subj + :predicate pred + :object (charvalue char) + :literal-datatyp literal-datatype)))) + chars)))) + + +(defgeneric filter-by-otherplayer (construct &key revision) + (:documentation "Returns triples where the passed player is the object, + the other player is the subject and the type of the passed + player's role is the predicate.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (let ((roles-by-oplayer (player-in-roles construct :revision revision)) + (obj-uri (any-id construct :revision revision))) + (remove-null + (map 'list + #'(lambda(role) + (let* ((orole + (when-do assoc (parent role :revision revision) + (when (= (length (roles assoc :revision revision)) + 2) + (find-if #'(lambda(r) (not (eql r role))) + (roles assoc :revision revision))))) + (pred-uri + (when-do type (instance-of role :revision revision) + (any-id type :revision revision))) + (subj-uri + (when-do plr (instance-of orole :revision revision) + (any-id plr :revision revision)))) + (when (and obj-uri pred-uri subj-uri) + (list :subject subj-uri + :predicate pred-uri + :object obj-uri)))) + roles-by-oplayer))))) + + +(defgeneric filter-by-given-predicate (construct &key revision) + (:documentation "Returns all topics that owns a characteristic of the + given type or an associaiton with an otherrole of the + given type. The result is a plist representing a triple.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (and (variable-p (subject construct)) + (iri-p (predicate construct))) + (cond ((variable-p (object construct)) + (append (filter-by-otherroletype construct :revision revision) + (filter-by-characteristictype construct :revision revision))) + ((literal-p (object construct)) + (filter-by-characteristictype construct :revision revision)) + ((iri-p (object construct)) + (filter-by-otherroletype construct :revision revision)))))) + + +(defgeneric filter-by-otherroletype (construct &key revision) + (:documentation "Returns triple where the passed predicate is a + type of a role. The returned subject is the otherplayer, + the predicate is the passed predicate, the object is + the player of the role of the passed type.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (or (variable-p (object construct)) + (iri-p (object construct))) + (let* ((roles-by-type + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'RoleC) + typed-construct)) + (used-as-type construct :revision revision))) + (roles-by-player + (if (iri-p (object construct)) + (remove-null + (map 'list #'(lambda(role) + (when (eql (instance-of role :revision revision) + (value (object construct))))) + roles-by-type)) + roles-by-type)) + (pred-uri (any-id (value (predicate construct)) :revision revision))) + (remove-null + (map 'list + #'(lambda(role) + (let* ((obj-uri + (when-do plr-top (player role :revision revision) + (any-id plr-top :revision revision))) + (assoc (parent role :revision revision)) + (orole (when (and assoc + (= (length + (roles assoc :revision revision)) + 2)) + (find-if #'(lambda(r) + (not (eql r role))) + (roles assoc :revision revision)))) + (subj-uri + (when-do plr (player orole :revision revision) + (any-id plr :revision revision)))) + (when (and subj-uri pred-uri obj-uri) + (list :subject subj-uri + :predicate pred-uri + :object obj-uri)))) + roles-by-player)))))) + + +(defgeneric filter-by-characteristictype (construct &key revision) + (:documentation "Returns the results of filter-by-nametype and + filter-by-occurrencetype.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (append (filter-by-nametype construct :revision revision) + (filter-by-occurrencetype construct :revision revision)))) + + +(defgeneric filter-by-nametype (construct &key revision) + (:documentation "Returns all names that corresponds to the given parameters.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (and (not (iri-p (object construct))) + (or (not (literal-datatype construct)) + (string= (literal-datatype construct) *xml-string*))) + (let* ((names-by-type + (remove-null + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'NameC) + typed-construct)) + (used-as-type (value (predicate construct)) + :revision revision)))) + (names-by-literal + (if (variable-p (object construct)) + (remove-null + (map 'list #'(lambda(name) + (string= (charvalue name) + (value (object construct)))) + names-by-type)) + names-by-type))) + (remove-null + (map 'list + #'(lambda(name) + (let ((subj + (when-do top (parent name :revision revision) + (any-id top :revision revision))) + (pred + (when-do top (instance-of name :revision revision) + (any-id top :revision revision)))) + (when (and subj pred) + (list :subject subj + :predicate pred + :object (charvalue name) + :literal-datatype *xml-string*)))) + names-by-literal)))))) + + +(defgeneric filter-by-occurrencetype (construct &key revision) + (:documentation "Returns all occurrence that corresponds to the + given parameters.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (unless (iri-p (object construct)) + (let* ((occs-by-type + (remove-null + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'OccurrenceC) + typed-construct)) + (used-as-type (value (predicate construct)) + :revision revision)))) + (all-occs + (let ((literal-value (if (variable-p (object construct)) + nil + (value (object construct)))) + (literal-datatype (literal-datatype (object construct)))) + (remove-null + (map 'list #'(lambda(occ) + (filter-occ-by-value occ literal-value + literal-datatype)) + occs-by-type))))) + (remove-null + (map 'list + #'(lambda(occ) + (let ((subj + (when-do top (parent occ :revision revision) + (any-id top :revision revision))) + (pred + (when-do top (instance-of occ :revision revision) + (any-id top :revision revision)))) + (when (and subj pred) + (list :subject subj + :predicate pred + :object (charvalue occ) + :literal-datatype (datatype occ))))) + all-occs)))))) + + +(defgeneric filter-by-given-subject (construct &key revision) + (:documentation "Calls filter-characteristics and filter associations + for the topic that is set as a subject of the passed triple.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (iri-p (subject construct)) + (let* ((subj (value (subject construct))) + (pred (when (iri-p (predicate construct)) + (value (predicate construct))))) + (cond ((variable-p (object construct)) + (append (filter-characteristics + subj pred nil nil :revision revision) + (filter-associations + subj pred nil :revision revision))) + ((literal-p (object construct)) + (filter-characteristics + subj pred (value (subject construct)) + (literal-datatype (object construct)) :revision revision)) + ((iri-p (object construct)) + (filter-associations subj pred (value (object construct)) + :revision revision))))))) + + +(defgeneric literal-p (construct) + (:documentation "Returns t if the passed construct has an elem-type + set to 'LITERAL.") + (:method ((construct SPARQL-Triple-Elem)) + (eql (elem-type construct) 'LITERAL))) + + +(defgeneric iri-p (construct) + (:documentation "Returns t if the passed construct has an elem-type + set to 'IRI.") + (:method ((construct SPARQL-Triple-Elem)) + (eql (elem-type construct) 'IRI))) + + +(defgeneric variable-p (construct) + (:documentation "Returns t if the passed construct has an elem-type + set to 'VARIABLE.") + (:method ((construct SPARQL-Triple-Elem)) + (eql (elem-type construct) 'VARIABLE))) + + +(defgeneric iri-not-found-p (construct) + (:documentation "Must be called after a call of set-tm-constructs. + It returns t if a TM-construct was not found for a + given IRI, so the result value of a query is nil.") (:method ((construct SPARQL-Triple)) - ;;TODO: implement - construct)) - - -(defgeneric find-subject-var-var (construct) - (:documentation "Finds a triple corresponding to the subject and sets - both variables.") - (:method ((construct SPARQL-Triple)) - - )) - + (or (iri-not-found-p (subject construct)) + (iri-not-found-p (predicate construct)) + (iri-not-found-p (object construct))))) + + +(defmethod iri-not-found-p ((construct SPARQL-Triple-Elem)) + (and (eql (elem-type construct) 'IRI) + (not (value construct)))) + + +(defgeneric set-tm-constructs (construct &key revision) + (:documentation "Calls the method set-tm-construct for every element + in a SPARQL-Triple object.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (when-do subj (subject construct) + (set-tm-construct subj :revision revision)) + (when-do pred (predicate construct) + (set-tm-construct pred :revision revision)) + (when-do obj (object construct) (set-tm-construct obj :revision revision)))) + + +(defgeneric set-tm-construct (construct &key revision) + (:documentation "Replaces the IRI in the given object by the corresponding + TM-construct.") + (:method ((construct SPARQL-Triple-Elem) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (eql (elem-type construct) 'IRI) + (setf (value construct) + (get-item-by-any-id (value construct) :revision revision))))) + + +(defun literal= (value-1 value-2) + "Returns t if both arguments are equal. The equality function is searched in + the table *equal-operators*." + (when (or (and (numberp value-1) (numberp value-2)) + (typep value-1 (type-of value-2)) + (typep value-2 (type-of value-1))) + (let ((operator (get-equal-operator value-1))) + (funcall operator value-1 value-2)))) + + +(defun filter-occ-by-value (occurrence literal-value literal-datatype) + "A helper that compares the occurrence's charvalue with the passed + literal value." + (declare (OccurrenceC occurrence) + (type (or Null String) literal-value literal-datatype)) + (when (or (not literal-datatype) + (string= (datatype occurrence) literal-datatype)) + (if (not literal-value) + occurrence + (handler-case + (let ((occ-value (cast-literal (charvalue occurrence) + (datatype occurrence)))) + (when (literal= occ-value literal-value) + occurrence)) + (condition () nil))))) + + +(defgeneric filter-occurrences(construct type-top literal-value + literal-datatype &key revision) + (:documentation "Returns a list representing a triple.") + (:method ((construct TopicC) type-top literal-value literal-datatype + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null String) literal-value literal-datatype) + (type (or Null TopicC) type-top)) + (let* ((occs-by-type + (occurrences-by-type construct type-top :revision revision)) + (all-occs + (remove-null + (map 'list + #'(lambda(occ) + (filter-occ-by-value occ literal-value literal-datatype)) + occs-by-type))) + (subj-uri (any-id construct :revision revision))) + (remove-null + (map 'list #'(lambda(occ) + (let ((pred-uri + (when-do type-top (instance-of occ :revision revision) + (any-id type-top :revision revision)))) + (when pred-uri + (list :subject subj-uri + :predicate pred-uri + :object (charvalue occ) + :literal-datatype (datatype occ))))) + all-occs))))) + + +(defgeneric filter-names(construct type-top literal-value + &key revision) + (:documentation "Returns a list representing a triple.") + (:method ((construct TopicC) type-top literal-value + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null String) literal-value) + (type (or Null TopicC) type-top)) + (let* ((by-type + (names-by-type construct type-top :revision revision)) + (by-literal (if literal-value + (names-by-value + construct #'(lambda(name) + (string= name literal-value)) + :revision revision) + (names construct :revision revision))) + (all-names (intersection by-type by-literal)) + (subj-uri (any-id construct :revision revision))) + (remove-null + (map 'list #'(lambda(name) + (let ((pred-uri + (when-do type-top (instance-of name :revision revision) + (any-id type-top :revision revision)))) + (when pred-uri + (list :subject subj-uri + :predicate pred-uri + :object (charvalue name) + :literal-datatype *xml-string*)))) + all-names))))) + + +(defgeneric filter-characteristics (construct type-top literal-value + literal-datatype &key revision) + (:documentation "Returns a list representing a triple.") + (:method ((construct TopicC) type-top literal-value literal-datatype + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null String) literal-value literal-datatype) + (type (or Null TopicC) type-top)) + (let ((occs (filter-occurrences construct type-top literal-value + literal-datatype :revision revision)) + (names (if (or (not literal-datatype) + (string= literal-datatype *xml-string*)) + (filter-names construct type-top literal-value + :revision revision) + nil))) + (append occs names)))) + + +(defgeneric filter-associations(construct type-top player-top + &key revision) + (:documentation "Returns a list of the form (:type <uri> :value <uri>). + type-identifier is the type of the otherrole and + player-identifier if the otherplayer.") + (:method ((construct TopicC) type-top player-top + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null TopicC) type-top player-top)) + (let ((assocs + (associations-of construct nil nil type-top player-top + :revision revision))) + (remove-null ;only assocs with two roles can match! + (map 'list + #'(lambda(assoc) + (when (= (length (roles assoc :revision revision)) 2) + (let* ((other-role + (find-if #'(lambda(role) + (not (eql construct + (player role :revision revision)))) + (roles assoc :revision revision))) + (pred-uri + (when-do type-top (instance-of other-role + :revision revision) + (any-id type-top :revision revision))) + (obj-uri + (when-do player-top (player other-role + :revision revision) + (any-id player-top :revision revision)))) + (when (and pred-uri obj-uri) + (list :type pred-uri + :value obj-uri))))) + assocs))))) (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sat Nov 27 11:40:38 2010 @@ -92,7 +92,10 @@ next-query (original-query construct) "WHERE"))) (let* ((triples (string-after next-query "WHERE")) (query-tail (parse-where construct triples))) - (or query-tail) ;TODO: process tail-of query, e.g. order by, ... + (when (> (length query-tail) 0) + (error (make-sparql-parser-condition + query-tail (original-query construct) + "The end of the query. Solution sequence modifiers are not supported yet."))) construct)))) @@ -147,7 +150,7 @@ (declare (String query-string) (SPARQL-Query query-object)) ;;TODO: implement - (or query-string query-object)) + ) (defun parse-triple-elem (query-string query-object &key (literal-allowed nil)) @@ -264,8 +267,12 @@ 'sparql-parser-error :message (format nil "Could not cast from ~a to ~a" literal-value literal-type)))) - value)))) - + value)) + (t + (error (make-condition + 'sparql-error + :message (format nil "The type \"~a\" is not supported." + literal-type)))))) (defun separate-literal-lang-or-type (query-string query-object) "A helper function that returns (:next-query string :lang string Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Sat Nov 27 11:40:38 2010 @@ -43,6 +43,7 @@ :FragmentC ;;methods, functions and macros + :get-all-identifiers-of-construct :xtm-id :uri :identified-construct @@ -108,6 +109,8 @@ :get-item-by-item-identifier :get-item-by-locator :get-item-by-content + :get-item-by-any-id + :any-id :string-integer-p :with-revision :get-latest-fragment-of-topic @@ -170,6 +173,7 @@ :invoke-on :names-by-type :occurrences-by-type + :occurrences-by-datatype :characteristics-by-type :occurrences-by-value :names-by-value @@ -1028,6 +1032,11 @@ the TM.")) +(defgeneric any-id (construct &key revision) + (:documentation "Returns any uri of the constructs identifier, except + TopicIdentificationC. The order is: PSIs, SL, II.")) + + ;;; generic functions/accessors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; VersionInfocC @@ -1838,6 +1847,28 @@ (item-identifiers construct :revision revision))) +(defun get-item-by-any-id (id-uri &key (revision d:*TM-REVISION*)) + "Returns a topic or REfifiableConstruct corresponding to the given uri." + (declare (String id-uri) + (Integer revision)) + (or (d:get-item-by-psi id-uri :revision revision) + (get-item-by-item-identifier id-uri :revision revision) + (get-item-by-locator id-uri :revision revision))) + + +(defmethod any-id ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (let ((psi (when-do psis (psis construct :revision revision) + (uri (first psis))))) + (if psi + psi + (let ((sl (when-do sls (locators construct :revision revision) + (uri (first sls))))) + (if sl + sl + (call-next-method)))))) + + (defgeneric names (construct &key revision) (:documentation "Returns the NameC-objects that correspond with the passed construct and the passed version.") @@ -3159,7 +3190,6 @@ construct 'reifier :start-revision revision))) (when assocs ;assocs must be nil or a list with exactly one item (reifier-topic (first assocs)))))) -1 (defgeneric add-item-identifier (construct item-identifier &key revision) @@ -3229,6 +3259,12 @@ construct))) +(defmethod any-id ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when-do iis (item-identifiers construct :revision revision) + (uri (first iis)))) + + (defgeneric add-reifier (construct reifier-topic &key revision) (:documentation "Adds the passed reifier-topic as reifier of the construct. If the construct is already reified by the given topic Modified: trunk/src/model/trivial-queries.lisp ============================================================================== --- trunk/src/model/trivial-queries.lisp (original) +++ trunk/src/model/trivial-queries.lisp Sat Nov 27 11:40:38 2010 @@ -321,6 +321,20 @@ (occurrences-by-value construct filter :revision revision)))) +(defgeneric occurrences-by-datatype (construct datatype &key revision) + (:documentation "Returns all occurrences of the specified datatype.") + (:method ((construct TopicC) datatype &key (revision *TM-REVISION*)) + (declare (type (or Null String) datatype) + (Integer revision)) + (if datatype + (remove-null + (map 'list #'(lambda(occ) + (when (string= (datatype occ) datatype) + occ)) + (occurrences construct :revision revision))) + (occurrences construct :revision revision)))) + + (defgeneric isa (construct type &key revision) (:documentation "Returns all types if the passed construct is of the specified type.")