steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

let the unique heap retain hashtable entries after elements are popped to ensure uniqueness forever

db4
Doug Coleman 2008-10-01 21:25:37 -05:00
parent 32b3fab3a9
commit a10c3f425c
3 changed files with 23 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/assoc-heaps/assoc-heaps-docs.factor
View File

@ -10,16 +10,17 @@ HELP: <unique-max-heap>
{ $values
{ "unique-heap" assoc-heap } }
{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap." } ;
{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
HELP: <unique-min-heap>
{ $values
{ "unique-heap" assoc-heap } }
{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap." } ;
{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
{ <unique-max-heap> <unique-min-heap> } related-words
HELP: assoc-heap
{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap should update both the assoc and the heap." } ;
{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap may update both the assoc and the heap or leave them out of sync if it's advantageous." } ;
ARTICLE: "assoc-heaps" "Associative heaps"
"The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl

3
extra/assoc-heaps/assoc-heaps.factor
View File

@ -21,8 +21,7 @@ M: assoc-heap heap-push* ( value key assoc-heap -- entry )
] if ;
M: assoc-heap heap-pop ( assoc-heap -- value key )
[ heap>> heap-pop ] keep
[ over ] dip assoc>> delete-at ;
heap>> heap-pop ;
M: assoc-heap heap-peek ( assoc-heap -- value key )
heap>> heap-peek ;

33
extra/spider/spider.factor
View File

@ -8,7 +8,7 @@ combinators.short-circuit continuations calendar prettyprint ;
IN: spider
TUPLE: spider base count max-count sleep max-depth initial-links
filters spidered todo nonmatching ;
filters spidered todo nonmatching quiet ;
! secure? agent page-timeout data-timeout overall-timeout
TUPLE: spider-result url depth headers fetch-time parsed-html
@ -27,19 +27,19 @@ links processing-time timestamp ;
<PRIVATE
: relative-url? ( url -- ? ) protocol>> not ;
: apply-filters ( links spider -- links' )
filters>> [ '[ _ 1&& ] filter ] when* ;
: push-links ( links level assoc-heap -- )
'[ _ _ heap-push ] each ;
: add-todo ( links level spider -- )
tuck [ apply-filters ] 2dip
tuck
[ spidered>> keys diff ]
[ todo>> ] 2bi* '[ _ _ heap-push ] each ;
todo>> push-links ;
: add-nonmatching ( links level spider -- )
nonmatching>> '[ _ _ heap-push ] each ;
: relative-url? ( url -- ? ) protocol>> not ;
nonmatching>> push-links ;
: filter-base ( spider spider-result -- base-links nonmatching-links )
[ base>> host>> ] [ links>> prune ] bi*
@ -51,26 +51,27 @@ links processing-time timestamp ;
[ filter-base ] 2keep
depth>> 1+ swap
[ add-nonmatching ]
[ add-todo ] 2bi ;
: print-spidering ( url depth -- )
"depth: " write number>string write
", spidering: " write . yield ;
[ tuck [ apply-filters ] 2dip add-todo ] 2bi ;
: normalize-hrefs ( links -- links' )
[ >url ] map
spider get base>> swap [ derive-url ] with map ;
: print-spidering ( url depth -- )
"depth: " write number>string write
", spidering: " write . yield ;
: (spider-page) ( url depth -- spider-result )
2dup print-spidering
f pick spider get spidered>> set-at
over '[ _ http-get ] benchmark swap
[ parse-html dup find-hrefs normalize-hrefs ] benchmark
now spider-result boa
dup describe ;
: spider-page ( url depth -- )
(spider-page) spider get swap add-spidered ;
spider get quiet>> [ 2dup print-spidering ] unless
(spider-page)
spider get [ quiet>> [ dup describe ] unless ]
[ swap add-spidered ] bi ;
\ spider-page ERROR add-error-logging