extra/benchmark/hashtables/hashtables.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs combinators kernel locals math
   4 math.ranges memoize sequences strings hashtables
   5 math.parser grouping ;
   6 QUALIFIED: assocs
   7 IN: benchmark.hashtables
   8
   9 MEMO: strings ( -- str )
  10     1 100 [a,b] 1 [ + ] accumulate nip [ number>string ] map ;
  11
  12 :: add-delete-mix ( hash keys -- )
  13     keys [| k |
  14         0 k hash set-at
  15         k hash delete-at
  16     ] each
  17
  18     keys [
  19         0 swap hash set-at
  20     ] each
  21
  22     keys [
  23         hash delete-at
  24     ] each ;
  25
  26 :: store-lookup-mix ( hash keys -- )
  27     keys [
  28         0 swap hash set-at
  29     ] each
  30
  31     keys [
  32         hash at
  33     ] map drop
  34
  35     keys [
  36         hash [ 1 + ] assocs:change-at
  37     ] each ;
  38
  39 : string-mix ( hash -- )
  40     strings
  41     [ add-delete-mix ]
  42     [ store-lookup-mix ]
  43     2bi ;
  44
  45 TUPLE: collision value ;
  46
  47 M: collision hashcode* value>> hashcode* 15 bitand ;
  48
  49 : collision-mix ( hash -- )
  50     strings 30 head [ collision boa ] map
  51     [ add-delete-mix ]
  52     [ store-lookup-mix ]
  53     2bi ;
  54
  55 : small-mix ( hash -- )
  56     strings 10 group [
  57         [ add-delete-mix ]
  58         [ store-lookup-mix ]
  59         2bi
  60     ] with each ;
  61
  62 : hashtables-benchmark ( -- )
  63     H{ } clone
  64     10000 [
  65         dup {
  66             [ small-mix ]
  67             [ clear-assoc ]
  68             [ string-mix ]
  69             [ clear-assoc ]
  70             [ collision-mix ]
  71             [ clear-assoc ]
  72         } cleave
  73     ] times
  74     drop ;
  75
  76 MAIN: hashtables-benchmark