Author: lgiessmann Date: Thu Apr 7 05:22:22 2011 New Revision: 423
Log: TM-SPARQL: fixed another efficiency problem in the processing of filters
Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_filter.lisp trunk/src/unit_tests/sparql_test.lisp
Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp ============================================================================== --- trunk/src/TM-SPARQL/filter_wrappers.lisp (original) +++ trunk/src/TM-SPARQL/filter_wrappers.lisp Thu Apr 7 05:22:22 2011 @@ -152,8 +152,12 @@ (ppcre:scan scanner local-str)))
+(defun filter-functions::write-to-symbol (name-string) + (common-lisp:intern (common-lisp:string-upcase name-string))) + + (defun filter-functions::bound(x) - (boundp x)) + (boundp (filter-functions::write-to-symbol x)))
(defun filter-functions::isLITERAL(x)
Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Thu Apr 7 05:22:22 2011 @@ -394,14 +394,22 @@ (defun return-false-values (all-values true-values) "Returns a list that contains all values from all-values that are not contained in true-values." - (let ((local-all-values - (remove-duplicates (reduce #'(lambda(x y) (append x y)) all-values) - :test #'variable-list=)) - (results nil)) - (dolist (value local-all-values) - (when (not (find value true-values :test #'variable-list=)) - (push value results))) - results)) + (cond ((not all-values) + nil) + ((not true-values) + (let ((local-all-values + (remove-duplicates (reduce #'(lambda(x y) (append x y)) all-values) + :test #'variable-list=))) + local-all-values)) + (t + (let ((local-all-values + (remove-duplicates (reduce #'(lambda(x y) (append x y)) all-values) + :test #'variable-list=)) + (results nil)) + (dolist (value local-all-values) + (when (not (find value true-values :test #'variable-list=)) + (push value results))) + results))))
(defun variable-list= (x y) @@ -413,15 +421,16 @@
(defgeneric process-filters (construct) (:documentation "Processes all filters by calling invoke-filter.") - (:method ((construct SPARQL-Query)) + (:method ((construct SPARQL-Query)) (dolist (filter (filters construct)) - (let* ((filter-variable-names - (get-variables-from-filter-string filter)) - (filter-variable-values nil)) + (let ((filter-variable-names (get-variables-from-filter-string filter)) + (filter-variable-values nil)) (dolist (var-name filter-variable-names) (setf filter-variable-values (make-variable-values construct var-name filter-variable-values))) (setf filter-variable-values + (remove-duplicates-from-variable-list construct filter-variable-values)) + (setf filter-variable-values (cast-variable-values construct filter-variable-values)) (let ((true-values nil)) (dolist (var-elem filter-variable-values) @@ -435,8 +444,41 @@ :test #'variable-list=)))) (dolist (to-del values-to-remove) (delete-rows-by-value construct (getf to-del :variable-name) - (getf to-del :variable-value))))))) - construct)) + (getf to-del :variable-value))))))))) + + +(defgeneric remove-duplicates-from-variable-list (construct variable-list) + (:documentation "Removes all duplicates from the passed variable list") + (:method ((construct SPARQL-QUERY) (variable-list LIST)) + (remove-duplicates + variable-list + :test #'(lambda(x y) + (when (= (length x) (length y)) + (let ((result nil)) + (dotimes (idx (length x) result) + (let ((cx (elt x idx)) + (cy (elt y idx))) + (when (or (string/= (getf cx :variable-name) + (getf cy :variable-name)) + (and (getf cx :literal-datatype) + (getf cy :literal-datatype) + (string/= (getf cx :literal-datatype) + (getf cy :literal-datatype))) + (and (getf cx :literal-datatype) + (not (getf cy :literal-datatype))) + (and (not (getf cx :literal-datatype)) + (getf cy :literal-datatype)) + (and (getf cx :variable-value) + (getf cy :variable-value) + (string/= (getf cx :variable-value) + (getf cy :variable-value))) + (and (getf cx :variable-value) + (not (getf cy :variable-value))) + (and (not (getf cx :variable-value)) + (getf cy :variable-value))) + (setf idx (length x)))) + (when (= idx (max 0 (1- (length x)))) + (setf result t)))))))))
(defgeneric idx-of (construct variable-name variable-value &key what)
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Thu Apr 7 05:22:22 2011 @@ -230,11 +230,27 @@ (arg-list (bracket-scope cleaned-right-str)) (cleaned-arg-list (clean-function-arguments arg-list)) (modified-str - (concat - left-str "(" fun-name " " cleaned-arg-list ")" - (subseq right-str (+ (- (length right-str) - (length cleaned-right-str)) - (length arg-list)))))) + (let ((modified-arg-list + (if (string= fun-name "BOUND") + (let* ((var-start + (search-first (list "?" "$") cleaned-arg-list)) + (var-end + (when var-start + (search-first + (list ")") + (subseq cleaned-arg-list var-start))))) + (when (and var-start var-end) + (concat (subseq cleaned-arg-list 0 var-start) + """ (subseq cleaned-arg-list var-start + (+ var-start var-end)) + """ (subseq cleaned-arg-list + (+ var-start var-end))))) + cleaned-arg-list))) + (concat + left-str "(" fun-name " " modified-arg-list ")" + (subseq right-str (+ (- (length right-str) + (length cleaned-right-str)) + (length arg-list))))))) (set-functions construct modified-str))))))
@@ -1000,20 +1016,33 @@ (let ((variables nil)) (dotimes (idx (length filter-string)) (let ((current-string (subseq filter-string idx))) - (when (and (or (string-starts-with current-string "?") - (string-starts-with current-string "$")) - (not (in-literal-string-p filter-string idx))) - (let ((end-pos - (let ((inner-value - (search-first - (append (list " " "?" "$" "." ",") - (*supported-operators*) - *supported-brackets* - (map 'list #'string (white-space))) - (subseq current-string 1)))) - (if inner-value - (1+ inner-value) - (length current-string))))) - (push (subseq current-string 1 end-pos) variables) - (incf idx end-pos))))) + (cond ((and (or (string-starts-with current-string "?") + (string-starts-with current-string "$")) + (not (in-literal-string-p filter-string idx))) + (let ((end-pos + (let ((inner-value + (search-first + (append (list " " "?" "$" "." ",") + (*supported-operators*) + *supported-brackets* + (map 'list #'string (white-space))) + (subseq current-string 1)))) + (if inner-value + (1+ inner-value) + (length current-string))))) + (push (subseq current-string 1 end-pos) variables) + (incf idx end-pos))) + ;BOUND needs a separate hanlding since all variables + ; were written into strings so they have to be + ; searched different + ((and (string-starts-with current-string "BOUND ") + (not (in-literal-string-p filter-string idx))) + (let* ((next-str (subseq current-string (length "BOUND "))) + (literal (when (string-starts-with next-str """) + (let ((val (get-literal next-str))) + (when val + (getf val :literal)))))) + (when (and literal (> (length literal) 3)) ;"?.." | "$.." + (push (subseq (string-trim (list #") literal) 1) variables)) + (incf idx (+ (length "BOUND ") (length literal)))))))) (remove-duplicates variables :test #'string=))) \ No newline at end of file
Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Thu Apr 7 05:22:22 2011 @@ -1530,7 +1530,7 @@ (is-true result-5) (is-true result-5-2) (is-true result-5-3) (is-true result-5-4) (is-true result-5-5) (is-true result-5-6) (is (string= (string-replace result-1-6 " " "") - "(or(progn(BOUND(progn(progn?var))))(progn(progn(and(progn(isLITERAL$var))(progn(=?var"abc"))))))")) + "(or(progn(BOUND(progn(progn"?var"))))(progn(progn(and(progn(isLITERAL$var))(progn(=?var"abc"))))))")) (is (string= (string-replace result-2-6 " " "") "(progn(or(progn(REGEX?var1""?var3))(progn(progn(and(progn(>?var1?var3))(progn(progn(=(STR?var)"abc"))))))))")) (is (string= (string-replace result-3-6 " " "")