Skip to content

Commit

Permalink
Add genertive test for sqlite backend
Browse files Browse the repository at this point in the history
  • Loading branch information
Andy Chambers committed Sep 3, 2016
1 parent 9f23205 commit bd0878a
Show file tree
Hide file tree
Showing 3 changed files with 174 additions and 80 deletions.
143 changes: 71 additions & 72 deletions env/profiling/hitchhiker/bench.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,77 +196,76 @@

(defn -main
[& [root & args]]
(jdbc/with-db-connection [db (sqlite/db-spec ":memory:")]
(let [outputs (atom [])]
(doseq [args (or (->> args
(partition-by #(= % "--"))
(map-indexed vector)
(filter (comp even? first))
(map second)
(seq))
[[]])] ; always do one iteration
(let [{:keys [options arguments errors summary]} (parse-opts args options)
tree-to-test (atom {})
results (atom [])]
(cond
(or (= "-h" root)
(= "--help" root)
(nil? root)
(:help options)) (exit 0 (usage summary))
(not= (count arguments) 0) (exit 1 (usage summary))
errors (exit 1 (error-msg errors)))
(let [backend (case (:backend options)
"testing" (core/->TestingBackend)
"redis" (do (redis/start-expiry-thread!)
(redis/->RedisBackend))
"sqlite" (do (sqlite/ensure-schema db)
(sqlite/->SQLiteBackend db)))
delete-xform (case (:delete-pattern options)
"forward" identity
"reverse" reverse
"shuffle" shuffle
"zero" #(repeat (count %) 0.0))
[tree-name structure]
(case (:data-structure options)
"b-tree" ["b-tree" (core-b-tree (:tree-width options) backend)]
"fractal" ["fractal" (msg-b-tree (:tree-width options) backend)]
"sorted-set" ["sorted-set" (sorted-set-repr)])
flush-freq (:flush-freq options)
codename (str tree-name
"__flush_"
flush-freq
"__b_"
(:tree-width options)
"__"
(:backend options)
"__n_"
(:num-operations options)
"__del_"
(:delete-pattern options))]
(doseq [ds (generate-test-datasets)
:let [codename (str codename
"_"
(:name ds))
out (create-output-dir
root
codename)
_ (println "Doing" codename)
bench-res (benchmark (:num-operations options) ds flush-freq structure out delete-xform)]]
(swap! results conj
{:tree tree-name
:ds (:name ds)
:freq flush-freq
:n (:num-operations options)
:b (:tree-width options)
:delete-pattern (:delete-pattern options)
:results bench-res}))
(let [outputs (atom [])]
(doseq [args (or (->> args
(partition-by #(= % "--"))
(map-indexed vector)
(filter (comp even? first))
(map second)
(seq))
[[]])] ; always do one iteration
(let [{:keys [options arguments errors summary]} (parse-opts args options)
tree-to-test (atom {})
results (atom [])]
(cond
(or (= "-h" root)
(= "--help" root)
(nil? root)
(:help options)) (exit 0 (usage summary))
(not= (count arguments) 0) (exit 1 (usage summary))
errors (exit 1 (error-msg errors)))
(let [backend (case (:backend options)
"testing" (core/->TestingBackend)
"redis" (do (redis/start-expiry-thread!)
(redis/->RedisBackend))
"sqlite" (sqlite/->SQLiteBackend
(sqlite/find-or-create-db "/tmp/yolo.sqlite")))
delete-xform (case (:delete-pattern options)
"forward" identity
"reverse" reverse
"shuffle" shuffle
"zero" #(repeat (count %) 0.0))
[tree-name structure]
(case (:data-structure options)
"b-tree" ["b-tree" (core-b-tree (:tree-width options) backend)]
"fractal" ["fractal" (msg-b-tree (:tree-width options) backend)]
"sorted-set" ["sorted-set" (sorted-set-repr)])
flush-freq (:flush-freq options)
codename (str tree-name
"__flush_"
flush-freq
"__b_"
(:tree-width options)
"__"
(:backend options)
"__n_"
(:num-operations options)
"__del_"
(:delete-pattern options))]
(doseq [ds (generate-test-datasets)
:let [codename (str codename
"_"
(:name ds))
out (create-output-dir
root
codename)
_ (println "Doing" codename)
bench-res (benchmark (:num-operations options) ds flush-freq structure out delete-xform)]]
(swap! results conj
{:tree tree-name
:ds (:name ds)
:freq flush-freq
:n (:num-operations options)
:b (:tree-width options)
:delete-pattern (:delete-pattern options)
:results bench-res}))
;(println "results")
;(clojure.pprint/pprint @results)
(swap! outputs conj (template-one-sheet @results)))))
(excel/render-to-file
"template_benchmark.xlsx"
(.getPath (File. root "analysis.xlsx"))
{"SingleDS"
(map-indexed (fn [i s]
(assoc s :sheet-name (str "Trial " (inc i))))
@outputs)}))))
(swap! outputs conj (template-one-sheet @results)))))
(excel/render-to-file
"template_benchmark.xlsx"
(.getPath (File. root "analysis.xlsx"))
{"SingleDS"
(map-indexed (fn [i s]
(assoc s :sheet-name (str "Trial " (inc i))))
@outputs)})))
52 changes: 44 additions & 8 deletions src/hitchhiker/sqlite.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,10 +28,19 @@
(def query
{:table-exists? "select 1 from sqlite_master where type='table' and name=?"
:index-exists? "select 1 from sqlite_master where type='index' and name=?"
:find-key "select * from hh_key where k=?"})
:find-key "select * from hh_key where k=?"
:dead-keys "select k
from hh_key
where k not in ( select child from hh_ref )"})

(defn drop-ref [db key]
(jdbc/delete! db :hh-key ["k = ?" key]))
(jdbc/delete! db :hh-key ["k = ?" key]
{:entities underscore})

(let [dead-keys (jdbc/query db (query :dead-keys))]
(doseq [{:keys [k] :as dead-key} dead-keys]
(drop-ref db k))))


(defn db-spec [subname]
{:classname "org.sqlite.JDBC"
Expand Down Expand Up @@ -86,7 +95,22 @@

(ensure {:items [:hh-ref-by-parent :hh-ref-by-child]
:exists? index-exists?
:create! create-index})))
:create! create-index})

