extra/mongodb/benchmark/benchmark.factor

   1 USING: calendar math fry kernel assocs math.ranges bson.reader io.streams.byte-array
   2 sequences formatting combinators namespaces io tools.time prettyprint io.encodings.binary
   3 accessors words mongodb.driver strings math.parser tools.walker bson.writer
   4 tools.continuations ;
   5
   6 IN: mongodb.benchmark
   7
   8 SYMBOL: collection
   9
  10 : get* ( symbol default -- value )
  11     [ get ] dip or ; inline
  12
  13 : ensure-number ( v -- n )
  14     dup string? [ string>number ] when ; inline
  15
  16 : trial-size ( -- size )
  17     "per-trial" 5000 get* ensure-number ; inline flushable
  18
  19 : batch-size ( -- size )
  20     "batch-size" 100 get* ensure-number ; inline flushable
  21
  22 TUPLE: result doc collection index batch lasterror ;
  23
  24 : <result> ( -- ) result new result set ; inline
  25
  26
  27 CONSTANT: CHECK-KEY f
  28
  29 CONSTANT: DOC-SMALL H{ }
  30
  31 CONSTANT: DOC-MEDIUM H{ { "integer" 5 }
  32                         { "number" 5.05 }
  33                         { "boolean" f }
  34                         { "array"
  35                           { "test" "benchmark" } } }
  36
  37 CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
  38                        { "total_word_count" 6743 }
  39                        { "access_time" f }
  40                        { "meta_tags" H{ { "description" "i am a long description string" }
  41                                         { "author" "Holly Man" }
  42                                         { "dynamically_created_meta_tag" "who know\n what" } } }
  43                        { "page_structure" H{ { "counted_tags" 3450 }
  44                                              { "no_of_js_attached" 10 }
  45                                              { "no_of_images" 6 } } }
  46                        { "harvested_words" { "10gen" "web" "open" "source" "application" "paas"
  47                                              "platform-as-a-service" "technology" "helps"
  48                                              "developers" "focus" "building" "mongodb" "mongo"
  49                                              "10gen" "web" "open" "source" "application" "paas"
  50                                              "platform-as-a-service" "technology" "helps"
  51                                              "developers" "focus" "building" "mongodb" "mongo"
  52                                              "10gen" "web" "open" "source" "application" "paas"
  53                                              "platform-as-a-service" "technology" "helps"
  54                                              "developers" "focus" "building" "mongodb" "mongo"
  55                                              "10gen" "web" "open" "source" "application" "paas"
  56                                              "platform-as-a-service" "technology" "helps"
  57                                              "developers" "focus" "building" "mongodb" "mongo"
  58                                              "10gen" "web" "open" "source" "application" "paas"
  59                                              "platform-as-a-service" "technology" "helps"
  60                                              "developers" "focus" "building" "mongodb" "mongo"
  61                                              "10gen" "web" "open" "source" "application" "paas"
  62                                              "platform-as-a-service" "technology" "helps"
  63                                              "developers" "focus" "building" "mongodb" "mongo"
  64                                              "10gen" "web" "open" "source" "application" "paas"
  65                                              "platform-as-a-service" "technology" "helps"
  66                                              "developers" "focus" "building" "mongodb" "mongo"
  67                                              "10gen" "web" "open" "source" "application" "paas"
  68                                              "platform-as-a-service" "technology" "helps"
  69                                              "developers" "focus" "building" "mongodb" "mongo"
  70                                              "10gen" "web" "open" "source" "application" "paas"
  71                                              "platform-as-a-service" "technology" "helps"
  72                                              "developers" "focus" "building" "mongodb" "mongo"
  73                                              "10gen" "web" "open" "source" "application" "paas"
  74                                              "platform-as-a-service" "technology" "helps"
  75                                              "developers" "focus" "building" "mongodb" "mongo"
  76                                              "10gen" "web" "open" "source" "application" "paas"
  77                                              "platform-as-a-service" "technology" "helps"
  78                                              "developers" "focus" "building" "mongodb" "mongo"
  79                                              "10gen" "web" "open" "source" "application" "paas"
  80                                              "platform-as-a-service" "technology" "helps"
  81                                              "developers" "focus" "building" "mongodb" "mongo"
  82                                              "10gen" "web" "open" "source" "application" "paas"
  83                                              "platform-as-a-service" "technology" "helps"
  84                                              "developers" "focus" "building" "mongodb" "mongo"
  85                                              "10gen" "web" "open" "source" "application" "paas"
  86                                              "platform-as-a-service" "technology" "helps"
  87                                              "developers" "focus" "building" "mongodb" "mongo"
  88                                              "10gen" "web" "open" "source" "application" "paas"
  89                                              "platform-as-a-service" "technology" "helps"
  90                                              "developers" "focus" "building" "mongodb" "mongo"
  91                                              "10gen" "web" "open" "source" "application" "paas"
  92                                              "platform-as-a-service" "technology" "helps"
  93                                              "developers" "focus" "building" "mongodb" "mongo"
  94                                              "10gen" "web" "open" "source" "application" "paas"
  95                                              "platform-as-a-service" "technology" "helps"
  96                                              "developers" "focus" "building" "mongodb" "mongo"
  97                                              "10gen" "web" "open" "source" "application" "paas"
  98                                              "platform-as-a-service" "technology" "helps"
  99                                              "developers" "focus" "building" "mongodb" "mongo"
 100                                              "10gen" "web" "open" "source" "application" "paas"
 101                                              "platform-as-a-service" "technology" "helps"
 102                                              "developers" "focus" "building" "mongodb" "mongo"
 103                                              "10gen" "web" "open" "source" "application" "paas"
 104                                              "platform-as-a-service" "technology" "helps"
 105                                              "developers" "focus" "building" "mongodb" "mongo" } } }
 106
 107 : set-doc ( name -- )
 108     [ result ] dip '[ _ >>doc ] change ; inline
 109
 110 : small-doc ( -- quot )
 111     "small" set-doc [ ] ; inline
 112
 113 : medium-doc ( -- quot )
 114     "medium" set-doc [ ] ; inline
 115
 116 : large-doc ( -- quot )
 117     "large" set-doc [ ] ; inline
 118
 119 : small-doc-prepare ( -- quot: ( i -- doc ) )
 120     small-doc drop
 121     '[ "x" DOC-SMALL clone [ set-at ] keep ] ;
 122
 123 : medium-doc-prepare ( -- quot: ( i -- doc ) )
 124     medium-doc drop
 125     '[ "x" DOC-MEDIUM clone [ set-at ] keep ] ;
 126
 127 : large-doc-prepare ( -- quot: ( i -- doc ) )
 128     large-doc drop
 129     [ "x" DOC-LARGE clone [ set-at ] keep
 130        [ now "access-time" ] dip
 131        [ set-at ] keep ] ;
 132
 133 : (insert) ( quot: ( i -- doc ) collection -- )
 134     [ trial-size ] 2dip
 135     '[ _ call( i -- doc ) [ _ ] dip
 136        result get lasterror>> [ save ] [ save-unsafe ] if ] each-integer ;
 137
 138 : (prepare-batch) ( i b quot: ( i -- doc ) -- batch-seq )
 139     [ [ * ] keep 1 range boa ] dip
 140     '[ _ call( i -- doc ) ] map ;
 141
 142 : (insert-batch) ( quot: ( i -- doc ) collection -- )
 143     [ trial-size batch-size [ / ] keep ] 2dip
 144     '[ _ _ (prepare-batch) [ _ ] dip
 145        result get lasterror>> [ save ] [ save-unsafe ] if
 146     ] each-integer ;
 147
 148 : bchar ( boolean -- char )
 149     [ "t" ] [ "f" ] if ; inline
 150
 151 : collection-name ( -- collection )
 152     collection "benchmark" get*
 153     result get doc>>
 154     result get index>> bchar
 155     "%s-%s-%s" sprintf
 156     [ [ result get ] dip >>collection drop ] keep ;
 157
 158 : prepare-collection ( -- collection )
 159     collection-name
 160     [ "_x_idx" drop-index ] keep
 161     [ drop-collection ] keep
 162     [ create-collection ] keep ;
 163
 164 : prepare-index ( collection -- )
 165     "_x_idx" [ "x" asc ] key-spec <index-spec> unique-index ensure-index ;
 166
 167 : insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
 168     prepare-collection
 169     result get index>> [ [ prepare-index ] keep ] when
 170     result get batch>>
 171     [ '[ _ _ (insert-batch) ] ] [ '[ _ _ (insert) ] ] if ;
 172
 173 : serialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
 174     '[ trial-size [ _ call( i -- doc ) assoc>bv drop ] each-integer ] ;
 175
 176 : deserialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
 177     [ 0 ] dip call( i -- doc ) assoc>bv
 178     '[ trial-size [  _ binary [ H{ } stream>assoc 2drop ] with-byte-reader ] times ] ;
 179
 180 : check-for-key ( assoc key -- )
 181     CHECK-KEY [ swap key? [ "ups... where's the key" throw ] unless ] [ 2drop ] if ;
 182
 183 : (check-find-result) ( result -- )
 184     "x" check-for-key ; inline
 185
 186 : (find) ( cursor -- )
 187     [ find [ (check-find-result) ] each (find) ] when* ; inline recursive
 188
 189 : find-one ( quot -- quot: ( -- ) )
 190     drop
 191     [ trial-size
 192       collection-name
 193       trial-size 2 / "x" H{ } clone [ set-at ] keep
 194       '[ _ _ <query> 1 limit (find) ] times ] ;
 195
 196 : find-all ( quot -- quot: ( -- ) )
 197     drop
 198     collection-name
 199     H{ } clone
 200     '[ _ _ <query> (find) ] ;
 201
 202 : find-range ( quot -- quot: ( -- ) )
 203     drop
 204     [ trial-size batch-size /i
 205        collection-name
 206        trial-size 2 / "$gt" H{ } clone [ set-at ] keep
 207        [ trial-size 2 / batch-size + "$lt" ] dip [ set-at ] keep
 208        "x" H{ } clone [ set-at ] keep
 209        '[ _ _ <query> (find) ] times ] ;
 210
 211 : batch ( -- )
 212     result [ t >>batch ] change ; inline
 213
 214 : index ( -- )
 215     result [ t >>index ] change ; inline
 216
 217 : errcheck ( -- )
 218     result [ t >>lasterror ] change ; inline
 219
 220 : print-result ( time -- )
 221     [ result get [ collection>> ] keep
 222       [ batch>> bchar ] keep
 223       [ index>> bchar ] keep
 224       lasterror>> bchar
 225       trial-size ] dip
 226     1000000 / /i
 227     "%-18s: {batch:%s,index:%s;errchk:%s} %10s docs/s"
 228     sprintf print flush ;
 229
 230 : print-separator ( -- )
 231     "----------------------------------------------------------------" print flush ; inline
 232
 233 : print-separator-bold ( -- )
 234     "================================================================" print flush ; inline
 235
 236 : print-header ( -- )
 237     trial-size
 238     batch-size
 239     "MongoDB Factor Driver Benchmark\n%d ops per Trial, Batch-Size: %d"
 240     sprintf print flush
 241     print-separator-bold ;
 242
 243 : with-result ( options quot -- )
 244     '[ <result> _ call( options -- time ) print-result ] with-scope ;
 245
 246 : [bench-quot] ( feat-seq op-word -- quot: ( doc-word -- ) )
 247     '[ _ swap _
 248        '[ [ [ _ execute( -- quot ) ] dip
 249           [ execute( -- ) ] each _ execute( quot -- quot ) benchmark ] with-result ] each
 250        print-separator ] ;
 251
 252 : run-serialization-bench ( doc-word-seq feat-seq -- )
 253     "Serialization Tests" print
 254     print-separator-bold
 255     \ serialize [bench-quot] '[ _ call( doc-word -- ) ] each ;
 256
 257 : run-deserialization-bench ( doc-word-seq feat-seq -- )
 258     "Deserialization Tests" print
 259     print-separator-bold
 260     \ deserialize [bench-quot] '[ _ call( doc-word -- ) ] each ;
 261
 262 : run-insert-bench ( doc-word-seq feat-seq -- )
 263     "Insert Tests" print
 264     print-separator-bold
 265     \ insert [bench-quot] '[ _ call( doc-word -- ) ] each ;
 266
 267 : run-find-one-bench ( doc-word-seq feat-seq -- )
 268     "Query Tests - Find-One" print
 269     print-separator-bold
 270     \ find-one [bench-quot] '[ _ call( doc-word -- ) ] each ;
 271
 272 : run-find-all-bench ( doc-word-seq feat-seq -- )
 273     "Query Tests - Find-All" print
 274     print-separator-bold
 275     \ find-all [bench-quot] '[ _ call( doc-word -- ) ] each ;
 276
 277 : run-find-range-bench ( doc-word-seq feat-seq -- )
 278     "Query Tests - Find-Range" print
 279     print-separator-bold
 280     \ find-range [bench-quot] '[ _ call( doc-word -- ) ] each ;
 281
 282
 283 : run-benchmarks ( -- )
 284     "db" "db" get* "host" "127.0.0.1" get* "port" 27020 get* ensure-number <mdb>
 285     [ print-header
 286       ! serialization
 287       { small-doc-prepare medium-doc-prepare
 288         large-doc-prepare }
 289       { { } } run-serialization-bench
 290       ! deserialization
 291       { small-doc-prepare medium-doc-prepare
 292         large-doc-prepare }
 293       { { } } run-deserialization-bench
 294       ! insert
 295       { small-doc-prepare medium-doc-prepare
 296         large-doc-prepare }
 297       { { } { index } { errcheck } { index errcheck }
 298         { batch } { batch errcheck } { batch index errcheck }
 299       } run-insert-bench
 300       ! find-one
 301       { small-doc medium-doc large-doc }
 302       { { } { index } } run-find-one-bench
 303       ! find-all
 304       { small-doc medium-doc large-doc }
 305       { { } { index } } run-find-all-bench
 306       ! find-range
 307       { small-doc medium-doc large-doc }
 308       { { } { index } } run-find-range-bench
 309     ] with-db ;
 310
 311 MAIN: run-benchmarks
 312