extra/mongodb/benchmark/benchmark.factor

   1 USING: accessors assocs bson calendar formatting hashtables io
   2 io.encodings.binary io.streams.byte-array kernel math
   3 math.parser mongodb.driver namespaces ranges sequences strings
   4 tools.time ;
   5 FROM: mongodb.driver => find ;
   6 FROM: memory => gc ;
   7 IN: mongodb.benchmark
   8
   9 SYMBOL: collection
  10
  11 : get* ( symbol default -- value )
  12     [ get ] dip or ; inline
  13
  14 : ensure-number ( v -- n )
  15     dup string? [ string>number ] when ; inline
  16
  17 : trial-size ( -- size )
  18     "per-trial" 5000 get* ensure-number ; inline flushable
  19
  20 : batch-size ( -- size )
  21     "batch-size" 100 get* ensure-number ; inline flushable
  22
  23 TUPLE: result doc collection index batch lasterror ;
  24
  25 : <result> ( -- ) result new result set ; inline
  26
  27
  28 CONSTANT: CHECK-KEY f
  29
  30 CONSTANT: DOC-SMALL H{ }
  31
  32 CONSTANT: DOC-MEDIUM H{ { "integer" 5 }
  33                         { "number" 5.05 }
  34                         { "boolean" f }
  35                         { "array"
  36                           { "test" "benchmark" } } }
  37
  38 CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
  39                        { "total_word_count" 6743 }
  40                        { "access_time" f }
  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" } } }
 107
 108 : set-doc ( name -- )
 109     [ result ] dip '[ _ >>doc ] change ; inline
 110
 111 : small-doc ( -- quot )
 112     "small" set-doc [ ] ; inline
 113
 114 : medium-doc ( -- quot )
 115     "medium" set-doc [ ] ; inline
 116
 117 : large-doc ( -- quot )
 118     "large" set-doc [ ] ; inline
 119
 120 : small-doc-prepare ( -- quot: ( i -- doc ) )
 121     small-doc drop
 122     '[ "x" DOC-SMALL clone [ set-at ] keep ] ;
 123
 124 : medium-doc-prepare ( -- quot: ( i -- doc ) )
 125     medium-doc drop
 126     '[ "x" DOC-MEDIUM clone [ set-at ] keep ] ;
 127
 128 : large-doc-prepare ( -- quot: ( i -- doc ) )
 129     large-doc drop
 130     [
 131         "x" DOC-LARGE clone [ set-at ] keep
 132         [ now "access-time" ] dip
 133         [ set-at ] keep
 134     ] ;
 135
 136 : (insert) ( quot: ( i -- doc ) collection -- )
 137     [ trial-size ] 2dip
 138     '[ _ call( i -- doc ) [ _ ] dip
 139     result get lasterror>> [ save ] [ save-unsafe ] if ] each-integer ;
 140
 141 : (prepare-batch) ( i b quot: ( i -- doc ) -- batch-seq )
 142     [ [ * ] keep 1 range boa ] dip
 143     '[ _ call( i -- doc ) ] map ;
 144
 145 : (insert-batch) ( quot: ( i -- doc ) collection -- )
 146     [ trial-size batch-size [ / ] keep ] 2dip
 147     '[ _ _ (prepare-batch) [ _ ] dip
 148         result get lasterror>> [ save ] [ save-unsafe ] if
 149     ] each-integer ;
 150
 151 : bchar ( boolean -- char )
 152     [ "t" ] [ "f" ] if ; inline
 153
 154 : collection-name ( -- collection )
 155     collection "benchmark" get*
 156     result get doc>>
 157     result get index>> bchar
 158     "%s-%s-%s" sprintf
 159     [ [ result get ] dip >>collection drop ] keep ;
 160
 161 : prepare-collection ( -- collection )
 162     collection-name
 163     [ "_x_idx" drop-index ] keep
 164     [ drop-collection ] keep
 165     [ create-collection ] keep ;
 166
 167 : prepare-index ( collection -- )
 168     "_x_idx" [ "x" asc ] key-spec <index-spec> t >>unique? ensure-index ;
 169
 170 : insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
 171     prepare-collection
 172     result get index>> [ [ prepare-index ] keep ] when
 173     result get batch>>
 174     [ '[ _ _ (insert-batch) ] ] [ '[ _ _ (insert) ] ] if ;
 175
 176 : serialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
 177     '[ trial-size [ _ call( i -- doc ) assoc>bv drop ] each-integer ] ;
 178
 179 : deserialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
 180     [ 0 ] dip call( i -- doc ) assoc>bv
 181     '[ trial-size [  _ binary [ H{ } stream>assoc drop ] with-byte-reader ] times ] ;
 182
 183 : check-for-key ( assoc key -- )
 184     CHECK-KEY [ swap key? [ "ups... where's the key" throw ] unless ] [ 2drop ] if ;
 185
 186 : (check-find-result) ( result -- )
 187     "x" check-for-key ; inline
 188
 189 : (find) ( cursor -- )
 190     [ find [ (check-find-result) ] each (find) ] when* ; inline recursive
 191
 192 : find-one ( quot -- quot: ( -- ) )
 193     drop
 194     [ trial-size
 195       collection-name
 196       trial-size 2 / "x" associate
 197       '[ _ _ <query> 1 limit (find) ] times ] ;
 198
 199 : find-all ( quot -- quot: ( -- ) )
 200     drop
 201     collection-name
 202     H{ } clone
 203     '[ _ _ <query> (find) ] ;
 204
 205 : find-range ( quot -- quot: ( -- ) )
 206     drop
 207     [
 208         trial-size batch-size /i
 209         collection-name
 210         trial-size 2 / "$gt" H{ } clone [ set-at ] keep
 211         [ trial-size 2 / batch-size + "$lt" ] dip [ set-at ] keep
 212         "x" H{ } clone [ set-at ] keep
 213         '[ _ _ <query> (find) ] times
 214     ] ;
 215
 216 : batch ( -- )
 217     result [ t >>batch ] change ; inline
 218
 219 : index ( -- )
 220     result [ t >>index ] change ; inline
 221
 222 : errcheck ( -- )
 223     result [ t >>lasterror ] change ; inline
 224
 225 : print-result ( time -- )
 226     [ result get [ collection>> ] keep
 227       [ batch>> bchar ] keep
 228       [ index>> bchar ] keep
 229       lasterror>> bchar
 230       trial-size ] dip
 231       1000000000 / [ /i ] [ result get batch>> [ [ batch-size /i ] dip ] when /i ] 2bi
 232     "%-18s: {batch:%s,index:%s;errchk:%s} %10s docs/s %10s ops/s"
 233     sprintf print flush ;
 234
 235 : print-separator ( -- )
 236     "---------------------------------------------------------------------------------" print flush ; inline
 237
 238 : print-separator-bold ( -- )
 239     "=================================================================================" print flush ; inline
 240
 241 : print-header ( -- )
 242     trial-size
 243     batch-size
 244     "MongoDB Factor Driver Benchmark\n%d ops per Trial, Batch-Size: %d"
 245     sprintf print flush
 246     print-separator-bold ;
 247
 248 : with-result ( options quot -- )
 249     '[ <result> _ call( options -- time ) print-result ] with-scope ;
 250
 251 : [bench-quot] ( feat-seq op-word -- quot: ( doc-word -- ) )
 252     '[
 253         _ swap _
 254         '[
 255             [
 256                 [ _ execute( -- quot ) ] dip
 257                 [ execute( -- ) ] each _ execute( quot -- quot ) gc
 258                 benchmark
 259             ] with-result
 260         ] each
 261         print-separator
 262     ] ;
 263
 264 : run-serialization-bench ( doc-word-seq feat-seq -- )
 265     "Serialization Tests" print
 266     print-separator-bold
 267     \ serialize [bench-quot] '[ _ call( doc-word -- ) ] each ;
 268
 269 : run-deserialization-bench ( doc-word-seq feat-seq -- )
 270     "Deserialization Tests" print
 271     print-separator-bold
 272     \ deserialize [bench-quot] '[ _ call( doc-word -- ) ] each ;
 273
 274 : run-insert-bench ( doc-word-seq feat-seq -- )
 275     "Insert Tests" print
 276     print-separator-bold
 277     \ insert [bench-quot] '[ _ call( doc-word -- ) ] each ;
 278
 279 : run-find-one-bench ( doc-word-seq feat-seq -- )
 280     "Query Tests - Find-One" print
 281     print-separator-bold
 282     \ find-one [bench-quot] '[ _ call( doc-word -- ) ] each ;
 283
 284 : run-find-all-bench ( doc-word-seq feat-seq -- )
 285     "Query Tests - Find-All" print
 286     print-separator-bold
 287     \ find-all [bench-quot] '[ _ call( doc-word -- ) ] each ;
 288
 289 : run-find-range-bench ( doc-word-seq feat-seq -- )
 290     "Query Tests - Find-Range" print
 291     print-separator-bold
 292     \ find-range [bench-quot] '[ _ call( doc-word -- ) ] each ;
 293
 294
 295 : run-benchmarks ( -- )
 296     "db" "db" get* "host" "127.0.0.1" get* "port" 27017 get* ensure-number <mdb>
 297     [ print-header
 298       ! serialization
 299       { small-doc-prepare medium-doc-prepare
 300         large-doc-prepare }
 301       { { } } run-serialization-bench
 302       ! deserialization
 303       { small-doc-prepare medium-doc-prepare
 304         large-doc-prepare }
 305       { { } } run-deserialization-bench
 306       ! insert
 307       { small-doc-prepare medium-doc-prepare
 308         large-doc-prepare }
 309       { { } { index } { errcheck } { index errcheck }
 310         { batch } { batch errcheck } { batch index errcheck }
 311       } run-insert-bench
 312       ! find-one
 313       { small-doc medium-doc large-doc }
 314       { { } { index } } run-find-one-bench
 315       ! find-all
 316       { small-doc medium-doc large-doc }
 317       { { } { index } } run-find-all-bench
 318       ! find-range
 319       { small-doc medium-doc large-doc }
 320       { { } { index } } run-find-range-bench
 321     ] with-db ;
 322
 323 MAIN: run-benchmarks