db))

(defonce ^:private db-registry (atom {}))

(defn find-db [subname]
(get @db-registry subname))

(defn create-db [subname]
(-> {:connection (jdbc/get-connection (db-spec subname))}
(ensure-schema)))

(defn find-or-create-db [subname]
(or (find-db subname)
(create-db subname)))

(defn add-node [db {:keys [k v] :as node}]
(try
Expand All @@ -96,23 +120,36 @@
{:node node
:db db} e)))))

(defn list-keys [db]
(jdbc/query db "select k from hh_key"))

(defn delete-key [db k]
(jdbc/delete! :hh-key ["k = ?" k]))

(defn add-refs [db {:keys [parent children]}]
(let [mk-ref (fn [child]
[parent child])]
(jdbc/insert-multi! db :hh-ref (for [child children]
{:parent parent
:child child})
{:entities underscore})))
(try
(jdbc/insert-multi! db :hh-ref (for [child children]
{:parent parent
:child child})
{:entities underscore})
(catch Exception e
(throw (ex-info "Failed to link parent with children"
{:parent parent
:children children}
e))))))

(defn synthesize-storage-addr
"Given a key, returns a promise containing that key for use as a storage-addr"
[key]
(doto (promise)
(deliver key)))

;;; TODO: I believe using a dynamic var to hold the DB is a bit of anti-pattern but
;;; not sure how to avoid it and still support caching as it behaves in the
;;; redis backend.
;;;
(def ^:dynamic *db*)

(let [cache (-> {}
Expand Down Expand Up @@ -167,7 +204,6 @@
(new-session [_] (atom {:writes 0
:deletes 0}))
(anchor-root [_ {:keys [sqlite-key] :as node}]
;; TODO: figure out how redis gc relates to SQL
node)
(write-node [_ node session]
(swap! session update-in [:writes] inc)
Expand Down
59 changes: 59 additions & 0 deletions test/hitchhiker/sqlite_test.clj
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,59 @@
(ns hitchhiker.sqlite-test
(:require [clojure.test.check.clojure-test :refer [defspec]]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[hitchhiker.sqlite :as sqlite]
[hitchhiker.tree.core :as core]
hitchhiker.tree.core-test
[hitchhiker.tree.messaging :as msg]
[clojure.java.jdbc :as jdbc]))

(defn insert
[t k]
(msg/insert t k k))

(defn lookup-fwd-iter
[t v]
(seq (map first (msg/lookup-fwd-iter t v))))

(defn mixed-op-seq
"This is like the basic mixed-op-seq tests, but it also mixes in flushes to sqlite
and automatically deletes the old tree"
[add-freq del-freq flush-freq universe-size num-ops]
(let [db (sqlite/find-or-create-db "/tmp/yolo.sqlite")]
(prop/for-all [ops (gen/vector (gen/frequency
[[add-freq (gen/tuple (gen/return :add)
(gen/no-shrink gen/int))]
[flush-freq (gen/return [:flush])]
[del-freq (gen/tuple (gen/return :del)
(gen/no-shrink gen/int))]])
40)]
(assert (empty? (sqlite/list-keys db))
"Start with no keys")
(let [[b-tree root set]
(reduce (fn [[t root set] [op x]]
(let [x-reduced (when x (mod x universe-size))]
(condp = op
:flush (let [t (:tree (core/flush-tree t (sqlite/->SQLiteBackend db)))]
(when root
(sqlite/drop-ref db root))
#_(println "flush" root)
[t @(:storage-addr t) set])
:add (do #_(println "add" x) [(insert t x-reduced) root (conj set x-reduced)])
:del (do #_(println "del" x) [(msg/delete t x-reduced) root (disj set x-reduced)]))))
[(core/b-tree (core/->Config 3 3 2)) nil #{}]
ops)]
#_(println "Make it to the end of a test," root "has" (count (lookup-fwd-iter b-tree -1)) "keys left")
(let [b-tree-order (lookup-fwd-iter b-tree -1)
res (= b-tree-order (seq (sort set)))]

(sqlite/drop-ref db root)
(assert (empty? (sqlite/list-keys db))
"End with no keys")

(assert res (str "These are unequal: " (pr-str b-tree-order) " " (pr-str (seq (sort set)))))
res)))))

(defspec test-many-keys-bigger-trees
100
(mixed-op-seq 800 200 10 1000 1000))

0 comments on commit bd0878a

Please sign in to comment.