[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