Mercurial > hg > audiodb

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bindings/sb-alien/interface.lisp	Wed Jan 21 21:48:25 2009 +0000
@@ -0,0 +1,362 @@
+(in-package "SB-ADB")
+
+(defclass adb ()
+  ((alien :initarg alien)))
+(defmethod initialize-instance :after ((o adb) &key)
+  (when (and (slot-boundp o 'alien)
+             (not (null-alien (slot-value o 'alien))))
+    (let ((alien (slot-value o 'alien)))
+      (sb-ext:finalize o (lambda () (%close alien))))))
+
+;;; FIXME: deal with interrupt-safety / leak issues
+
+;;; FIXME: if-does-not-exist.
+(defun open (path &key (direction :input) (if-exists :error) (adb-class 'adb))
+  (flet ((direction-flag (direction)
+           (ecase direction
+             ((:input :probe) sb-posix:o-rdonly)
+             ((:output :io) sb-posix:o-rdwr))))
+    (let* ((truepath (probe-file path))
+           (alien (cond
+                    (truepath
+                     (ecase direction
+                       ((:input :probe)
+                        (%%open path (direction-flag direction)))
+                       ((:output :io)
+                        (case if-exists
+                          (:error (error "database already exists: ~S" path))
+                          (:append (%open path (direction-flag direction)))
+                          ;; FIXME: not the best implementation of
+                          ;; :SUPERSEDE semantics ever.
+                          (:supersede (delete-file path) (%create path 0 0 0))))))
+                    ((eql direction :input)
+                     (error "database does not exist: ~S" path))
+                    (t (%create path 0 0 0)))))
+      (cond
+        ((null-alien alien)
+         (case direction
+           (:probe nil)
+           (t (error "opening database failed: ~S" path))))
+        (t (make-instance adb-class 'alien alien))))))
+(defmethod close ((o adb))
+  (when (and (slot-boundp o 'alien)
+             (not (null-alien (slot-value o 'alien))))
+    (%close (slot-value o 'alien))
+    (sb-ext:cancel-finalization o)
+    (slot-makunbound o 'alien)))
+(defmacro with-adb ((adb path &rest open-args &key direction adb-class if-exists)
+                    &body body)
+  (declare (ignore direction adb-class if-exists))
+  `(let ((,adb (open ,path ,@open-args)))
+     (unwind-protect
+          (locally ,@body)
+       (close ,adb))))
+
+(defgeneric l2norm (db))
+(defmethod l2norm ((db adb))
+  (%l2norm (slot-value db 'alien)))
+
+(defstruct (datum
+             (:constructor %make-datum)
+             (:constructor
+              make-datum
+              (key %data &key times power
+               &aux (data
+                     (make-array (list (length %data) (length (elt %data 0)))
+                                 :element-type 'double-float
+                                 :initial-contents %data)))))
+  (key (error "missing argument") :type string)
+  (data (error "missing argument") :type (simple-array double-float (* *)))
+  (times nil :type (or null (simple-array double-float)))
+  (power nil :type (or null (simple-array double-float))))
+
+(defgeneric insert (datum db))
+
+(defmethod insert ((datum datum) (db adb))
+  (let* ((data (datum-data datum))
+         (nvectors (array-dimension data 0))
+         (dim (array-dimension data 1)))
+    (when (datum-times datum)
+      (unless (= (array-total-size (datum-times datum)) (* 2 nvectors))
+        (error "dimension mismatch for times: ~S" datum)))
+    (when (datum-power datum)
+      (unless (= (array-total-size (datum-power datum)) nvectors)
+        (error "dimension mismatch for power: ~S" datum)))
+    (with-alien ((d adb-datum-t))
+      (sb-sys:with-pinned-objects ((datum-data datum)
+                                   (datum-times datum)
+                                   (datum-power datum))
+        (setf (slot d 'dim) dim)
+        (setf (slot d 'nvectors) nvectors)
+        (setf (slot d 'key) (datum-key datum))
+        (setf (slot d 'data)
+              (sb-sys:vector-sap (sb-ext:array-storage-vector (datum-data datum))))
+        (if (datum-times datum)
+            (setf (slot d 'times) (sb-sys:vector-sap (sb-ext:array-storage-vector (datum-times datum))))
+            (setf (slot d 'times) nil))
+        (if (datum-power datum)
+            (setf (slot d 'power) (sb-sys:vector-sap (sb-ext:array-storage-vector (datum-times datum))))
+            (setf (slot d 'power) nil))
+        (sb-int:with-float-traps-masked (:invalid)
+          (%insert-datum (slot-value db 'alien) (addr d)))))))
+
+(defstruct result
+  (key "" :type string)
+  (distance 0d0 :type double-float)
+  (qpos 0 :type (and unsigned-byte fixnum))
+  (ipos 0 :type (and unsigned-byte fixnum)))
+
+;;; Hrm.  To copy (from the malloc heap) or not to copy?  Copying
+;;; would make things generally easier, I guess, and we have to hope
+;;; that the order of magnitude is not such that the copying causes
+;;; pain.
+(defclass results (sequence standard-object)
+  ())
+(defclass copied-query-results (results)
+  ((results :initarg results :accessor %copied-results)))
+(defmethod print-object ((o copied-query-results) s)
+  (pprint-logical-block (s nil)
+    (print-unreadable-object (o s :type t)
+      (format s "(~D results):~2I~@:_" (length o))
+      (sequence:dosequence (r o)
+        (pprint-pop)
+        (format s "~A ~6,3e ~D ~D~@:_"
+                (result-key r) (result-distance r)
+                (result-qpos r) (result-ipos r))))))
+
+(defmethod sequence:length ((o copied-query-results))
+  (length (%copied-results o)))
+(defmethod sequence:elt ((o copied-query-results) index)
+  (elt (%copied-results o) index))
+(defmethod (setf sequence:elt) (new-value (o copied-query-results) index)
+  (setf (elt (%copied-results o) index) new-value))
+(defmethod sequence:make-sequence-like
+    ((o copied-query-results) length &rest args
+     &key initial-element initial-contents)
+  (declare (ignore initial-element initial-contents))
+  (let ((vector (apply #'make-array length args)))
+    (make-instance 'copied-query-results 'results vector)))
+(defmethod sequence:adjust-sequence
+    ((o copied-query-results) length &rest args
+     &key initial-element initial-contents)
+  (declare (ignore initial-element initial-contents))
+  (let ((results (%copied-results o)))
+    (apply #'sequence:adjust-sequence results length args))
+  o)
+
+(defclass proxied-query-results (results)
+  ((adb :initarg adb)
+   (spec :initarg spec)
+   (results :initarg results)))
+(defmethod initialize-instance :after ((o proxied-query-results) &key)
+  (when (and (slot-boundp o 'results)
+             (not (null-alien o))
+             (slot-boundp o 'spec))
+    (with-slots (results spec adb) o
+      (flet ((results-finalizer ()
+               (with-slots (alien) adb
+                 (%free-query-results alien spec results))))
+        (sb-ext:finalize o #'results-finalizer)))))
+
+(defgeneric query (datum db &key))
+
+;;; FIXME: I don't like this way of generalizing the boilerplate;
+;;; isn't there a nice functional way of doing this?
+(macrolet
+    ((def (name datum-class &body qdatum-forms)
+       `(defmethod ,name ((datum ,datum-class) (db adb) &key
+                          (sequence-length 1) (sequence-start 0)
+                          exhaustivep accumulation distance
+                          ;; FIXME: dubious historical defaults
+                          (npoints 10) (ntracks 10)
+
+                          (radius nil radiusp)
+                          (include-keys nil include-keys-p)
+                          (exclude-keys nil exclude-keys-p))
+          (unless (slot-boundp db 'alien)
+            (error "database ~S is closed" db))
+         (with-alien ((qid adb-query-id-t)
+                      (qparams adb-query-parameters-t)
+                      (qrefine adb-query-refine-t)
+                      (qdatum adb-datum-t))
+           ,@qdatum-forms
+           (setf (slot qid 'datum) (addr qdatum))
+           (setf (slot qid 'sequence-length) sequence-length)
+           (setf (slot qid 'sequence-start) sequence-start)
+           (setf (slot qid 'flags) (if exhaustivep 1 0))
+
+           (setf (slot qparams 'accumulation)
+                 (ecase accumulation
+                   (:db 1)
+                   (:per-track 2)
+                   (:one-to-one 3)))
+           (setf (slot qparams 'distance)
+                 (ecase distance
+                   (:dot-product 1)
+                   (:euclidean-normed 2)
+                   (:euclidean 3)))
+           (setf (slot qparams 'npoints) (or npoints 0))
+           (setf (slot qparams 'ntracks) (or ntracks 0))
+
+           (let ((refine-flags 0))
+             (when radiusp
+               (setf refine-flags (logior refine-flags 4))
+               (setf (slot qrefine 'radius) (float radius 0d0)))
+             ;; FIXME: the freeing of the KEYS slot in these
+             ;; include/exclude keylists isn't interrupt-safe.
+             ;;
+             ;; FIXME: think quite hard about the behaviour of this
+             ;; when LENGTH is 0.
+             (when include-keys-p
+               (setf refine-flags (logior refine-flags 1))
+               (let ((length (length include-keys)))
+                 (setf (slot (slot qrefine 'include) 'nkeys) length)
+                 (let ((keys (make-alien c-string length)))
+                   (setf (slot (slot qrefine 'include) 'keys) keys)
+                   (loop for key being the elements of include-keys
+                         for i upfrom 0
+                         do (setf (deref keys i) key)))))
+             (when exclude-keys-p
+               (setf refine-flags (logior refine-flags 2))
+               (let ((length (length exclude-keys)))
+                 (setf (slot (slot qrefine 'exclude) 'nkeys) length)
+                 (let ((keys (make-alien c-string length)))
+                   (setf (slot (slot qrefine 'exclude) 'keys) keys)
+                   (loop for key being the elements of exclude-keys
+                         for i upfrom 0
+                         do (setf (deref keys i) key)))))
+             (setf (slot qrefine 'flags) refine-flags))
+           (setf (slot qrefine 'hopsize) 1)
+
+           ;; FIXME: hm, this possibly suggests that there's something
+           ;; a bit wrong with the C audioDB interface.  The API
+           ;; currently exposed effectively requires either that all
+           ;; the processing of query results happens in the same
+           ;; dynamic extent as the call to audiodb_query_spec(), or
+           ;; that the adb_query_spec_t object is allocated on the
+           ;; heap.  We need to think harder about whether the spec
+           ;; argument is really required (I think it probably isn't).
+           ;;
+           ;; meanwhile, here we're using it with dynamic extent anyway, so
+           ;; we could put it right back on the stack.
+           (let ((qspec (make-alien adb-query-spec-t)))
+             (unwind-protect
+                  (progn
+                    (setf (slot qspec 'qid) qid)
+                    (setf (slot qspec 'params) qparams)
+                    (setf (slot qspec 'refine) qrefine)
+
+                    (let ((results
+                           (sb-int:with-float-traps-masked (:invalid)
+                             (%query (slot-value db 'alien) qspec))))
+                      (flet ((collect-copied-results ()
+                               (let ((nresults (slot results 'nresults))
+                                     (cresults (slot results 'results)))
+                                 (coerce
+                                  (loop for i below nresults
+                                        for r = (deref cresults i)
+                                        collect (make-result
+                                                 :key (slot r 'key)
+                                                 :distance (slot r 'dist)
+                                                 :qpos (slot r 'qpos)
+                                                 :ipos (slot r 'ipos)))
+                                  'vector))))
+                        (unwind-protect
+                             (make-instance 'copied-query-results
+                                            'results (collect-copied-results))
+                          (%free-query-results (slot-value db 'alien) qspec results)))))
+               (when (logbitp 0 (slot (slot qspec 'refine) 'flags))
+                 (free-alien (slot (slot (slot qspec 'refine) 'include) 'keys)))
+               (when (logbitp 1 (slot (slot qspec 'refine) 'flags))
+                 (free-alien (slot (slot (slot qspec 'refine) 'exclude) 'keys)))
+               (free-alien qspec)))))))
+  (def query string (setf (slot qdatum 'key) datum))
+  (def query datum
+    (setf (slot qdatum 'key) (datum-key datum))
+    (setf (slot qdatum 'dim) (array-dimension (datum-data datum) 1))
+    (setf (slot qdatum 'nvectors) (array-dimension (datum-data datum) 0))
+    (setf (slot qdatum 'data) (sb-sys:vector-sap (sb-ext:array-storage-vector (datum-data datum))))
+    (if (datum-times datum)
+        (setf (slot qdatum 'times) (sb-sys:vector-sap (sb-ext:array-storage-vector (datum-times datum))))
+        (setf (slot qdatum 'times) nil))
+    (if (datum-power datum)
+        (setf (slot qdatum 'power) (sb-sys:vector-sap (sb-ext:array-storage-vector (datum-times datum))))
+        (setf (slot qdatum 'power) nil))))
+
+#+test
+(sb-adb:with-adb (db "/home/csr21/tmp/omras2-workshop/9.adb")
+  (sb-adb:query "KSA_CHARM_337" db :exhaustivep t :sequence-length 30
+                :accumulation :per-track :distance :euclidean :npoints 1 :ntracks 20))
+
+#+test
+(sb-adb:with-adb (db "/home/csr21/tmp/omras2-workshop/9.adb")
+  (sb-adb:query "KSA_CHARM_337" db :sequence-start 20 :sequence-length 20
+                :accumulation :per-track :distance :euclidean-normed
+                :npoints 10 :ntracks 1))
+
+#+test
+(sb-adb:with-adb (db "/home/csr21/tmp/omras2-workshop/9.adb")
+  (sb-adb:query "KSA_CHARM_337" db
+                :exhaustivep t :sequence-length 30
+                :accumulation :per-track :distance :euclidean-normed
+                :npoints 2 :ntracks 10))
+
+;;; only hacks and tests below
+#|
+(defun foo ()
+  (let ((db (%open "/home/csr21/tmp/omras2-workshop/9.adb" sb-posix:o-rdonly)))
+    (unless (null-alien db)
+      (unwind-protect
+           (with-alien ((status adb-status-t))
+           (%status db (addr status))
+           (print (list (slot status 'dim) (slot status 'nfiles))))
+        (%close db)))))
+
+(defun set-up-spec (spec qid qparams qrefine)
+  (declare (type (alien adb-query-parameters-t) qparams)
+           (type (alien adb-query-refine-t) qrefine)
+           (type (alien adb-query-id-t) qid)
+           (type (alien adb-query-spec-t) spec))
+  (setf (slot spec 'refine) qrefine)
+  nil)
+
+(defun bar ()
+  (let ((db (%open "/home/csr21/tmp/omras2-workshop/9.adb" sb-posix:o-rdonly)))
+    (unless (null-alien db)
+      (unwind-protect
+           (with-alien ((qid adb-query-id-t)
+                        (qparams adb-query-parameters-t)
+                        (qrefine adb-query-refine-t)
+                        (qspec adb-query-spec-t)
+                        (datum adb-datum-t))
+             (setf (slot datum 'key) "KSA_CHARM_337")
+             (setf (slot datum 'data) (sap-alien (sb-sys:int-sap 0) (* double)))
+
+             (setf (slot qid 'datum) (addr datum))
+             (setf (slot qid 'sequence-length) 30)
+             (setf (slot qid 'flags) 1) ; ADB_QID_FLAG_EXHAUSTIVE
+
+             (setf (slot qparams 'accumulation) 2) ; ADB_ACCUMULATION_PER_TRACK
+             (setf (slot qparams 'distance) 2) ; ADB_DISTANCE_EUCLIDEAN_NORMED
+             (setf (slot qparams 'npoints) 1)
+             (setf (slot qparams 'ntracks) 20)
+
+             (setf (slot qrefine 'flags) 0)
+             (setf (slot qrefine 'hopsize) 1)
+
+             (setf (slot qspec 'qid) qid)
+             (setf (slot qspec 'params) qparams)
+             (setf (slot qspec 'refine) qrefine)
+             (let ((results (%query db (addr qspec))))
+               (unless (null-alien results)
+                 (unwind-protect
+                      (flet ((print-result (n)
+                               (let ((result (deref (slot results 'results) n)))
+                                 (format t "~&~A ~F ~D ~D~%"
+                                         (slot result 'key) (slot result 'dist)
+                                         (slot result 'qpos) (slot result 'ipos)))))
+                        (dotimes (i (slot results 'nresults))
+                          (print-result i)))
+                   (%free-query-results db (addr qspec) results)))))
+        (%close db)))))
+|#
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bindings/sb-alien/library.lisp	Wed Jan 21 21:48:25 2009 +0000
@@ -0,0 +1,130 @@
+(in-package "SB-ADB")
+
+(defmacro define-int-checking-function (name arglist llname)
+  `(defun ,name ,arglist
+     (let ((result (,llname ,@arglist)))
+       (unless (eql 0 result)
+         (error "~S on ~{~S ~}failed." ',name (list ,@arglist))))))
+
+(defmacro define-pointer-checking-function (name arglist llname)
+  `(defun ,name ,arglist
+     (let ((result (,llname ,@arglist)))
+       (when (null-alien result)
+         (error "~S on ~{~S ~}failed." ',name (list ,@arglist)))
+       result)))
+
+(define-alien-type adb-t
+  (struct adb))
+
+(define-alien-routine ("audiodb_open" %%open) (* adb-t)
+  (path c-string)
+  (flags int))
+(define-pointer-checking-function %open (path flags) %%open)
+
+(define-alien-routine ("audiodb_create" %%create) (* adb-t)
+  (path c-string)
+  (datasize (unsigned 32))
+  (ntracks (unsigned 32))
+  (datadim (unsigned 32)))
+(define-pointer-checking-function %create (path datasize ntracks datadim)
+  %%create)
+
+(define-alien-routine ("audiodb_l2norm" %%l2norm) int
+  (adb (* adb-t)))
+(define-int-checking-function %l2norm (adb) %%l2norm)
+
+(define-alien-routine ("audiodb_power" %%power) int
+  (adb (* adb-t)))
+(define-int-checking-function %power (adb) %%power)
+
+(define-alien-type adb-datum-t
+  (struct adb-datum
+    (nvectors (unsigned 32))
+    (dim (unsigned 32))
+    (key c-string)
+    (data (* double))
+    (power (* double))
+    (times (* double))))
+
+(define-alien-routine ("audiodb_insert_datum" %%insert-datum) int
+  (adb (* adb-t))
+  (datum (* adb-datum-t)))
+(define-int-checking-function %insert-datum (adb datum) %%insert-datum)
+
+(define-alien-type adb-status-t
+  (struct adb-status
+    (nfiles (unsigned 32))
+    (dim (unsigned 32))
+    (ignore1 (unsigned 32))
+    (ignore2 (unsigned 32))
+    (flags (unsigned 32))
+    (length (unsigned 64))
+    (data-region-size (unsigned 64))))
+
+(define-alien-routine ("audiodb_status" %%status) int
+  (adb (* adb-t))
+  (status (* adb-status-t)))
+(define-int-checking-function %status (adb datum) %%status)
+
+(define-alien-type adb-query-id-t
+  (struct adbqueryid
+    (datum (* adb-datum-t))
+    (sequence-length (unsigned 32))
+    (flags (unsigned 32))
+    (sequence-start (unsigned 32))))
+
+(define-alien-type adb-query-parameters-t
+  (struct adbqueryparameters
+    (accumulation (unsigned 32))
+    (distance (unsigned 32))
+    (npoints (unsigned 32))
+    (ntracks (unsigned 32))))
+
+(define-alien-type adb-keylist-t
+  (struct adbkeylist
+    (nkeys (unsigned 32))
+    (keys (* c-string))))
+
+(define-alien-type adb-query-refine-t
+  (struct adbqueryrefine
+    (flags (unsigned 32))
+    (include adb-keylist-t)
+    (exclude adb-keylist-t)
+    (radius double)
+    (absolute-threshold double)
+    (relative-threshold double)
+    (duration-ratio double)
+    (hopsize (unsigned 32))))
+
+(define-alien-type adb-query-spec-t
+  (struct adbqueryspec
+    (qid adb-query-id-t)
+    (params adb-query-parameters-t)
+    (refine adb-query-refine-t)))
+
+(define-alien-type adb-result-t
+  (struct adbresult
+    (key c-string)
+    (dist double)
+    (qpos (unsigned 32))
+    (ipos (unsigned 32))))
+
+(define-alien-type adb-query-results-t
+  (struct adbqueryresults
+    (nresults (unsigned 32))
+    (results (* adb-result-t))))
+
+(define-alien-routine ("audiodb_query_spec" %%query) (* adb-query-results-t)
+  (adb (* adb-t))
+  (spec (* adb-query-spec-t)))
+(define-pointer-checking-function %query (adb spec) %%query)
+
+(define-alien-routine ("audiodb_query_free_results" %%free-query-results) int
+  (adb (* adb-t))
+  (spec (* adb-query-spec-t))
+  (results (* adb-query-results-t)))
+(define-int-checking-function %free-query-results (adb spec results)
+  %%free-query-results)
+
+(define-alien-routine ("audiodb_close" %close) void
+  (adb (* adb-t)))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bindings/sb-alien/package.lisp	Wed Jan 21 21:48:25 2009 +0000
@@ -0,0 +1,4 @@
+(cl:defpackage "SB-ADB"
+  (:use "CL" "SB-ALIEN")
+  (:export "ADB" "OPEN" "CLOSE" "QUERY" "WITH-ADB")
+  (:shadow "OPEN" "CLOSE"))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bindings/sb-alien/sb-adb.asd	Wed Jan 21 21:48:25 2009 +0000
@@ -0,0 +1,6 @@
+(asdf:defsystem :sb-adb
+  :serial t
+  :depends-on (sb-posix)
+  :components ((:file "package")
+               (:file "library")
+               (:file "interface")))
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bindings/sb-alien/tests.lisp	Wed Jan 21 21:48:25 2009 +0000
@@ -0,0 +1,136 @@
+(in-package "SB-ADB")
+
+(define-symbol-macro %default-query-args nil)
+(defmacro with-default-query-args (args &body body &environment env)
+  (let ((current-args (macroexpand '%default-query-args env)))
+    `(symbol-macrolet ((%default-query-args ,(append args current-args)))
+       ,@body)))
+
+(defmacro with-query-result-assertions
+    ((query db &rest query-args) &body body &environment env)
+  (let ((results (gensym "RESULTS"))
+        (default-args (macroexpand '%default-query-args env)))
+    `(let* ((,results (query ,query ,db ,@query-args ,@default-args))
+            (length (length ,results)))
+       (flet ((%present (list)
+                (find-if (lambda (r)
+                           (and
+                            (string= (first list) (result-key r))
+                            (< (abs (- (second list) (result-distance r))) 1e-4)
+                            (= (third list) (result-qpos r))
+                            (= (fourth list) (result-ipos r))))
+                         ,results)))
+         (declare (ignorable #'%present))
+         (macrolet ((present (&rest forms)
+                      `(and ,@(loop for f in forms collect `(%present ',f)))))
+           ,@(loop for b in body collect `(assert ,b)))))))
+
+(defmacro with-asserted-query-results ((query db &rest query-args) &body body)
+  `(with-query-result-assertions (,query ,db ,@query-args)
+     (= length ,(length body))
+     (present ,@body)))
+
+(declaim (optimize debug))
+
+(defun test-0003 ()
+  (let ((datum (make-datum "testfeature" '((1d0)))))
+    (with-adb (db "testdb.0003" :direction :output :if-exists :supersede)
+      (l2norm db)
+      (insert datum db)
+      (with-asserted-query-results
+          (datum db :npoints 10 :accumulation :db :distance :dot-product)
+        ("testfeature" 1 0 0)))))
+
+(defun test-0004 ()
+  (let ((feature (make-datum "testfeature" '((0d0 1d0) (1d0 0d0))))
+        (query05 (make-datum "testquery" '((0d0 0.5d0))))
+        (query50 (make-datum "testquery" '((0.5d0 0d0)))))
+    (with-adb (db "testdb.0004" :direction :output :if-exists :supersede)
+      (l2norm db)
+      (insert feature db)
+      (with-default-query-args (:accumulation :db :distance :dot-product)
+        (with-asserted-query-results (query05 db :npoints 10)
+          ("testfeature" 0.5 0 0) ("testfeature" 0 0 1))
+        (with-asserted-query-results (query05 db :npoints 1)
+          ("testfeature" 0.5 0 0))
+        (with-asserted-query-results (query50 db :npoints 10)
+          ("testfeature" 0.5 0 1) ("testfeature" 0 0 0))
+        (with-asserted-query-results (query50 db :npoints 1)
+          ("testfeature" 0.5 0 1))))))
+
+(defun test-0010 ()
+  (let ((feature01 (make-datum "testfeature01" '((0d0 1d0))))
+        (feature10 (make-datum "testfeature10" '((1d0 0d0))))
+        (query05 (make-datum "testquery" '((0d0 0.5d0))))
+        (query50 (make-datum "testquery" '((0.5d0 0d0)))))
+    (with-adb (db "testdb.0010" :direction :output :if-exists :supersede)
+      (insert feature01 db)
+      (insert feature10 db)
+      (l2norm db)
+      (with-default-query-args
+          (:accumulation :per-track :ntracks 10 :npoints 10 :distance :euclidean-normed)
+        (with-asserted-query-results (query05 db)
+          ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
+        (with-asserted-query-results (query05 db :radius 5)
+          ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
+        (with-asserted-query-results (query05 db :radius 1)
+          ("testfeature01" 0 0 0))
+        (with-asserted-query-results (query50 db)
+          ("testfeature01" 2 0 0) ("testfeature10" 0 0 0))
+        (with-asserted-query-results (query50 db :radius 5)
+          ("testfeature01" 2 0 0) ("testfeature10" 0 0 0))
+        (with-asserted-query-results (query50 db :radius 1)
+          ("testfeature10" 0 0 0))))))
+
+(defun test-0031 ()
+  (let ((feature01 (make-datum "testfeature01" '((0d0 1d0))))
+        (feature10 (make-datum "testfeature10" '((1d0 0d0))))
+        (query05 (make-datum "testquery" '((0d0 0.5d0)))))
+    (with-adb (db "testdb.0031" :direction :output :if-exists :supersede)
+      (insert feature01 db)
+      (insert feature10 db)
+      (l2norm db)
+      (with-default-query-args
+          (:accumulation :per-track :ntracks 10 :npoints 10 :distance :euclidean-normed)
+        (with-asserted-query-results (query05 db)
+          ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
+        (with-asserted-query-results (query05 db :include-keys ()))
+        (with-asserted-query-results (query05 db :include-keys '("testfeature01"))
+          ("testfeature01" 0 0 0))
+        (with-asserted-query-results (query05 db :include-keys '("testfeature10"))
+          ("testfeature10" 2 0 0))
+        (with-asserted-query-results (query05 db :include-keys '("testfeature10" "testfeature01"))
+          ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
+
+        (with-asserted-query-results (query05 db :exclude-keys '("testfeature10" "testfeature01")))
+
+        (with-asserted-query-results (query05 db :exclude-keys '("testfeature01"))
+          ("testfeature10" 2 0 0))
+        (with-asserted-query-results (query05 db :exclude-keys '("testfeature10"))
+          ("testfeature01" 0 0 0))
+        (with-asserted-query-results (query05 db :exclude-keys ())
+          ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))))))
+
+(defun test-0036 ()
+  (let ((feature01 (make-datum "testfeature01" '((0d0 1d0) (1d0 0d0))))
+        (feature10 (make-datum "testfeature10" '((1d0 0d0) (0d0 1d0))))
+        (query05 (make-datum "testquery" '((0d0 0.5d0))))
+        (query50 (make-datum "testquery" '((0.5d0 0d0)))))
+    (with-adb (db "testdb.0036" :direction :output :if-exists :supersede)
+      (insert feature01 db)
+      (insert feature10 db)
+      (l2norm db)
+      (with-default-query-args
+          (:accumulation :per-track :ntracks 10 :distance :euclidean-normed)
+        (dolist (npoints '(10 2 5))
+          (with-asserted-query-results (query05 db :npoints npoints)
+            ("testfeature01" 0 0 0) ("testfeature01" 2 0 1)
+            ("testfeature10" 0 0 1) ("testfeature10" 2 0 0)))
+        (with-asserted-query-results (query05 db :npoints 1)
+          ("testfeature01" 0 0 0) ("testfeature10" 0 0 1))
+        (dolist (npoints '(10 2 5))
+          (with-asserted-query-results (query50 db :npoints npoints)
+            ("testfeature01" 0 0 1) ("testfeature01" 2 0 0)
+            ("testfeature10" 0 0 0) ("testfeature10" 2 0 1)))
+        (with-asserted-query-results (query50 db :npoints 1)
+          ("testfeature01" 0 0 1) ("testfeature10" 0 0 0))))))