Changeset 423 for trunk/src/TM-SPARQL

Timestamp:

04/07/11 09:22:22 (14 years ago)

Author:

lgiessmann

Message:

TM-SPARQL: fixed another efficiency problem in the processing of filters

Location:

trunk/src/TM-SPARQL

Files:

• filter_wrappers.lisp (modified) (1 diff)
• sparql.lisp (modified) (3 diffs)
• sparql_filter.lisp (modified) (2 diffs)

trunk/src/TM-SPARQL/filter_wrappers.lisp ¶

@@ -153 +153 @@
 
 
+(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)))
 
 

trunk/src/TM-SPARQL/sparql.lisp ¶

@@ -395 +395 @@
   "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))))
 
 
@@ -414 +422 @@
 (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))
@@ -436 +445 @@
             (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)))))))))
 
 

trunk/src/TM-SPARQL/sparql_filter.lisp ¶

@@ -231 +231 @@
                  (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))))))
 
@@ -1001 +1017 @@
     (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=)))