[isidorus-cvs] r392 - trunk/src/TM-SPARQL
Lukas Giessmann
lgiessmann at common-lisp.net
Sun Feb 6 22:33:56 UTC 2011
Author: lgiessmann
Date: Sun Feb 6 17:33:55 2011
New Revision: 392
Log:
TM-SPARQL: added the ability to handle blank nodes, i.e. tm-items without any identifier
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Sun Feb 6 17:33:55 2011
@@ -25,6 +25,20 @@
classes and equality operators.")
+
+(defgeneric sparql-node (construct &key revision)
+ (:documentation "Returns a string of the form <uri> or _t123 that represents
+ a resource node or a blank node.")
+ (:method ((construct TopicMapConstructC) &key (revision d:*TM-REVISION*))
+ (declare (Integer revision))
+ (let ((uri-string (any-id construct :revision revision)))
+ (if uri-string
+ (concat "<" uri-string ">")
+ (let ((oid-string (write-to-string (elephant::oid construct)))
+ (pref (subseq (symbol-name (type-of construct)) 0 1)))
+ (concat "_" (string-downcase pref) oid-string))))))
+
+
(defun init-tm-sparql (&optional (revision (get-revision)))
"Imports the file tmsparql_core_psis.xtm. core_psis.xtm has to be imported
before."
@@ -470,14 +484,6 @@
results)))))
-(defun embrace-uri(uri-string)
- "Returns '<'uri-string'>' if uri-string is not a string uri-string
- is returned as result."
- (if (typep uri-string 'String)
- (concat "<" uri-string ">")
- uri-string))
-
-
(defgeneric filter-by-given-object (construct &key revision)
(:documentation "Returns a list representing a triple that is the result
of a given object.")
@@ -555,15 +561,16 @@
(String literal-datatype))
(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 (embrace-uri subj)
- :predicate (embrace-uri pred)
- :object (charvalue char)
- :literal-datatype literal-datatype))))
+ (let ((subj-uri
+ (when-do top (parent char :revision revision)
+ (sparql-node top :revision revision)))
+ (pred-uri
+ (when-do top (instance-of char :revision revision)
+ (sparql-node top :revision revision))))
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (charvalue char)
+ :literal-datatype literal-datatype)))
(remove-if #'(lambda(char)
(typep char 'VariantC))
(return-characteristics literal-value literal-datatype)))))
@@ -576,26 +583,23 @@
(: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)))
+ (obj-uri (sparql-node 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
+ (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))))))
+ (list :subject
(when-do plr (player orole :revision revision)
- (any-id plr :revision revision))))
- (when (and obj-uri pred-uri subj-uri)
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (embrace-uri obj-uri)))))
+ (sparql-node plr :revision revision))
+ :predicate
+ (when-do type (instance-of role :revision revision)
+ (sparql-node type :revision revision))
+ :object obj-uri)))
roles-by-oplayer)))))
@@ -639,29 +643,27 @@
(value (object construct)))
role))
roles-by-type))
- roles-by-type))
- (pred-uri (any-id (value (predicate construct)) :revision revision)))
+ roles-by-type)))
(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))
+ (let* ((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
+ (roles assoc :revision revision)))))
+ (list :subject
(when-do plr (player orole :revision revision)
- (any-id plr :revision revision))))
- (when (and subj-uri pred-uri obj-uri)
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (embrace-uri obj-uri)))))
+ (sparql-node plr :revision revision))
+ :predicate
+ (sparql-node (value (predicate construct))
+ :revision revision)
+ :object
+ (when-do plr-top (player role :revision revision)
+ (sparql-node plr-top :revision revision)))))
roles-by-player))))))
@@ -700,17 +702,14 @@
(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 (embrace-uri subj)
- :predicate (embrace-uri pred)
- :object (charvalue name)
- :literal-datatype *xml-string*))))
+ (list :subject
+ (when-do top (parent name :revision revision)
+ (sparql-node top :revision revision))
+ :predicate
+ (when-do top (instance-of name :revision revision)
+ (sparql-node top :revision revision))
+ :object (charvalue name)
+ :literal-datatype *xml-string*))
names-by-literal))))))
@@ -740,17 +739,14 @@
(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 (embrace-uri subj)
- :predicate (embrace-uri pred)
- :object (charvalue occ)
- :literal-datatype (datatype occ)))))
+ (list :subject
+ (when-do top (parent occ :revision revision)
+ (sparql-node top :revision revision))
+ :predicate
+ (when-do top (instance-of occ :revision revision)
+ (sparql-node top :revision revision))
+ :object (charvalue occ)
+ :literal-datatype (datatype occ)))
all-occs))))))
@@ -895,19 +891,16 @@
#'(lambda(occ)
(filter-occ-by-value occ literal-value literal-datatype))
occs-by-type)))
- (subj-uri (when-do top-uri (any-id construct :revision revision)
- top-uri)))
+ (subj-uri (sparql-node 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 (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (charvalue occ)
- :literal-datatype (datatype occ)))))
+ (list :subject subj-uri
+ :predicate
+ (when-do type-top
+ (instance-of occ :revision revision)
+ (sparql-node type-top :revision revision))
+ :object (charvalue occ)
+ :literal-datatype (datatype occ)))
all-occs)))))
@@ -930,17 +923,15 @@
:revision revision)
(names construct :revision revision)))
(all-names (intersection by-type by-literal))
- (subj-uri (any-id construct :revision revision)))
+ (subj-uri (sparql-node 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 (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (charvalue name)
- :literal-datatype *xml-string*))))
+ (list :subject subj-uri
+ :predicate
+ (when-do type-top (instance-of name :revision revision)
+ (sparql-node type-top :revision revision))
+ :object (charvalue name)
+ :literal-datatype *xml-string*))
all-names)))))
@@ -975,7 +966,7 @@
(let ((assocs
(associations-of construct nil nil type-top player-top
:revision revision))
- (subj-uri (any-id construct :revision revision)))
+ (subj-uri (sparql-node construct :revision revision)))
(remove-null ;only assocs with two roles can match!
(map 'list
#'(lambda(assoc)
@@ -995,17 +986,16 @@
(when-do
type-top (instance-of other-role
:revision revision)
- (any-id type-top :revision revision))))
+ (sparql-node type-top :revision revision))))
(obj-uri
(when other-role
(when-do player-top (player other-role
:revision revision)
- (any-id player-top :revision revision)))))
- (when (and pred-uri obj-uri)
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (embrace-uri obj-uri))))))
+ (sparql-node player-top :revision revision)))))
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
assocs)))))
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 17:33:55 2011
@@ -12,11 +12,6 @@
;TODO: create a macro for "filter-for-scopes", "filter-for-reifier", ...
-;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
@@ -99,14 +94,11 @@
(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)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (eql (player (value subj) :revision revision)
@@ -120,19 +112,15 @@
(when player-top
(list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id player-top :revision revision)
- (embrace-uri (uri id)))))))
+ :object (sparql-node player-top :revision revision)))))
((not (variable-p obj))
(let ((parent-roles
(player-in-roles (value obj) :revision revision)))
(loop for role in parent-roles
- collect (list :subject (when-do id (any-id role :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node role :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id (player role :revision revision)
- :revision revision)
- (embrace-uri id))))))
+ :object (sparql-node (player role :revision revision)
+ :revision revision)))))
(t ; only pred is given
(let ((all-roles
(remove-null
@@ -141,14 +129,10 @@
role))
(get-all-roles revision)))))
(loop for role in all-roles
- collect (list :subject
- (when-do id (any-id role :revision revision)
- (embrace-uri (uri id)))
+ collect (list :subject (sparql-node role :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id (player role :revision revision)
- :revision revision)
- (embrace-uri id)))))))))))
+ :object (sparql-node (player role :revision revision)
+ :revision revision))))))))))
(defgeneric filter-for-roles (construct &key revision)
@@ -160,14 +144,11 @@
(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)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (find obj (roles (value subj) :revision revision))
@@ -178,13 +159,11 @@
(loop for role in (roles (value subj) :revision revision)
collect (list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id role :revision revision)
- (embrace-uri id)))))
+ :object (sparql-node role :revision revision))))
((not (variable-p obj))
(let ((parent-assoc (parent (value obj) :revision revision)))
(when revision
- (list :subject (when-do id (any-id parent-assoc :revision revision)
- (embrace-uri id))
+ (list :subject (sparql-node parent-assoc :revision revision)
:predicate pred-uri
:object obj-uri))))
(t ; only pred is given
@@ -196,15 +175,11 @@
(get-all-associations revision)))))
(loop for assoc in assocs
append (loop for role in (roles assoc :revision revision)
- collect (list :subject
- (when-do id (any-id assoc
- :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node
+ assoc :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id role
- :revision revision)
- (embrace-uri id))))))))))))
+ :object (sparql-node
+ role :revision revision)))))))))))
(defgeneric filter-for-topicProperties (construct &key revision)
@@ -216,14 +191,11 @@
(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)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (find obj (append (names (value subj) :revision revision)
@@ -237,13 +209,12 @@
(occurrences (value subj) :revision revision))
collect (list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id property :revision revision)
- (embrace-uri id)))))
+ :object
+ (sparql-node property :revision revision))))
((not (variable-p obj))
(let ((parent-top (parent (value obj) :revision revision)))
(when revision
- (list :subject (when-do id (any-id parent-top :revision revision)
- (embrace-uri id))
+ (list :subject (sparql-node parent-top :revision revision)
:predicate pred-uri
:object obj-uri))))
(t ; only pred is given
@@ -259,13 +230,11 @@
append (loop for prop in (append
(names top :revision revision)
(occurrences top :revision revision))
- collect (list :subject
- (when-do id (any-id top :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node
+ top :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id prop :revision revision)
- (embrace-uri id))))))))))))
+ :object (sparql-node
+ prop :revision revision)))))))))))
(defgeneric filter-for-values (construct &key revision)
@@ -280,11 +249,9 @@
(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)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node(value pred) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (or (and (typep subj 'NameC)
@@ -302,8 +269,7 @@
:literal-datatype (datatype subj))))
((not (variable-p obj))
(loop for char in (return-characteristics (value obj) literal-datatype)
- collect (list :subject (when-do id (any-id char :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node char :revision revision)
:predicate pred-uri
:object (charvalue char)
:literal-datatype (datatype char))))
@@ -312,8 +278,7 @@
(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))
+ collect (list :subject (sparql-node char :revision revision)
:predicate pred-uri
:object (charvalue char)
:literal-datatype (datatype char))))))))))
@@ -328,14 +293,11 @@
(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)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (find obj (themes (value subj) :revision revision))
@@ -346,14 +308,12 @@
(loop for scope in (themes (value subj) :revision revision)
collect (list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id scope :revision revision)
- (embrace-uri (uri id))))))
+ :object (sparql-node scope :revision revision))))
((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)))
+ collect (list :subject (sparql-node construct :revision revision)
:predicate pred-uri
:object obj-uri))))
(t ;only pred is given
@@ -369,68 +329,59 @@
(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))
+ (list :subject (sparql-node
+ construct :revision revision)
:predicate pred-uri
- :object (when-do id (any-id construct
- :revision revision)
- (embrace-uri id))))))))))))
+ :object (sparql-node
+ construct :revision revision)))))))))))
- (defgeneric filter-for-reifier (construct &key revision)
- (:documentation "Returns a list with triples representing a reifier
+(defgeneric filter-for-reifier (construct &key revision)
+ (:documentation "Returns a list with triples 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
+ (: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)
+ (sparql-node (value subj) :revision revision)))
+ (pred-uri (unless (variable-p pred)
+ (sparql-node (value pred) :revision revision)))
+ (obj-uri (unless (variable-p obj)
+ (sparql-node (value obj) :revision revision))))
+ (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 (sparql-node reifier-top :revision revision)))))
+ ((not (variable-p obj))
+ (let ((reified-cons
+ (reified-construct (value obj) :revision revision)))
+ (when reified-cons
+ (list (list :subject
+ (sparql-node reified-cons :revision revision)
: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
+ :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
+ (sparql-node (reified-construct top :revision revision)
+ :revision revision)
+ :predicate pred-uri
+ :object (sparql-node top :revision revision))))))))))
\ No newline at end of file
More information about the Isidorus-cvs
mailing list