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 IN: benchmark.hashtables
   7
   8 MEMO: strings ( -- str )
   9     1 100 [a,b] 1 [ + ] accumulate nip [ number>string ] map ;
  10
  11 :: add-delete-mix ( hash keys -- )
  12     keys [| k |
  13         0 k hash set-at
  14         k hash delete-at
  15     ] each
  16
  17     keys [
  18         0 swap hash set-at
  19     ] each
  20
  21     keys [
  22         hash delete-at
  23     ] each ;
  24
  25 :: store-lookup-mix ( hash keys -- )
  26     keys [
  27         0 swap hash set-at
  28     ] each
  29
  30     keys [
  31         hash at
  32     ] map drop
  33
  34     keys [
  35         hash [ 1 + ] change-at
  36     ] each ;
  37
  38 : string-mix ( hash -- )
  39     strings
  40     [ add-delete-mix ]
  41     [ store-lookup-mix ]
  42     2bi ;
  43
  44 TUPLE: collision value ;
  45
  46 M: collision hashcode* value>> hashcode* 15 bitand ;
  47
  48 : collision-mix ( hash -- )
  49     strings 30 head [ collision boa ] map
  50     [ add-delete-mix ]
  51     [ store-lookup-mix ]
  52     2bi ;
  53
  54 : small-mix ( hash -- )
  55     strings 10 group [
  56         [ add-delete-mix ]
  57         [ store-lookup-mix ]
  58         2bi
  59     ] with each ;
  60
  61 : hashtable-benchmark ( -- )
  62     H{ } clone
  63     10000 [
  64         dup {
  65             [ small-mix ]
  66             [ clear-assoc ]
  67             [ string-mix ]
  68             [ clear-assoc ]
  69             [ collision-mix ]
  70             [ clear-assoc ]
  71         } cleave
  72     ] times
  73     drop ;
  74
  75 MAIN: hashtable-benchmark