version 1.1, 1994/07/21 10:52:43
|
version 1.2, 1994/08/25 15:25:27
|
Line 1
|
Line 1
|
\ Hashed dictionaries 15jul94py |
\ Hashed dictionaries 15jul94py |
|
|
$80 Value Hashlen |
7 value hashbits |
|
1 hashbits lshift Value Hashlen |
|
|
Variable insRule insRule on |
Variable insRule insRule on |
|
|
Line 22 Variable HashPointer
|
Line 23 Variable HashPointer
|
|
|
\ compute hash key 15jul94py |
\ compute hash key 15jul94py |
|
|
: hash ( addr len -- key ) (hashkey) |
: hash ( addr len -- key ) |
\ tuck bounds ?DO I c@ toupper + LOOP |
hashbits (hashkey1) ; |
Hashlen 1- and ; |
\ (hashkey) |
|
\ Hashlen 1- and ; |
|
|
: hash-find ( addr len wordlist -- nfa / false ) $C + @ >r |
|
2dup hash cells r> + @ (hashfind) ; |
: hash-find ( addr len wordlist -- nfa / false ) |
|
$C + @ >r |
|
2dup hash cells r> + @ (hashfind) ; |
\ BEGIN dup WHILE |
\ BEGIN dup WHILE |
\ 2@ >r >r dup r@ cell+ c@ $1F and = |
\ 2@ >r >r dup r@ cell+ c@ $1F and = |
\ IF 2dup r@ cell+ char+ capscomp 0= |
\ IF 2dup r@ cell+ char+ capscomp 0= |
Line 51 Variable HashPointer
|
Line 55 Variable HashPointer
|
|
|
Create hashsearch ' hash-find A, ' hash-reveal A, ' drop A, |
Create hashsearch ' hash-find A, ' hash-reveal A, ' drop A, |
|
|
: (initvoc ( addr -- ) cell+ dup @ 0< IF drop EXIT THEN |
: (initvoc ( addr -- ) |
insRule @ >r insRule off hash-alloc |
cell+ dup @ 0< IF drop EXIT THEN |
3 cells - hashsearch over cell+ ! dup |
insRule @ >r insRule off hash-alloc |
BEGIN @ dup WHILE 2dup swap (reveal REPEAT |
3 cells - hashsearch over cell+ ! dup |
2drop r> insRule ! ; |
BEGIN @ dup WHILE 2dup swap (reveal REPEAT |
|
2drop r> insRule ! ; |
|
|
' (initvoc IS 'initvoc |
' (initvoc IS 'initvoc |
|
|
: addall ( -- ) voclink |
: addall ( -- ) |
BEGIN @ dup @ WHILE dup (initvoc REPEAT drop ; |
voclink |
|
BEGIN @ dup @ WHILE dup (initvoc REPEAT drop ; |
|
|
\ Hash-Find 01jan93py |
\ Hash-Find 01jan93py |
|
|
Line 74 addall \ Baum aufbauen
|
Line 80 addall \ Baum aufbauen
|
dup cell+ @ .name REPEAT drop |
dup cell+ @ .name REPEAT drop |
LOOP drop r> base ! ; |
LOOP drop r> base ! ; |
|
|
|
\ \ this stuff is for evaluating the hash function |
|
\ : square dup * ; |
|
|
|
\ : countwl ( -- sum sumsq ) |
|
\ \ gives the number of words in the current wordlist and the sum of |
|
\ \ squares for the sublist lengths |
|
\ 0 0 |
|
\ context @ 3 cells + @ hashlen cells over + swap DO |
|
\ 0 i BEGIN |
|
\ @ dup WHILE |
|
\ swap 1+ swap |
|
\ REPEAT |
|
\ drop |
|
\ swap over square + |
|
\ >r + r> |
|
\ 1 cells |
|
\ +LOOP ; |
|
|
|
\ : chisq ( -- n ) |
|
\ \ n should have about the same size as hashlen |
|
\ countwl hashlen 2 pick */ swap - ; |