1 USING: accessors assocs bson.reader bson.writer calendar
2 formatting hashtables io io.encodings.binary
3 io.streams.byte-array kernel math math.parser
4 mongodb.driver namespaces ranges sequences strings tools.time ;
5 FROM: mongodb.driver => find ;
11 : get* ( symbol default -- value )
12 [ get ] dip or ; inline
14 : ensure-number ( v -- n )
15 dup string? [ string>number ] when ; inline
17 : trial-size ( -- size )
18 "per-trial" 5000 get* ensure-number ; inline flushable
20 : batch-size ( -- size )
21 "batch-size" 100 get* ensure-number ; inline flushable
23 TUPLE: result doc collection index batch lasterror ;
25 : <result> ( -- ) result new result set ; inline
30 CONSTANT: DOC-SMALL H{ }
32 CONSTANT: DOC-MEDIUM H{ { "integer" 5 }
36 { "test" "benchmark" } } }
38 CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
39 { "total_word_count" 6743 }
41 { "meta_tags" H{ { "description" "i am a long description string" }
42 { "author" "Holly Man" }
43 { "dynamically_created_meta_tag" "who know\n what" } } }
44 { "page_structure" H{ { "counted_tags" 3450 }
45 { "no_of_js_attached" 10 }
46 { "no_of_images" 6 } } }
47 { "harvested_words" { "10gen" "web" "open" "source" "application" "paas"
48 "platform-as-a-service" "technology" "helps"
49 "developers" "focus" "building" "mongodb" "mongo"
50 "10gen" "web" "open" "source" "application" "paas"
51 "platform-as-a-service" "technology" "helps"
52 "developers" "focus" "building" "mongodb" "mongo"
53 "10gen" "web" "open" "source" "application" "paas"
54 "platform-as-a-service" "technology" "helps"
55 "developers" "focus" "building" "mongodb" "mongo"
56 "10gen" "web" "open" "source" "application" "paas"
57 "platform-as-a-service" "technology" "helps"
58 "developers" "focus" "building" "mongodb" "mongo"
59 "10gen" "web" "open" "source" "application" "paas"
60 "platform-as-a-service" "technology" "helps"
61 "developers" "focus" "building" "mongodb" "mongo"
62 "10gen" "web" "open" "source" "application" "paas"
63 "platform-as-a-service" "technology" "helps"
64 "developers" "focus" "building" "mongodb" "mongo"
65 "10gen" "web" "open" "source" "application" "paas"
66 "platform-as-a-service" "technology" "helps"
67 "developers" "focus" "building" "mongodb" "mongo"
68 "10gen" "web" "open" "source" "application" "paas"
69 "platform-as-a-service" "technology" "helps"
70 "developers" "focus" "building" "mongodb" "mongo"
71 "10gen" "web" "open" "source" "application" "paas"
72 "platform-as-a-service" "technology" "helps"
73 "developers" "focus" "building" "mongodb" "mongo"
74 "10gen" "web" "open" "source" "application" "paas"
75 "platform-as-a-service" "technology" "helps"
76 "developers" "focus" "building" "mongodb" "mongo"
77 "10gen" "web" "open" "source" "application" "paas"
78 "platform-as-a-service" "technology" "helps"
79 "developers" "focus" "building" "mongodb" "mongo"
80 "10gen" "web" "open" "source" "application" "paas"
81 "platform-as-a-service" "technology" "helps"
82 "developers" "focus" "building" "mongodb" "mongo"
83 "10gen" "web" "open" "source" "application" "paas"
84 "platform-as-a-service" "technology" "helps"
85 "developers" "focus" "building" "mongodb" "mongo"
86 "10gen" "web" "open" "source" "application" "paas"
87 "platform-as-a-service" "technology" "helps"
88 "developers" "focus" "building" "mongodb" "mongo"
89 "10gen" "web" "open" "source" "application" "paas"
90 "platform-as-a-service" "technology" "helps"
91 "developers" "focus" "building" "mongodb" "mongo"
92 "10gen" "web" "open" "source" "application" "paas"
93 "platform-as-a-service" "technology" "helps"
94 "developers" "focus" "building" "mongodb" "mongo"
95 "10gen" "web" "open" "source" "application" "paas"
96 "platform-as-a-service" "technology" "helps"
97 "developers" "focus" "building" "mongodb" "mongo"
98 "10gen" "web" "open" "source" "application" "paas"
99 "platform-as-a-service" "technology" "helps"
100 "developers" "focus" "building" "mongodb" "mongo"
101 "10gen" "web" "open" "source" "application" "paas"
102 "platform-as-a-service" "technology" "helps"
103 "developers" "focus" "building" "mongodb" "mongo"
104 "10gen" "web" "open" "source" "application" "paas"
105 "platform-as-a-service" "technology" "helps"
106 "developers" "focus" "building" "mongodb" "mongo" } } }
108 : set-doc ( name -- )
109 [ result ] dip '[ _ >>doc ] change ; inline
111 : small-doc ( -- quot )
112 "small" set-doc [ ] ; inline
114 : medium-doc ( -- quot )
115 "medium" set-doc [ ] ; inline
117 : large-doc ( -- quot )
118 "large" set-doc [ ] ; inline
120 : small-doc-prepare ( -- quot: ( i -- doc ) )
122 '[ "x" DOC-SMALL clone [ set-at ] keep ] ;
124 : medium-doc-prepare ( -- quot: ( i -- doc ) )
126 '[ "x" DOC-MEDIUM clone [ set-at ] keep ] ;
128 : large-doc-prepare ( -- quot: ( i -- doc ) )
130 [ "x" DOC-LARGE clone [ set-at ] keep
131 [ now "access-time" ] dip
134 : (insert) ( quot: ( i -- doc ) collection -- )
136 '[ _ call( i -- doc ) [ _ ] dip
137 result get lasterror>> [ save ] [ save-unsafe ] if ] each-integer ;
139 : (prepare-batch) ( i b quot: ( i -- doc ) -- batch-seq )
140 [ [ * ] keep 1 range boa ] dip
141 '[ _ call( i -- doc ) ] map ;
143 : (insert-batch) ( quot: ( i -- doc ) collection -- )
144 [ trial-size batch-size [ / ] keep ] 2dip
145 '[ _ _ (prepare-batch) [ _ ] dip
146 result get lasterror>> [ save ] [ save-unsafe ] if
149 : bchar ( boolean -- char )
150 [ "t" ] [ "f" ] if ; inline
152 : collection-name ( -- collection )
153 collection "benchmark" get*
155 result get index>> bchar
157 [ [ result get ] dip >>collection drop ] keep ;
159 : prepare-collection ( -- collection )
161 [ "_x_idx" drop-index ] keep
162 [ drop-collection ] keep
163 [ create-collection ] keep ;
165 : prepare-index ( collection -- )
166 "_x_idx" [ "x" asc ] key-spec <index-spec> t >>unique? ensure-index ;
168 : insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
170 result get index>> [ [ prepare-index ] keep ] when
172 [ '[ _ _ (insert-batch) ] ] [ '[ _ _ (insert) ] ] if ;
174 : serialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
175 '[ trial-size [ _ call( i -- doc ) assoc>bv drop ] each-integer ] ;
177 : deserialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
178 [ 0 ] dip call( i -- doc ) assoc>bv
179 '[ trial-size [ _ binary [ H{ } stream>assoc drop ] with-byte-reader ] times ] ;
181 : check-for-key ( assoc key -- )
182 CHECK-KEY [ swap key? [ "ups... where's the key" throw ] unless ] [ 2drop ] if ;
184 : (check-find-result) ( result -- )
185 "x" check-for-key ; inline
187 : (find) ( cursor -- )
188 [ find [ (check-find-result) ] each (find) ] when* ; inline recursive
190 : find-one ( quot -- quot: ( -- ) )
194 trial-size 2 / "x" associate
195 '[ _ _ <query> 1 limit (find) ] times ] ;
197 : find-all ( quot -- quot: ( -- ) )
201 '[ _ _ <query> (find) ] ;
203 : find-range ( quot -- quot: ( -- ) )
205 [ trial-size batch-size /i
207 trial-size 2 / "$gt" H{ } clone [ set-at ] keep
208 [ trial-size 2 / batch-size + "$lt" ] dip [ set-at ] keep
209 "x" H{ } clone [ set-at ] keep
210 '[ _ _ <query> (find) ] times ] ;
213 result [ t >>batch ] change ; inline
216 result [ t >>index ] change ; inline
219 result [ t >>lasterror ] change ; inline
221 : print-result ( time -- )
222 [ result get [ collection>> ] keep
223 [ batch>> bchar ] keep
224 [ index>> bchar ] keep
227 1000000000 / [ /i ] [ result get batch>> [ [ batch-size /i ] dip ] when /i ] 2bi
228 "%-18s: {batch:%s,index:%s;errchk:%s} %10s docs/s %10s ops/s"
229 sprintf print flush ;
231 : print-separator ( -- )
232 "---------------------------------------------------------------------------------" print flush ; inline
234 : print-separator-bold ( -- )
235 "=================================================================================" print flush ; inline
237 : print-header ( -- )
240 "MongoDB Factor Driver Benchmark\n%d ops per Trial, Batch-Size: %d"
242 print-separator-bold ;
244 : with-result ( options quot -- )
245 '[ <result> _ call( options -- time ) print-result ] with-scope ;
247 : [bench-quot] ( feat-seq op-word -- quot: ( doc-word -- ) )
249 '[ [ [ _ execute( -- quot ) ] dip
250 [ execute( -- ) ] each _ execute( quot -- quot ) gc
251 benchmark ] with-result ] each
254 : run-serialization-bench ( doc-word-seq feat-seq -- )
255 "Serialization Tests" print
257 \ serialize [bench-quot] '[ _ call( doc-word -- ) ] each ;
259 : run-deserialization-bench ( doc-word-seq feat-seq -- )
260 "Deserialization Tests" print
262 \ deserialize [bench-quot] '[ _ call( doc-word -- ) ] each ;
264 : run-insert-bench ( doc-word-seq feat-seq -- )
267 \ insert [bench-quot] '[ _ call( doc-word -- ) ] each ;
269 : run-find-one-bench ( doc-word-seq feat-seq -- )
270 "Query Tests - Find-One" print
272 \ find-one [bench-quot] '[ _ call( doc-word -- ) ] each ;
274 : run-find-all-bench ( doc-word-seq feat-seq -- )
275 "Query Tests - Find-All" print
277 \ find-all [bench-quot] '[ _ call( doc-word -- ) ] each ;
279 : run-find-range-bench ( doc-word-seq feat-seq -- )
280 "Query Tests - Find-Range" print
282 \ find-range [bench-quot] '[ _ call( doc-word -- ) ] each ;
285 : run-benchmarks ( -- )
286 "db" "db" get* "host" "127.0.0.1" get* "port" 27017 get* ensure-number <mdb>
289 { small-doc-prepare medium-doc-prepare
291 { { } } run-serialization-bench
293 { small-doc-prepare medium-doc-prepare
295 { { } } run-deserialization-bench
297 { small-doc-prepare medium-doc-prepare
299 { { } { index } { errcheck } { index errcheck }
300 { batch } { batch errcheck } { batch index errcheck }
303 { small-doc medium-doc large-doc }
304 { { } { index } } run-find-one-bench
306 { small-doc medium-doc large-doc }
307 { { } { index } } run-find-all-bench
309 { small-doc medium-doc large-doc }
310 { { } { index } } run-find-range-bench