Author: lgiessmann Date: Tue Feb 1 12:55:25 2011 New Revision: 386 Log: TM-SPARQL: added som function/methods that handles predicates for requesting: topicProperties, scopes, reifiers and values Added: trunk/src/TM-SPARQL/sparql_special_uris.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/isidorus.asd trunk/src/model/datamodel.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Tue Feb 1 12:55:25 2011 @@ -15,6 +15,8 @@ :result :init-tm-sparql)) + + (in-package :TM-SPARQL) (defvar *empty-label* "_empty_label_symbol" "A label symobl for empyt prefix labels") @@ -453,9 +455,11 @@ (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)))) + (let ((results (append + (or (filter-by-given-subject construct :revision revision) + (filter-by-given-predicate construct :revision revision) + (filter-by-given-object construct :revision revision)) + (filter-by-special-uris construct :revision revision)))) (map 'list #'(lambda(result) (push (getf result :subject) (subject-result construct)) (push (getf result :predicate) (predicate-result construct)) @@ -491,13 +495,9 @@ :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-datatype)) +(defun return-characteristics (literal-value literal-datatype) + "Returns all characteristica that own the specified value." + (declare (String literal-datatype)) (let ((chars (cond ((string= literal-datatype *xml-string*) (remove-if #'(lambda(elem) @@ -506,30 +506,53 @@ (elephant:get-instances-by-value 'OccurrenceC 'charvalue literal-value) (elephant:get-instances-by-value + 'VariantC 'charvalue literal-value) + (elephant:get-instances-by-value 'NameC 'charvalue literal-value)))) ((and (string= literal-datatype *xml-boolean*) literal-value) (remove-if #'(lambda(elem) (string/= (charvalue elem) "true")) - (elephant:get-instances-by-value - 'OccurrenceC 'charvalue "true"))) + (append (elephant:get-instances-by-value + 'VariantC 'charvalue "true") + (elephant:get-instances-by-value + 'OccurrenceC 'charvalue "true")))) ((and (string= literal-datatype *xml-boolean*) (not literal-value)) (remove-if #'(lambda(elem) (string/= (charvalue elem) "false")) - (elephant:get-instances-by-value - 'OccurrenceC 'charvalue "false"))) + (append (elephant:get-instances-by-value + 'VariantC 'charvalue "true") + (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)))))) + (let ((constructs + (remove-if #'(lambda(con) + (string/= (datatype con) literal-datatype)) + (append + (elephant:get-instances-by-value + 'VariantC 'datatype literal-datatype) + (elephant:get-instances-by-value + 'OccurrenceC 'datatype literal-datatype))))) + (remove-if #'(lambda(con) + (not (literal= (charvalue con) literal-value))) + constructs)))))) + ;;elephant returns names, occurences, and variants if any string + ;;value matches, so all duplicates have to be removed + (remove-duplicates chars))) + + +(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. + (Variants are not considered because they are not typed, so they cannot + be referenced via a predicate)." + (declare (Integer revision) + (String literal-datatype)) (remove-null (map 'list #'(lambda(char) (let ((subj (when-do top (parent char :revision revision) @@ -540,13 +563,10 @@ (list :subject (embrace-uri subj) :predicate (embrace-uri pred) :object (charvalue char) - :literal-datatyp literal-datatype)))) - ;;elephant returns names, occurences, and variants if any string - ;;value matches, so all duplicates have to be removed, additionaly - ;;variants have to be remove completely - (remove-if #'(lambda(obj) - (typep obj 'VariantC)) - (remove-duplicates chars)))))) + :literal-datatype literal-datatype)))) + (remove-if #'(lambda(char) + (typep char 'VariantC)) + (return-characteristics literal-value literal-datatype))))) (defgeneric filter-by-otherplayer (construct &key revision) @@ -824,21 +844,37 @@ (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 +(defun filter-datatypable-by-value (construct literal-value literal-datatype) + "A helper that compares the datatypable's charvalue with the passed literal value." - (declare (OccurrenceC occurrence) + (declare (d::DatatypableC construct) (type (or Null String) literal-value literal-datatype)) (when (or (not literal-datatype) - (string= (datatype occurrence) literal-datatype)) + (string= (datatype construct) literal-datatype)) (if (not literal-value) - occurrence + construct (handler-case - (let ((occ-value (cast-literal (charvalue occurrence) - (datatype occurrence)))) + (let ((occ-value (cast-literal (charvalue construct) + (datatype construct)))) (when (literal= occ-value literal-value) - occurrence)) + construct)) (condition () nil))))) + + +(defun filter-variant-by-value (variant literal-value literal-datatype) + "A helper that compares the occurrence's variant's with the passed + literal value." + (declare (VariantC variant) + (type (or Null String) literal-value literal-datatype)) + (filter-datatypable-by-value variant literal-value literal-datatype)) + + +(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)) + (filter-datatypable-by-value occurrence literal-value literal-datatype)) (defgeneric filter-occurrences(construct type-top literal-value Added: trunk/src/TM-SPARQL/sparql_special_uris.lisp ============================================================================== --- (empty file) +++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Tue Feb 1 12:55:25 2011 @@ -0,0 +1,230 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff +;;+ +;;+ Isidorus is freely distributable under the LLGPL license. +;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and +;;+ trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- + + +(in-package :TM-SPARQL) + + +;TODO: create a macro for "filter-for-scopes", "filter-for-reifier", ... +;TODO: filter-by-special-uris +;TODO: change (embrace-uri String) to (embrace-construct TopicMapsConstructC) +; that creates a blank node when there is no identifier available +; => change also any-id, so if there is no identifier a blank node +; have to be returned +; => change all when-do statements that call any-id + + + + +(defgeneric filter-by-special-uris (construct &key revision) + (:documentation "Returns lists representing triples that handles special + predicate uris defined in tmsparql.") + (:method ((construct SPARQL-Triple) &key (revision d:*TM-REVISION*)) + (let ((pred (predicate construct))) + (if (variable-p pred) + (filter-for-special-uris construct :revision revision) + (cond ((has-identifier (value pred) *tms-reifier*) + (filter-for-reifier construct :revision revision)) + ((has-identifier (value pred) *tms-scope*) + (filter-for-special-uris construct :revision revision)) + ((has-identifier (value pred) *tms-value*) + (filter-for-values construct :revision revision)) + ((has-identifier (value pred) *tms-topicProperty*) + (filter-for-topicProperties construct :revision revision)) + ((has-identifier (value pred) *tms-role*) + nil) ;TODO: implement + ))))) + + +(defgeneric filter-for-special-uris (construct &key revision) + (:documentation "Returns a list of triples representing the subject + and its objects correponding to the defined + special-uris, e.g. <subj> var <obj>.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + ;;TODO: implement + ;; *tms-reifier* + ;; *tms-scope* + ;; *tms-value* => only when there is <occ|var|nam> ? <LITERAL>, otherwise the predicate is the type of the characteristic + ;; *tms-topicProperty* + )) + +(defgeneric filter-for-topicProperties (construct &key revision) + (:documentation "Returns a list of triples where the subject represents + a topic and the object represents a name or occurrence.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + ;TODO: implement + )) + + +(defgeneric filter-for-values (construct &key revision) + (:documentation "Returns a list of triples that represent a + subject and its literal value as object.") + (:method ((construct SPARQL-Triple) &key revision) + (declare (ignorable revision)) + (when (or (literal-p (object construct)) + (variable-p (object construct))) + (let* ((subj (subject construct)) + (pred (predicate construct)) + (obj (object construct)) + (literal-datatype (literal-datatype obj)) + (subj-uri (unless (variable-p subj) + (when-do id (any-id (value subj) :revision revision) + (embrace-uri (uri id))))) + (pred-uri (unless (variable-p pred) + (when-do id (any-id (value pred) :revision revision) + (embrace-uri (uri id)))))) + (cond ((and (not (variable-p subj)) + (not (variable-p obj))) + (when (or (and (typep subj 'NameC) + (string= literal-datatype *xml-string*) + (string= (charvalue subj) obj)) + (filter-datatypable-by-value subj obj literal-datatype)) + (list (list :subject subj-uri + :predicate pred-uri + :object obj + :literal-datatype literal-datatype)))) + ((not (variable-p subj)) + (list (list :subject subj-uri + :predicate pred-uri + :object (charvalue subj) + :literal-datatype (datatype subj)))) + ((not (variable-p obj)) + (loop for char in (return-characteristics obj literal-datatype) + collect (list :subject (when-do id (any-id char :revision revision) + (embrace-uri id)) + :predicate pred-uri + :object (charvalue char) + :literal-datatype (datatype char)))) + (t ;only pred is given + (let ((chars (append (get-all-names revision) + (get-all-occurrences revision) + (get-all-variants revision)))) + (loop for char in chars + collect (list :subject (when-do id (any-id char :revision revision) + (embrace-uri id)) + :predicate pred-uri + :object (charvalue char) + :literal-datatype (datatype char)))))))))) + + +(defgeneric filter-for-scopes (construct &key revision) + (:documentation "Returns a list of triples that represent a subject as the + scoped item and the object as the scope-topic.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (unless (literal-p (object construct)) + (let* ((subj (subject construct)) + (pred (predicate construct)) + (obj (object construct)) + (subj-uri (unless (variable-p subj) + (when-do id (any-id (value subj) :revision revision) + (embrace-uri (uri id))))) + (pred-uri (unless (variable-p pred) + (when-do id (any-id (value pred) :revision revision) + (embrace-uri (uri id))))) + (obj-uri (unless (variable-p obj) + (when-do id (any-id (value obj) :revision revision) + (embrace-uri (uri id)))))) + (cond ((and (not (variable-p subj)) + (not (variable-p obj))) + (when (find obj (themes subj :revision revision)) + (list (list :subject subj-uri + :predicate pred-uri + :object obj-uri)))) + ((not (variable-p subj)) + (loop for scope in (themes subj :revision revision) + collect (list :subject subj-uri + :predicate pred-uri + :object (when-do id (any-id scope :revision revision) + (embrace-uri (uri id)))))) + ((not (variable-p obj)) + (let ((scoped-constructs + (used-as-theme (value obj) :revision revision))) + (loop for construct in scoped-constructs + collect (list :subject (when-do id (any-id construct :revision revision) + (embrace-uri (uri id))) + :predicate pred-uri + :object obj-uri)))) + (t ;only pred is given + (let ((scoped-constructs + (remove-null + (map 'list #'(lambda(construct) + (when (themes construct :revision revision) + construct)) + (append (get-all-associations revision) + (get-all-occurrences revision) + (get-all-names revision) + (get-all-variants)))))) + (loop for construct in scoped-constructs + append (loop for scope in (themes construct :revision revision) + collect + (list :subject (when-do id (any-id construct + :revision revision) + (embrace-uri id)) + :predicate pred-uri + :object (when-do id (any-id construct + :revision revision) + (embrace-uri id)))))))))))) + + +(defgeneric filter-for-reifier (construct &key revision) + (:documentation "Returns a list with one triple representing a reifier + and the corresponding reified construct.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (unless (literal-p (object construct)) + (let* ((subj (subject construct)) + (pred (predicate construct)) + (obj (object construct)) + (subj-uri (unless (variable-p subj) + (when-do id (any-id (value subj) :revision revision) + (embrace-uri (uri id))))) + (pred-uri (unless (variable-p pred) + (when-do id (any-id (value pred) :revision revision) + (embrace-uri (uri id))))) + (obj-uri (unless (variable-p obj) + (when-do id (any-id (value obj) :revision revision) + (embrace-uri (uri id)))))) + (cond ((and (not (variable-p subj)) + (not (variable-p obj))) + (when (eql (reifier (value subj) :revision revision) + (value obj)) + (list (list :subject subj-uri + :predicate pred-uri + :object obj-uri)))) + ((not (variable-p subj)) + (let ((reifier-top + (reifier (value subj) :revision revision))) + (when reifier-top + (list :subject subj-uri + :predicate pred-uri + :object (when-do id (any-id reifier-top :revision revision) + (embrace-uri (uri id))))))) + ((not (variable-p obj)) + (let ((reified-cons + (reified-construct (value obj) :revision revision))) + (when reified-cons + (list (list :subject + (when-do id (any-id reified-cons :revision revision) + (embrace-uri (uri id))) + :predicate pred-uri + :object obj-uri))))) + (t ; only pred is given + (let ((topics + (remove-null + (map 'list #'(lambda(top) + (when (reified-construct top :revision revision) + top)) + (get-all-topics revision))))) + (loop for top in topics + collect (list :subject + (when-do id (any-id (reified-construct + top :revision revision)) + (embrace-uri (uri id))) + :predicate pred-uri + :object (when-do id (any-id top :revision revision) + (embrace-uri (uri id)))))))))))) \ No newline at end of file Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Feb 1 12:55:25 2011 @@ -44,6 +44,8 @@ :components ((:file "sparql_constants") (:file "sparql" :depends-on ("sparql_constants")) + (:file "sparql_special_uris" + :depends-on ("sparql")) (:file "filter_wrappers" :depends-on ("sparql")) (:file "sparql_filter" Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue Feb 1 12:55:25 2011 @@ -43,6 +43,7 @@ :FragmentC ;;methods, functions and macros + :has-identifier :get-all-identifiers-of-construct :xtm-id :uri @@ -153,6 +154,9 @@ :rec-remf :get-all-topics :get-all-associations + :get-all-occurrences + :get-all-names + :get-all-variants :get-all-tms ;;globals @@ -684,6 +688,18 @@ :function-symbol function-symbol)) +(defgeneric has-identifier (construct uri &key revision) + (:documentation "Returns an identifier if there is any identifier bound + to the passed construct with the specified uri.") + (:method ((construct TopicMapConstructC) (uri String) + &key (revision *TM-REVISION*)) + (let ((all-ids + (get-all-identifiers-of-construct construct :revision revision))) + (find-if #'(lambda(idc) + (string= (uri idc) uri)) + all-ids)))) + + (defgeneric get-most-recent-versioned-assoc (construct slot-symbol) (:documentation "Returns the most recent VersionedAssociationC object.") @@ -747,6 +763,18 @@ (get-db-instances-by-class 'AssociationC :revision revision)) +(defun get-all-occurrences (&optional (revision *TM-REVISION*)) + (get-db-instances-by-class 'OccurrenceC :revision revision)) + + +(defun get-all-names (&optional (revision *TM-REVISION*)) + (get-db-instances-by-class 'NameC :revision revision)) + + +(defun get-all-variants (&optional (revision *TM-REVISION*)) + (get-db-instances-by-class 'VariantC :revision revision)) + + (defun get-all-tms (&optional (revision *TM-REVISION*)) (get-db-instances-by-class 'TopicMapC :revision revision)) @@ -980,7 +1008,7 @@ (defgeneric check-for-duplicate-identifiers (construct &key revision) (:documentation "Check for possibly duplicate identifiers and signal an - duplicate-identifier-error is such duplicates are found")) + duplicate-identifier-error is such duplicates are found")) (defgeneric get-all-identifiers-of-construct (construct &key revision)