- Code: Select all
`\ Key collisions are handled via separate chaining.`

\ An attempt to #add with an existing key will simply replace the value.

Object Class new: Node ( key mutable val mutable next )

m: initialize \ val key --

:= key := val 0 := next ;

m: get-key @key ; \ -- s

m: get-val @val ; \ -- n

m: !val := val ; \ n --

m: get-next @next ; \ -- next-node

m: !next := next ; \ next-node --

m: << @key << "," << @val << " " << @next << " " << ;

: hash-str ( s -- hash )

| i |

0 s size loop: i [ i s at i 1+ * + ] ;

: */ ( n1 n2 n3 -- result )

n1 n2 * n3 / ;

Object Class new: Hash-table ( mutable table mutable no-of-nodes tload mutable a )

m: initialize \ n --

0 Array newWith := table 0 := no-of-nodes 100 := tload ;

\ given a key return the table index and contents of the related bucket ( a Node or Integer 0 )

m: buckets-table \ ( k -- idx node | idx 0 )

hash-str @table size mod abs 1+ dup @table at ;

\ 3 possible outcomes for search method:

\ 1) not found (empty bucket), return index/1/false

\ 2) not found (but there was a hash-collision, return last node in chain node/0/false

\ 3) found, return node/true

m: search ( k -- node true | idx 1 false | node 0 false )

k self buckets-table

\ idx node-obj or idx 0

dup 0 = if drop 1 false return else nip then \ => idx 1 false

\ not 0, so must be a node

\ if we got here, then it's a bucket collision

\ node

begin

dup get-key k == if true return then \ => node true

dup get-next \ will get a chained node or 0

\ node1 node2 or node1 0

dup 0 = if 0 return then \ => node1 0 false

nip \ node2

again ;

m: inc-nodes \ -1 or +1

@no-of-nodes + := no-of-nodes ;

m: remove ( k -- true | false )

| idx last-node |

k self buckets-table swap -> idx

\ node-obj or 0

dup 0 = if return then \ => false

dup get-key k == if get-next idx swap @table put -1 self inc-nodes true return then

\ not found yet, possibly key is in chained nodes

begin

dup -> last-node

get-next

dup 0 = if return then \ => false

dup get-key k == if get-next last-node !next -1 self inc-nodes true return then

again ;

m: get \ ( k -- val true | false )

self search

if \ node

get-val true

else \ idx 1 or node 0

2drop false

then ;

m: nodes-to-a \ node

begin

dup @a add

get-next \ will get a chained node or 0

\ node2 or 0

dup 0 = if drop return then

\ node2

again ;

\ Array a is used as temporary storage for all nodes while a new

\ table is being constructed

m: expand-table \ -- true or false

@no-of-nodes @table size @tload 100 */ >

if Array new := a

#[ dup class #Node = if self nodes-to-a else drop then ] @table apply

true return

then false ;

m: size \ ( -- n ) \ not used here, but could be useful

@no-of-nodes ;

\ note that value can be anything, key must be a string object

m: add ( v k -- )

k self search

if \ node

\ key already present so just over-write val

v swap !val

else \ idx 1 or node 0

v k Node new 1 self inc-nodes \ idx 1 nnode or node 0 nnode

swap \ idx newnode 1 or node newnode 0

if \ "node to empty table slot" .

@table put

else \ "chain node due to hash collision" .

swap !next

then

\ now expand the table if necessary

self expand-table

if @table size 2 * 1+ self initialize

#[ dup get-val swap get-key self add ] @a apply

null := a \ will force a garbage collect of a?

then

then ;

m: << \ display each node

@no-of-nodes << " nodes total " << @table size << " total buckets table size" <<

#[ dup if printcr << else drop then ] @table apply ;

tvar: h

\ Needs an initial size at instantiation. I arbitrarily chose 10.

\ But the table will automatically resize itself. I assume the table size is limited only by RAM.

10 Hash-table new to h

15 "pig" h add

88 "dog" h add

99 "cat" h add

66 "goat" h add

33 "rat" h add

2 "frog" h add

55 "fly" h add

67 "gnat" h add

9 "hat" h add

10 "jet" h add

12 "cart" h add

18 "hole" h add

18 "hole2" h add

18 "hole3" h add

18 "hole4" h add

18 "hole5" h add

18 "hole6" h add

18 "hole7" h add

18 "hole8" h add

15 "pig2" h add

15 "pig3" h add

15 "pig4" h add

15 "pig5" h add

15 "pig6" h add

15 "pig7" h add

15 "pig8" h add

15 "pig9" h add

15 "pig10" h add

h .