Author: lgiessmann Date: Sun Apr 3 15:56:15 2011 New Revision: 410
Log: TM-SPARQL: fixed a bug in the processing of final results when making intersections of all triples containing the same variable; finished the unit-tests for triples of the form <subj> ?var1 ?var2
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 Sun Apr 3 15:56:15 2011 @@ -576,10 +576,11 @@ (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))) + (when (and subj-uri pred-uri) + (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))))) @@ -602,13 +603,14 @@ 2) (find-if #'(lambda(r) (not (eql r role))) (roles assoc :revision revision)))))) - (list :subject - (when-do plr (player orole :revision revision) - (sparql-node plr :revision revision)) - :predicate - (when-do type (instance-of role :revision revision) - (sparql-node type :revision revision)) - :object obj-uri))) + (when orole + (list :subject + (when-do plr (player orole :revision revision) + (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)))))
@@ -664,15 +666,16 @@ (find-if #'(lambda(r) (not (eql r role))) (roles assoc :revision revision))))) - (list :subject - (when-do plr (player orole :revision revision) - (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))))) + (when (and orole assoc) + (list :subject + (when-do plr (player orole :revision revision) + (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))))))
@@ -711,14 +714,16 @@ (remove-null (map 'list #'(lambda(name) - (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*)) + (when (and (parent name :revision revision) + (instance-of name :revision revision)) + (list :subject + (sparql-node (parent name :revision revision) + :revision revision) + :predicate + (sparql-node (instance-of name :revision revision) + :revision revision) + :object (charvalue name) + :literal-datatype *xml-string*))) names-by-literal))))))
@@ -748,14 +753,16 @@ (remove-null (map 'list #'(lambda(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))) + (when (and (parent occ :revision revision) + (instance-of occ :revision revision)) + (list :subject + (sparql-node (parent occ :revision revision) + :revision revision) + :predicate + (sparql-node (instance-of occ :revision revision) + :revision revision) + :object (charvalue occ) + :literal-datatype (datatype occ)))) all-occs))))))
@@ -771,9 +778,9 @@ (cond ((variable-p (object construct)) (when (typep subj 'TopicC) (append (filter-characteristics - subj pred nil nil :revision revision) - (filter-associations - subj pred nil :revision revision)))) + subj pred nil nil :revision revision) + (filter-associations + subj pred nil :revision revision)))) ((literal-p (object construct)) (when (typep subj 'TopicC) (filter-characteristics @@ -937,13 +944,13 @@ (subj-uri (sparql-node construct :revision revision))) (remove-null (map 'list #'(lambda(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))) + (when (instance-of occ :revision revision) + (list :subject subj-uri + :predicate (sparql-node + (instance-of occ :revision revision) + :revision revision) + :object (charvalue occ) + :literal-datatype (datatype occ)))) all-occs)))))
@@ -968,15 +975,15 @@ (names construct :revision revision))) (all-names (intersection by-type by-literal)) (subj-uri (sparql-node construct :revision revision))) - (remove-null - (map 'list #'(lambda(name) - (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))))) + (map 'list #'(lambda(name) + (when (instance-of name :revision revision) + (list :subject subj-uri + :predicate (sparql-node + (instance-of name :revision revision) + :revision revision) + :object (charvalue name) + :literal-datatype *xml-string*))) + all-names))))
(defgeneric filter-characteristics (construct type-top literal-value @@ -1037,9 +1044,10 @@ (when-do player-top (player other-role :revision revision) (sparql-node player-top :revision revision))))) - (list :subject subj-uri - :predicate pred-uri - :object obj-uri)))) + (when (and subj-uri pred-uri obj-uri) + (list :subject subj-uri + :predicate pred-uri + :object obj-uri))))) assocs)))))
@@ -1065,6 +1073,8 @@ (remove-null (loop for triple in (select-group construct) append (remove-null + ;;TODO: replace remove-null by a function that check if any of the + ;; list items is nil, if so the entire list should be nil (list (when (variable-p (subject triple)) (list :variable (value (subject triple)) @@ -1102,7 +1112,7 @@ (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.") + an intersection of all partial 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) @@ -1135,7 +1145,7 @@ (:method ((construct SPARQL-Query) (result-lists List)) (map 'list #'(lambda(triple) (reduce-triple triple result-lists)) - (select-group construct)))) + (select-group construct))))
(defgeneric reduce-triple(construct result-lists) @@ -1155,6 +1165,7 @@ 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 @@ -1173,17 +1184,15 @@ (object-result construct))))) (when var-elem (let* ((rows-to-hold - (remove-null - (map 'list #'(lambda(res) - (when (cond - ((stringp res) - (find res dont-touch-values :test #'string=)) - ((numberp res) - (find res dont-touch-values :test #'=)) - (t - (find res dont-touch-values))) - (position res var-elem))) - var-elem))) + (loop for idx to (max 0 (1- (length var-elem))) + when (cond + ((stringp (elt var-elem idx)) + (find (elt var-elem idx) dont-touch-values :test #'string=)) + ((numberp (elt var-elem idx)) + (find (elt var-elem idx) dont-touch-values :test #'=)) + (t + (find (elt var-elem idx) dont-touch-values))) + collect idx)) (new-result-list (map 'list #'(lambda(row-idx)
Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Apr 3 15:56:15 2011 @@ -16,7 +16,8 @@ :unittests-constants :fixtures :d - :constants) + :constants + :tm-sparql-constants) (:export :run-sparql-tests :sparql-tests :test-prefix-and-base @@ -2075,14 +2076,105 @@ "}")) (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) (is-true (= (length r-1) 12)) - - (format t "~a~%" r-1)))) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "pred1") + ;one name without a type so it is not listed + (is (= (length (getf item :result)) 9))) + ((string= (getf item :variable) "pred2") + (is (= (length (getf item :result)) 3)) + (is-false (set-exclusive-or + (getf item :result) + (list (concat "<" *tms-role* ">") + (concat "<" *tms-reifier* ">")) + :test #'string=))) + ((string= (getf item :variable) "pred3") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-player* ">")))) + ((string= (getf item :variable) "pred4") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-value* ">")))) + ((string= (getf item :variable) "pred5") + (is (= (length (getf item :result)) 2)) + (is-false (set-exclusive-or + (getf item :result) + (list (concat "<" *tms-value* ">") + (concat "<" *tms-reifier* ">")) + :test #'string=))) + ((string= (getf item :variable) "pred6") + (is (= (length (getf item :result)) 2)) + (is-false (set-exclusive-or + (getf item :result) + (list (concat "<" *tms-value* ">") + (concat "<" *tms-scope* ">")) + :test #'string=))) + ((string= (getf item :variable) "obj1") + (is (= (length (getf item :result)) 9)) + (is-false (set-exclusive-or + (getf item :result) + (list "Johann Wolfgang" "von Goethe" + "28.08.1749" "22.03.1832" "82" + "true" "false" + "http://some.where/tmsparql/author" + "http://some.where/psis/poem/zauberlehrling") + :test #'string=))) + ((string= (getf item :variable) "obj2") + (is (= (length (getf item :result)) 3)) + (is-false + (set-exclusive-or + (getf item :result) + (list + "http://some.where/ii/association-reifier" + "http://some.where/ii/role-2" + (concat + "_:r" + (write-to-string + (elephant::oid + (loop for role in + (roles + (get-item-by-item-identifier + "http://some.where/ii/association" + :revision 0)) + when (string= + (uri (first (psis (player role + :revision 0)))) + "http://some.where/tmsparql/author/goethe") + return role))))) + :test #'string=))) + ((string= (getf item :variable) "obj3") + (is (= (length (getf item :result)) 1)) + (is (string= + (first (getf item :result)) + "http://some.where/psis/poem/zauberlehrling"))) + ((string= (getf item :variable) "obj4") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + "Johann Wolfgang von Goethe"))) + ((string= (getf item :variable) "obj5") + (is (= (length (getf item :result)) 2)) + (is-false + (set-exclusive-or + (getf item :result) + (list "28.08.1749" + "http://some.where/ii/goethe-occ-reifier") + :test #'string=))) + ((string= (getf item :variable) "obj6") + (is (= (length (getf item :result)) 2)) + (is-false + (set-exclusive-or + (getf item :result) + (list "Goethe" + "http://some.where/tmsparql/display-name") + :test #'string=))) + (t + (is-true (format t "bad variable-name found"))))) + r-1))))
;TODO: complex filter, ; complex relations between variables -; <subj> ?pred ?obj, ; ?subj ?pred <obj> ;TODO: PREFIX tms:http://www.networkedplanet.com/tmsparql/ ; SELECT * WHERE {