[isidorus-cvs] r415 - in trunk/src: TM-SPARQL unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Apr 5 21:12:57 UTC 2011
Author: lgiessmann
Date: Tue Apr 5 17:12:56 2011
New Revision: 415
Log:
TM-SPARQL: all result values are returned in the correct datatype representation, if there are unsupported datatypes requested the return value is of the form """value"""^^datatype
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/unit_tests/sparql_test.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Tue Apr 5 17:12:56 2011
@@ -106,7 +106,7 @@
:initform nil
:documentation "Contains the datatype of the literal,
e.g. xml:string"))
- (:documentation "Represents one element of an RDF-triple."))
+ (:documentation "Represents one element of an RDF-triple."))
(defclass SPARQL-Triple()
@@ -147,9 +147,14 @@
:documentation "Represents the subject of an RDF-triple.")
(object-result :initarg :object-result
:accessor object-result
- :type T
+ :type List
:initform nil
- :documentation "Contains the result of the object triple elem."))
+ :documentation "Contains the result of the object triple elem.")
+ (object-datatype :initarg :object-datatype
+ :accessor object-datatype
+ :type List
+ :initform nil
+ :documentation "Conations the corresponding value's datatype."))
(:documentation "Represents an entire RDF-triple."))
@@ -377,9 +382,6 @@
(:documentation "Processes all filters by calling invoke-filter.")
(:method ((construct SPARQL-Query))
(dolist (filter (filters construct))
-
- (format t ">>>~a<<<~%" filter) ;TODO: remove
-
(let* ((filter-variable-names
(get-variables-from-filter-string filter))
(filter-variable-values nil)
@@ -453,14 +455,18 @@
(push
(list :subject (elt (subject-result triple) idx)
:predicate (elt (predicate-result triple) idx)
- :object (elt (object-result triple) idx))
+ :object (elt (object-result triple) idx)
+ :object-datatype (elt (object-datatype triple) idx))
new-values)))
(setf (subject-result triple)
(map 'list #'(lambda(elem) (getf elem :subject)) new-values))
(setf (predicate-result triple)
(map 'list #'(lambda(elem) (getf elem :predicate)) new-values))
(setf (object-result triple)
- (map 'list #'(lambda(elem) (getf elem :object)) new-values))))))
+ (map 'list #'(lambda(elem) (getf elem :object)) new-values))
+ (setf (object-datatype triple)
+ (map 'list #'(lambda(elem) (getf elem :object-datatype))
+ new-values))))))
construct))
@@ -477,13 +483,11 @@
(filter-by-given-object construct :revision revision))
(filter-by-special-uris construct :revision revision))))
(map 'list #'(lambda(result)
- ;(format t "-->~a<--~%" result) ;TODO: remove
(push (getf result :subject) (subject-result construct))
(push (getf result :predicate) (predicate-result construct))
- (push (getf result :object) (object-result 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, ...
+ (push (getf result :object) (object-result construct))
+ (push (getf result :literal-datatype)
+ (object-datatype construct)))
results)))))
@@ -1064,11 +1068,36 @@
(all-variables construct)
(variables construct))))
(cleaned-results (make-result-lists construct)))
- (map 'list #'(lambda(response-variable)
- (list :variable response-variable
- :result (variable-intersection response-variable
+ (let ((result
+ (map 'list #'(lambda(response-variable)
+ (let ((result
+ (variable-intersection response-variable
cleaned-results)))
- response-variables))))
+ (list :variable response-variable
+ :result (getf result :result)
+ :literal-datatype
+ (getf result :literal-datatype))))
+ response-variables)))
+ (cast-result-values result)))))
+
+
+(defun cast-result-values (result-values)
+ "Casts all literal values that are represented as a string to
+ the actual datatype."
+ (declare (List result-values))
+ (loop for set-idx to (1- (length result-values))
+ collect (let ((value-set (getf (elt result-values set-idx) :result))
+ (type-set (getf (elt result-values set-idx) :literal-datatype))
+ (var-name (getf (elt result-values set-idx) :variable)))
+ (list :variable var-name
+ :result
+ (loop for value-idx to (1- (length value-set))
+ when (elt type-set value-idx)
+ collect (cast-literal (elt value-set value-idx)
+ (elt type-set value-idx))
+ else
+ collect (elt value-set value-idx))))))
+
(defgeneric make-result-lists (construct)
@@ -1087,6 +1116,7 @@
:result (predicate-result triple)))
(when (variable-p (object triple))
(list :variable (value (object triple))
+ :literal-datatype (object-datatype triple)
:result (object-result triple)))))))))
@@ -1130,14 +1160,22 @@
(defun recursive-intersection (list-1 list-2 more-lists)
"Returns an intersection of al the passed lists."
(declare (List list-1 list-2))
- (let ((current-result
- (intersection list-1 list-2
- :test #'(lambda(val-1 val-2)
- (if (and (stringp val-1) (stringp val-2))
- (string= val-1 val-2)
- (eql val-1 val-2))))))
+ (let* ((current-result
+ (intersection (getf list-1 :result) (getf list-2 :result)
+ :test #'(lambda(val-1 val-2)
+ (if (and (stringp val-1) (stringp val-2))
+ (string= val-1 val-2)
+ (eql val-1 val-2)))))
+ (current-datatypes
+ (map 'list #'(lambda(result-entry)
+ (let ((pos (position result-entry (getf list-1 :result)
+ :test #'string=)))
+ (when (getf list-1 :literal-datatype)
+ (elt (getf list-1 :literal-datatype) pos))))
+ current-result)))
(if (not more-lists)
- current-result
+ (list :result current-result
+ :literal-datatype current-datatypes)
(recursive-intersection current-result (first more-lists)
(rest more-lists)))))
@@ -1157,10 +1195,13 @@
(:method ((construct SPARQL-Triple) (result-lists List))
(let* ((triple-variables (variables construct))
(intersections
- (map 'list #'(lambda(var)
- (list :variable var
- :result (variable-intersection
- var result-lists)))
+ (map 'list
+ #'(lambda(var)
+ (let ((result (variable-intersection
+ var result-lists)))
+ (list :variable var
+ :result (getf result :result)
+ :literal-datatype (getf result :literal-datatype))))
triple-variables)))
(map 'list #'(lambda(entry)
(delete-rows construct (getf entry :variable)
@@ -1197,11 +1238,14 @@
(find (elt var-elem idx) dont-touch-values)))
collect idx))
(new-result-list
- (map 'list
- #'(lambda(row-idx)
- (list :subject (elt (subject-result construct) row-idx)
- :predicate (elt (predicate-result construct) row-idx)
- :object (elt (object-result construct) row-idx)))
+ (map
+ 'list
+ #'(lambda(row-idx)
+ (list
+ :subject (elt (subject-result construct) row-idx)
+ :predicate (elt (predicate-result construct) row-idx)
+ :object (elt (object-result construct) row-idx)
+ :object-datatype (elt (object-datatype construct) row-idx)))
rows-to-hold)))
(setf (subject-result construct)
(map 'list #'(lambda(entry)
@@ -1211,7 +1255,10 @@
(getf entry :predicate)) new-result-list))
(setf (object-result construct)
(map 'list #'(lambda(entry)
- (getf entry :object)) new-result-list)))))))
+ (getf entry :object)) new-result-list))
+ (setf (object-datatype construct)
+ (map 'list #'(lambda(entry)
+ (getf entry :object-datatype)) new-result-list)))))))
(defgeneric results-for-variable (variable-name result-lists)
@@ -1224,7 +1271,8 @@
result-lists))
(values
(map 'list #'(lambda(entry)
- (getf entry :result))
+ (list :result (getf entry :result)
+ :literal-datatype (getf entry :literal-datatype)))
cleaned-result-lists)))
values)))
@@ -1244,7 +1292,7 @@
((string= literal-type *xml-decimal*)
(cast-literal-to-decimal literal-value))
(t ; return the value as a string
- literal-value)))
+ (concat "\"\"\"" literal-value "\"\"\"^^" literal-type))))
(defun cast-literal-to-decimal (literal-value)
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Tue Apr 5 17:12:56 2011
@@ -40,7 +40,21 @@
:test-set-compare-operators
:test-set-functions
:test-module-1
- :test-module-2))
+ :test-module-2
+ :test-all-1
+ :test-all-2
+ :test-all-3
+ :test-all-4
+ :test-all-5
+ :test-all-6
+ :test-all-7
+ :test-all-8
+ :test-all-9
+ :test-all-10
+ :test-all-11
+ :test-all-12
+ :test-all-13
+ :test-all-14))
(in-package :sparql-test)
@@ -219,7 +233,7 @@
(let ((res (tm-sparql::parse-literal-elem dummy-object query-6)))
(is (string= (getf res :next-query)
(concat "." (string #\newline))))
- (is (eql (tm-sparql::value (getf res :value)) 123.4))
+ (is (eql (tm-sparql::value (getf res :value)) 123.4d0))
(is-false (tm-sparql::literal-lang (getf res :value)))
(is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-double*))
@@ -2049,12 +2063,12 @@
(getf item :result)
(list "Johann Wolfgang" "von Goethe"
"Johann Wolfgang von Goethe" "Der Zauberlehrling"
- "28.08.1749" "22.03.1832" "82" "true" "false"
+ "28.08.1749" "22.03.1832" 82 t nil
"Hat der alte Hexenmeister
sich doch einmal wegbegeben!
...
")
- :test #'string=))
+ :test #'tm-sparql::literal=))
(t
(is-true (format t "bad variable-name found")))))
r-1))))
@@ -2346,31 +2360,22 @@
(let* ((q-1 (concat
"SELECT * WHERE {
<http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
- FILTER ?obj1 = 'von Goethe' || ?obj1 = '82'
- #FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
- #FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
- #FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
- #FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))"
+ FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
+ FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
+ FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
+ FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
+ FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))"
"
}"))
(r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
-
- ;;TODO: use all stored literal datatype information if existent and
- ;; cast the values to the actual objects
- ;; or
- ;; write all string values to the results in a quoted form,
- ;; it is also needed to escapte quotes in the actual string value
- ;; the filter is called with read-from-string, so a "12" will evaluate
- ;; to 12 and "\"abc\"" to "abc
-
(map 'list #'(lambda(triple)
- (format t "~a - ~a - ~a(~a)~%"
+ (format t "~a - ~a - ~a[~a]~%"
(tm-sparql::subject-result triple)
(tm-sparql::predicate-result triple)
(tm-sparql::object-result triple)
- (tm-sparql::literal-datatype triple)))
+ (tm-sparql::object-datatype triple)))
(tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
@@ -2388,6 +2393,8 @@
;TODO: test complex filters
+;TODO: check if object results are in the actual object-represenrtation and not as string
+;TODO: rename test-all-? test-module-?
(defun run-sparql-tests ()
(it.bese.fiveam:run! 'sparql-test:sparql-tests))
More information about the Isidorus-cvs
mailing list