[isidorus-cvs] r423 - in trunk/src: TM-SPARQL unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Thu Apr 7 09:22:22 UTC 2011
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 " " "")
More information about the Isidorus-cvs
mailing list