[isidorus-cvs] r358 - in trunk/src: TM-SPARQL rest_interface unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Sat Dec 4 13:59:08 UTC 2010
Author: lgiessmann
Date: Sat Dec 4 08:59:08 2010
New Revision: 358
Log:
TM-SPARQL: added a method called "result"=>SPARQL-Query, so invoking it produces a result of the entier query; fixed a style warning in the RESTful-itnerface
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/rest_interface/set-up-json-interface.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 Sat Dec 4 08:59:08 2010
@@ -9,10 +9,8 @@
(defpackage :TM-SPARQL
(:use :cl :datamodel :base-tools :exceptions :constants)
- (:export :SPARQL-Query))
-
-;;TODO:
-;; *handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html
+ (:export :SPARQL-Query
+ :result))
(in-package :TM-SPARQL)
@@ -161,6 +159,21 @@
(:documentation "This class represents the entire request."))
+(defmethod variables ((construct SPARQL-Triple-Elem))
+ "Returns all variable names that are contained in the passed element."
+ (remove-duplicates
+ (remove-null
+ (loop for triple in (select-group construct)
+ collect (remove-null
+ (list (when (variable-p (subject construct))
+ (value (subject construct)))
+ (when (variable-p (predicate construct))
+ (value (predicate construct)))
+ (when (variable-p (object construct))
+ (value (object construct)))))))
+ :test #'string=))
+
+
(defgeneric add-triple (construct triple)
(:documentation "Adds a triple object to the select-group list.")
(:method ((construct SPARQL-Query) (triple SPARQL-Triple))
@@ -742,6 +755,162 @@
assocs)))))
+
+(defgeneric result (construct)
+ (:documentation "Returns the result of the entire query.")
+ (:method ((construct SPARQL-Query))
+ (let ((result-lists (make-result-lists construct)))
+ (reduce-results construct result-lists)
+ (let* ((response-variables (variables construct))
+ (cleaned-results (make-result-lists construct)))
+ (map 'list #'(lambda(response-variable)
+ (variable-intersection response-variable
+ cleaned-results))
+ response-variables)))))
+
+
+(defgeneric make-result-lists (construct)
+ (:documentation "Returns a list of the form ((:variable 'var-name'
+ :result (<any-object>)).")
+ (:method ((construct SPARQL-Query))
+ (remove-null
+ (loop for triple in (select-group construct)
+ collect (remove-null
+ (list
+ (when (variable-p (subject construct))
+ (list :variable (value (subject construct))
+ :result (subject-result construct)))
+ (when (variable-p (predicate construct))
+ (list :variable (value (predicate construct))
+ :result (predicate-result construct)))
+ (when (variable-p (object construct))
+ (list :variable (value (object construct))
+ :result (object-result construct)))))))))
+
+
+(defgeneric all-variables (result-lists)
+ (:documentation "Returns a list of all variables that are contained in
+ the passed result-lists.")
+ (:method ((result-lists List))
+ (remove-duplicates
+ (map 'list #'(lambda(entry)
+ (getf entry :variable))
+ result-lists)
+ :test #'string=)))
+
+
+(defgeneric variable-intersection (variable-name result-lists)
+ (:documentation "Returns a list with all results of the passed variable
+ that are contained in the result-lists. All results is
+ an intersection of all paratial results.")
+ (:method ((variable-name String) (result-lists List))
+ (let* ((all-values (results-for-variable variable-name result-lists))
+ (list-1 (when (>= (length all-values) 1)
+ (first all-values)))
+ (list-2 (if (> (length all-values) 2)
+ (second all-values)
+ list-1))
+ (more-lists (rest (rest all-values))))
+ (recursive-intersection list-1 list-2 more-lists))))
+
+
+(defun recursive-intersection (list-1 list-2 &rest 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))))))
+ (if (= (length more-lists) 0)
+ current-result
+ (apply #'recursive-intersection current-result
+ (first more-lists) (rest more-lists)))))
+
+
+(defgeneric reduce-results(construct result-lists)
+ (:documentation "Reduces the select-group of the passed construct by processing
+ all triples with the intersection-results.")
+ (:method ((construct SPARQL-Query) (result-lists List))
+ (map 'list #'(lambda(triple)
+ (reduce-triple triple result-lists))
+ (select-group construct))))
+
+
+(defgeneric reduce-triple(construct result-lists)
+ (:documentation "Reduces the results of a triple by using only the
+ intersection values.")
+ (:method ((construct SPARQL-Triple-Elem) (result-lists List))
+ (let* ((triple-variables (variables construct))
+ (intersections
+ (map 'list #'(lambda(var)
+ (list :variable var
+ :result (variable-intersection
+ var result-lists)))
+ triple-variables)))
+ (map 'list #'(lambda(entry)
+ (delete-rows construct (getf entry :variable)
+ (getf entry :result)))
+ intersections))))
+
+
+(defgeneric delete-rows (construct variable-name dont-touch-values)
+ (:documentation "Checks all results of the passed variable of the given
+ construct and deletes every result with the corresponding
+ row that is not contained in the dont-touch-values.")
+ (:method ((construct SPARQL-Triple-Elem) (variable-name String)
+ (dont-touch-values List))
+ (let ((var-elem
+ (cond ((and (variable-p (subject construct))
+ (string= (value (subject construct)) variable-name))
+ (subject-result construct))
+ ((and (variable-p (predicate construct))
+ (string= (value (predicate construct)) variable-name))
+ (predicate-result construct))
+ ((and (variable-p (object construct))
+ (string= (value (object construct)) variable-name))
+ (object-result construct)))))
+ (if (not var-elem)
+ construct
+ (let* ((rows-to-hold
+ (remove-null
+ (map 'list #'(lambda(val)
+ (if (stringp val)
+ (position val var-elem :test #'string=)
+ (position val var-elem)))
+ var-elem)))
+ (new-result-list
+ (dolist (row-idx rows-to-hold)
+ (list :subject (elt (subject-result construct) row-idx)
+ :predicate (elt (predicate-result construct) row-idx)
+ :object (elt (object-result construct) row-idx)))))
+ (setf (subject-result construct)
+ (map 'list #'(lambda(entry)
+ (getf entry :subject)) new-result-list))
+ (setf (predicate-result construct)
+ (map 'list #'(lambda(entry)
+ (getf entry :predicate)) new-result-list))
+ (setf (object-result construct)
+ (map 'list #'(lambda(entry)
+ (getf entry :object)) new-result-list)))))))
+
+
+(defgeneric results-for-variable (variable-name result-lists)
+ (:documentation "Returns a list with result-lists for the passed variable.")
+ (:method ((variable-name String) (result-lists List))
+ (let* ((cleaned-result-lists
+ (remove-if-not #'(lambda(entry)
+ (string= (getf entry :variable)
+ variable-name))
+ result-lists))
+ (values
+ (map 'list #'(lambda(entry)
+ (getf entry :result))
+ cleaned-result-lists)))
+ values)))
+
+
(defmethod initialize-instance :after ((construct SPARQL-Query) &rest args)
(declare (ignorable args))
(parser-start construct (original-query construct))
Modified: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- trunk/src/rest_interface/set-up-json-interface.lisp (original)
+++ trunk/src/rest_interface/set-up-json-interface.lisp Sat Dec 4 08:59:08 2010
@@ -428,8 +428,10 @@
(if result
(progn
(when (typep result 'd:TopicC)
- (delete (elephant::oid result) *type-table*)
- (delete (elephant::oid result) *instance-table*))
+ (append ;;the append function is used only for suppress
+ ;;style warnings of unused delete return values
+ (delete (elephant::oid result) *type-table*)
+ (delete (elephant::oid result) *instance-table*)))
(format nil "")) ;operation succeeded
(progn
(setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Sat Dec 4 08:59:08 2010
@@ -19,6 +19,7 @@
(:export :run-sparql-tests
:sparql-tests
:test-prefix-and-base
+ :test-variable-names
:test-parse-literals
:test-parse-triple-elem
:test-parse-group-1
@@ -180,61 +181,61 @@
(query-9 (concatenate 'string "\"13e4\"^^" *xml-boolean* " ."))
(dummy-object (make-instance 'SPARQL-Query :query "")))
(is-true dummy-object)
- (let ((result (tm-sparql::parse-literal-elem query-1 dummy-object)))
- (is (string= (getf result :next-query) "."))
- (is (string= (tm-sparql::value (getf result :value))
+ (let ((res (tm-sparql::parse-literal-elem query-1 dummy-object)))
+ (is (string= (getf res :next-query) "."))
+ (is (string= (tm-sparql::value (getf res :value))
"literal-value"))
- (is (string= (tm-sparql::literal-lang (getf result :value))
+ (is (string= (tm-sparql::literal-lang (getf res :value))
"de"))
- (is (string= (tm-sparql::literal-datatype (getf result :value))
+ (is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-string*))
- (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL)))
- (let ((result (tm-sparql::parse-literal-elem query-2 dummy-object)))
- (is (string= (getf result :next-query) "."))
- (is (eql (tm-sparql::value (getf result :value)) t))
- (is-false (tm-sparql::literal-lang (getf result :value)))
- (is (string= (tm-sparql::literal-datatype (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
+ (let ((res (tm-sparql::parse-literal-elem query-2 dummy-object)))
+ (is (string= (getf res :next-query) "."))
+ (is (eql (tm-sparql::value (getf res :value)) t))
+ (is-false (tm-sparql::literal-lang (getf res :value)))
+ (is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-boolean*))
- (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL)))
- (let ((result (tm-sparql::parse-literal-elem query-3 dummy-object)))
- (is (string= (getf result :next-query) "}"))
- (is (eql (tm-sparql::value (getf result :value)) nil))
- (is-false (tm-sparql::literal-lang (getf result :value)))
- (is (string= (tm-sparql::literal-datatype (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
+ (let ((res (tm-sparql::parse-literal-elem query-3 dummy-object)))
+ (is (string= (getf res :next-query) "}"))
+ (is (eql (tm-sparql::value (getf res :value)) nil))
+ (is-false (tm-sparql::literal-lang (getf res :value)))
+ (is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-boolean*))
- (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL)))
- (let ((result (tm-sparql::parse-literal-elem query-4 dummy-object)))
- (is (string= (getf result :next-query) (string #\tab)))
- (is (= (tm-sparql::value (getf result :value)) 1234.43e10))
- (is-false (tm-sparql::literal-lang (getf result :value)))
- (is (string= (tm-sparql::literal-datatype (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
+ (let ((res (tm-sparql::parse-literal-elem query-4 dummy-object)))
+ (is (string= (getf res :next-query) (string #\tab)))
+ (is (= (tm-sparql::value (getf res :value)) 1234.43e10))
+ (is-false (tm-sparql::literal-lang (getf res :value)))
+ (is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-double*))
- (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL)))
- (let ((result (tm-sparql::parse-literal-elem query-5 dummy-object)))
- (is (string= (getf result :next-query) ";"))
- (is (eql (tm-sparql::value (getf result :value)) t))
- (is-false (tm-sparql::literal-lang (getf result :value)))
- (is (string= (tm-sparql::literal-datatype (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
+ (let ((res (tm-sparql::parse-literal-elem query-5 dummy-object)))
+ (is (string= (getf res :next-query) ";"))
+ (is (eql (tm-sparql::value (getf res :value)) t))
+ (is-false (tm-sparql::literal-lang (getf res :value)))
+ (is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-boolean*))
- (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL)))
- (let ((result (tm-sparql::parse-literal-elem query-6 dummy-object)))
- (is (string= (getf result :next-query)
+ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
+ (let ((res (tm-sparql::parse-literal-elem query-6 dummy-object)))
+ (is (string= (getf res :next-query)
(concatenate 'string "." (string #\newline))))
- (is (eql (tm-sparql::value (getf result :value)) 123.4))
- (is-false (tm-sparql::literal-lang (getf result :value)))
- (is (string= (tm-sparql::literal-datatype (getf result :value))
+ (is (eql (tm-sparql::value (getf res :value)) 123.4))
+ (is-false (tm-sparql::literal-lang (getf res :value)))
+ (is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-double*))
- (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL)))
- (let ((result (tm-sparql::parse-literal-elem query-7 dummy-object)))
- (is (string= (getf result :next-query) "."))
- (is (string= (tm-sparql::value (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
+ (let ((res (tm-sparql::parse-literal-elem query-7 dummy-object)))
+ (is (string= (getf res :next-query) "."))
+ (is (string= (tm-sparql::value (getf res :value))
"Just a test
literal with some \\\"quoted\\\" words!"))
- (is (string= (tm-sparql::literal-lang (getf result :value)) "en"))
- (is (string= (tm-sparql::literal-datatype (getf result :value))
+ (is (string= (tm-sparql::literal-lang (getf res :value)) "en"))
+ (is (string= (tm-sparql::literal-datatype (getf res :value))
*xml-string*))
- (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL)))
+ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
(signals sparql-parser-error
(tm-sparql::parse-literal-elem query-8 dummy-object))
(signals sparql-parser-error
@@ -256,38 +257,38 @@
(var 'TM-SPARQL::VARIABLE)
(iri 'TM-SPARQL::IRI))
(tm-sparql::add-prefix dummy-object "pref" "http://prefix.value")
- (let ((result (tm-sparql::parse-triple-elem query-1 dummy-object)))
- (is (string= (getf result :next-query) "."))
- (is (string= (tm-sparql::value (getf result :value)) "var1"))
- (is (eql (tm-sparql::elem-type (getf result :value)) var)))
- (let ((result (tm-sparql::parse-triple-elem query-2 dummy-object)))
- (is (string= (getf result :next-query) ";"))
- (is (string= (tm-sparql::value (getf result :value)) "var2"))
- (is (eql (tm-sparql::elem-type (getf result :value)) var)))
- (let ((result (tm-sparql::parse-triple-elem query-3 dummy-object)))
- (is (string= (getf result :next-query) "}"))
- (is (string= (tm-sparql::value (getf result :value)) "var3"))
- (is (eql (tm-sparql::elem-type (getf result :value)) var)))
- (let ((result (tm-sparql::parse-triple-elem query-4 dummy-object)))
- (is (string= (getf result :next-query) "."))
- (is (string= (tm-sparql::value (getf result :value))
+ (let ((res (tm-sparql::parse-triple-elem query-1 dummy-object)))
+ (is (string= (getf res :next-query) "."))
+ (is (string= (tm-sparql::value (getf res :value)) "var1"))
+ (is (eql (tm-sparql::elem-type (getf res :value)) var)))
+ (let ((res (tm-sparql::parse-triple-elem query-2 dummy-object)))
+ (is (string= (getf res :next-query) ";"))
+ (is (string= (tm-sparql::value (getf res :value)) "var2"))
+ (is (eql (tm-sparql::elem-type (getf res :value)) var)))
+ (let ((res (tm-sparql::parse-triple-elem query-3 dummy-object)))
+ (is (string= (getf res :next-query) "}"))
+ (is (string= (tm-sparql::value (getf res :value)) "var3"))
+ (is (eql (tm-sparql::elem-type (getf res :value)) var)))
+ (let ((res (tm-sparql::parse-triple-elem query-4 dummy-object)))
+ (is (string= (getf res :next-query) "."))
+ (is (string= (tm-sparql::value (getf res :value))
"http://full.url"))
- (is (eql (tm-sparql::elem-type (getf result :value)) iri)))
- (let ((result (tm-sparql::parse-triple-elem query-5 dummy-object)))
- (is (string= (getf result :next-query) "}"))
- (is (string= (tm-sparql::value (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
+ (let ((res (tm-sparql::parse-triple-elem query-5 dummy-object)))
+ (is (string= (getf res :next-query) "}"))
+ (is (string= (tm-sparql::value (getf res :value))
"http://base.value/url-suffix"))
- (is (eql (tm-sparql::elem-type (getf result :value)) iri)))
- (let ((result (tm-sparql::parse-triple-elem query-6 dummy-object)))
- (is (string= (getf result :next-query) "."))
- (is (string= (tm-sparql::value (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
+ (let ((res (tm-sparql::parse-triple-elem query-6 dummy-object)))
+ (is (string= (getf res :next-query) "."))
+ (is (string= (tm-sparql::value (getf res :value))
"http://prefix.value/suffix"))
- (is (eql (tm-sparql::elem-type (getf result :value)) iri)))
- (let ((result (tm-sparql::parse-triple-elem query-7 dummy-object)))
- (is (string= (getf result :next-query) "}"))
- (is (string= (tm-sparql::value (getf result :value))
+ (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
+ (let ((res (tm-sparql::parse-triple-elem query-7 dummy-object)))
+ (is (string= (getf res :next-query) "}"))
+ (is (string= (tm-sparql::value (getf res :value))
"http://prefix.value/suffix"))
- (is (eql (tm-sparql::elem-type (getf result :value)) iri)))
+ (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
(signals sparql-parser-error
(tm-sparql::parse-triple-elem query-8 dummy-object))))
More information about the Isidorus-cvs
mailing list