[isidorus-cvs] r386 - in trunk/src: . TM-SPARQL model
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Feb 1 17:55:25 UTC 2011
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)
More information about the Isidorus-cvs
mailing list