Search dequeues: constant-time insert/removal at both ends, membership test
parent
bdf77814e2
commit
4d0abcae4d
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,89 @@
|
|||
IN: dequeues
|
||||
USING: help.markup help.syntax kernel ;
|
||||
|
||||
ARTICLE: "dequeues" "Dequeues"
|
||||
"A dequeue is a data structure with constant-time insertion and removal of elements at both ends. Dequeue operations are defined in the " { $vocab-link "dequeues" } " vocabulary."
|
||||
$nl
|
||||
"Dequeues must be instances of a mixin class:"
|
||||
{ $subsection dequeue }
|
||||
"Dequeues must implement a protocol."
|
||||
$nl
|
||||
"Querying the dequeue:"
|
||||
{ $subsection peek-front }
|
||||
{ $subsection peek-back }
|
||||
{ $subsection dequeue-length }
|
||||
{ $subsection dequeue-member? }
|
||||
"Adding and removing elements:"
|
||||
{ $subsection push-front* }
|
||||
{ $subsection push-back* }
|
||||
{ $subsection pop-front* }
|
||||
{ $subsection pop-back* }
|
||||
{ $subsection clear-dequeue }
|
||||
"Working with node objects output by " { $link push-front* } " and " { $link push-back* } ":"
|
||||
{ $subsection delete-node }
|
||||
{ $subsection node-value }
|
||||
"Utility operations built in terms of the above:"
|
||||
{ $subsection dequeue-empty? }
|
||||
{ $subsection push-front }
|
||||
{ $subsection push-all-front }
|
||||
{ $subsection push-back }
|
||||
{ $subsection push-all-back }
|
||||
{ $subsection pop-front }
|
||||
{ $subsection pop-back }
|
||||
{ $subsection slurp-dequeue }
|
||||
"When using a dequeue as a queue, the convention is to queue elements with " { $link push-front } " and dequeue them with " { $link pop-back } "." ;
|
||||
|
||||
ABOUT: "dequeues"
|
||||
|
||||
HELP: dequeue-empty?
|
||||
{ $values { "dequeue" { $link dequeue } } { "?" "a boolean" } }
|
||||
{ $description "Returns true if a dequeue is empty." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-front
|
||||
{ $values { "obj" object } { "dequeue" dequeue } }
|
||||
{ $description "Push the object onto the front of the dequeue." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-front*
|
||||
{ $values { "obj" object } { "dequeue" dequeue } { "node" "a node" } }
|
||||
{ $description "Push the object onto the front of the dequeue and return the newly created node." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-back
|
||||
{ $values { "obj" object } { "dequeue" dequeue } }
|
||||
{ $description "Push the object onto the back of the dequeue." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-back*
|
||||
{ $values { "obj" object } { "dequeue" dequeue } { "node" "a node" } }
|
||||
{ $description "Push the object onto the back of the dequeue and return the newly created node." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: peek-front
|
||||
{ $values { "dequeue" dequeue } { "obj" object } }
|
||||
{ $description "Returns the object at the front of the dequeue." } ;
|
||||
|
||||
HELP: pop-front
|
||||
{ $values { "dequeue" dequeue } { "obj" object } }
|
||||
{ $description "Pop the object off the front of the dequeue and return the object." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: pop-front*
|
||||
{ $values { "dequeue" dequeue } }
|
||||
{ $description "Pop the object off the front of the dequeue." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: peek-back
|
||||
{ $values { "dequeue" dequeue } { "obj" object } }
|
||||
{ $description "Returns the object at the back of the dequeue." } ;
|
||||
|
||||
HELP: pop-back
|
||||
{ $values { "dequeue" dequeue } { "obj" object } }
|
||||
{ $description "Pop the object off the back of the dequeue and return the object." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: pop-back*
|
||||
{ $values { "dequeue" dequeue } }
|
||||
{ $description "Pop the object off the back of the dequeue." }
|
||||
{ $notes "This operation is O(1)." } ;
|
|
@ -0,0 +1,44 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences math ;
|
||||
IN: dequeues
|
||||
|
||||
GENERIC: push-front* ( obj dequeue -- node )
|
||||
GENERIC: push-back* ( obj dequeue -- node )
|
||||
GENERIC: peek-front ( dequeue -- obj )
|
||||
GENERIC: peek-back ( dequeue -- obj )
|
||||
GENERIC: pop-front* ( dequeue -- )
|
||||
GENERIC: pop-back* ( dequeue -- )
|
||||
GENERIC: delete-node ( node dequeue -- )
|
||||
GENERIC: dequeue-length ( dequeue -- n )
|
||||
GENERIC: dequeue-member? ( value dequeue -- ? )
|
||||
GENERIC: clear-dequeue ( dequeue -- )
|
||||
GENERIC: node-value ( node -- value )
|
||||
|
||||
: dequeue-empty? ( dequeue -- ? )
|
||||
dequeue-length zero? ;
|
||||
|
||||
: push-front ( obj dequeue -- )
|
||||
push-front* drop ;
|
||||
|
||||
: push-all-front ( seq dequeue -- )
|
||||
[ push-front ] curry each ;
|
||||
|
||||
: push-back ( obj dequeue -- )
|
||||
push-back* drop ;
|
||||
|
||||
: push-all-back ( seq dequeue -- )
|
||||
[ push-back ] curry each ;
|
||||
|
||||
: pop-front ( dequeue -- obj )
|
||||
[ peek-front ] [ pop-front* ] bi ;
|
||||
|
||||
: pop-back ( dequeue -- obj )
|
||||
[ peek-back ] [ pop-back* ] bi ;
|
||||
|
||||
: slurp-dequeue ( dequeue quot -- )
|
||||
over dequeue-empty? [ 2drop ] [
|
||||
[ [ pop-back ] dip call ] [ slurp-dequeue ] 2bi
|
||||
] if ; inline
|
||||
|
||||
MIXIN: dequeue
|
|
@ -0,0 +1 @@
|
|||
Double-ended queue protocol and common operations
|
|
@ -0,0 +1 @@
|
|||
collections
|
|
@ -1,103 +1,27 @@
|
|||
USING: help.markup help.syntax kernel quotations dlists.private ;
|
||||
USING: help.markup help.syntax kernel quotations
|
||||
dequeues ;
|
||||
IN: dlists
|
||||
|
||||
ARTICLE: "dlists" "Doubly-linked lists"
|
||||
"A doubly-linked list, or dlist, is a list of nodes. Each node has a link to the previous and next nodes, and a slot to store an object."
|
||||
ARTICLE: "dlists" "Double-linked lists"
|
||||
"A double-linked list is the canonical implementation of a " { $link dequeue } "."
|
||||
$nl
|
||||
"While nodes can be modified directly, the fundamental protocol support by doubly-linked lists is that of a double-ended queue with a few additional operations. Elements can be added or removed at both ends of the dlist in constant time."
|
||||
$nl
|
||||
"When using a dlist as a simple queue, the convention is to queue elements with " { $link push-front } " and dequeue them with " { $link pop-back } "."
|
||||
$nl
|
||||
"Dlists form a class:"
|
||||
"Double-linked lists form a class:"
|
||||
{ $subsection dlist }
|
||||
{ $subsection dlist? }
|
||||
"Constructing a dlist:"
|
||||
"Constructing a double-linked list:"
|
||||
{ $subsection <dlist> }
|
||||
"Working with the front of the list:"
|
||||
{ $subsection push-front }
|
||||
{ $subsection push-front* }
|
||||
{ $subsection peek-front }
|
||||
{ $subsection pop-front }
|
||||
{ $subsection pop-front* }
|
||||
"Working with the back of the list:"
|
||||
{ $subsection push-back }
|
||||
{ $subsection push-back* }
|
||||
{ $subsection peek-back }
|
||||
{ $subsection pop-back }
|
||||
{ $subsection pop-back* }
|
||||
"Finding out the length:"
|
||||
{ $subsection dlist-empty? }
|
||||
{ $subsection dlist-length }
|
||||
"Double-linked lists support all the operations of the dequeue protocol (" { $link "dequeues" } ") as well as the following."
|
||||
$nl
|
||||
"Iterating over elements:"
|
||||
{ $subsection dlist-each }
|
||||
{ $subsection dlist-find }
|
||||
{ $subsection dlist-contains? }
|
||||
"Deleting a node:"
|
||||
{ $subsection delete-node }
|
||||
{ $subsection dlist-delete }
|
||||
"Deleting a node matching a predicate:"
|
||||
{ $subsection delete-node-if* }
|
||||
{ $subsection delete-node-if }
|
||||
"Consuming all nodes:"
|
||||
{ $subsection dlist-slurp } ;
|
||||
{ $subsection delete-node-if } ;
|
||||
|
||||
ABOUT: "dlists"
|
||||
|
||||
HELP: dlist-empty?
|
||||
{ $values { "dlist" { $link dlist } } { "?" "a boolean" } }
|
||||
{ $description "Returns true if a " { $link dlist } " is empty." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-front
|
||||
{ $values { "obj" "an object" } { "dlist" dlist } }
|
||||
{ $description "Push the object onto the front of the " { $link dlist } "." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-front*
|
||||
{ $values { "obj" "an object" } { "dlist" dlist } { "dlist-node" dlist-node } }
|
||||
{ $description "Push the object onto the front of the " { $link dlist } " and return the newly created " { $snippet "dlist-node" } "." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-back
|
||||
{ $values { "obj" "an object" } { "dlist" dlist } }
|
||||
{ $description "Push the object onto the back of the " { $link dlist } "." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: push-back*
|
||||
{ $values { "obj" "an object" } { "dlist" dlist } { "dlist-node" dlist-node } }
|
||||
{ $description "Push the object onto the back of the " { $link dlist } " and return the newly created " { $snippet "dlist-node" } "." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: peek-front
|
||||
{ $values { "dlist" dlist } { "obj" "an object" } }
|
||||
{ $description "Returns the object at the front of the " { $link dlist } "." } ;
|
||||
|
||||
HELP: pop-front
|
||||
{ $values { "dlist" dlist } { "obj" "an object" } }
|
||||
{ $description "Pop the object off the front of the " { $link dlist } " and return the object." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: pop-front*
|
||||
{ $values { "dlist" dlist } }
|
||||
{ $description "Pop the object off the front of the " { $link dlist } "." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: peek-back
|
||||
{ $values { "dlist" dlist } { "obj" "an object" } }
|
||||
{ $description "Returns the object at the back of the " { $link dlist } "." } ;
|
||||
|
||||
HELP: pop-back
|
||||
{ $values { "dlist" dlist } { "obj" "an object" } }
|
||||
{ $description "Pop the object off the back of the " { $link dlist } " and return the object." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
HELP: pop-back*
|
||||
{ $values { "dlist" dlist } }
|
||||
{ $description "Pop the object off the back of the " { $link dlist } "." }
|
||||
{ $notes "This operation is O(1)." } ;
|
||||
|
||||
{ push-front push-front* push-back push-back* peek-front pop-front pop-front* peek-back pop-back pop-back* } related-words
|
||||
|
||||
HELP: dlist-find
|
||||
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } }
|
||||
{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, until it outputs a true value or the end of the " { $link dlist } " is reached. Outputs either the object it found or " { $link f } ", and a boolean which is true if an object is found." }
|
||||
|
|
|
@ -1,17 +1,17 @@
|
|||
USING: dlists dlists.private kernel tools.test random assocs
|
||||
sets sequences namespaces sorting debugger io prettyprint
|
||||
USING: dequeues dlists dlists.private kernel tools.test random
|
||||
assocs sets sequences namespaces sorting debugger io prettyprint
|
||||
math accessors classes ;
|
||||
IN: dlists.tests
|
||||
|
||||
[ t ] [ <dlist> dlist-empty? ] unit-test
|
||||
[ t ] [ <dlist> dequeue-empty? ] unit-test
|
||||
|
||||
[ T{ dlist f T{ dlist-node f 1 f f } T{ dlist-node f 1 f f } 1 } ]
|
||||
[ <dlist> 1 over push-front ] unit-test
|
||||
|
||||
! Make sure empty lists are empty
|
||||
[ t ] [ <dlist> dlist-empty? ] unit-test
|
||||
[ f ] [ <dlist> 1 over push-front dlist-empty? ] unit-test
|
||||
[ f ] [ <dlist> 1 over push-back dlist-empty? ] unit-test
|
||||
[ t ] [ <dlist> dequeue-empty? ] unit-test
|
||||
[ f ] [ <dlist> 1 over push-front dequeue-empty? ] unit-test
|
||||
[ f ] [ <dlist> 1 over push-back dequeue-empty? ] unit-test
|
||||
|
||||
[ 1 ] [ <dlist> 1 over push-front pop-front ] unit-test
|
||||
[ 1 ] [ <dlist> 1 over push-front pop-back ] unit-test
|
||||
|
@ -25,22 +25,22 @@ IN: dlists.tests
|
|||
! Test the prev,next links for two nodes
|
||||
[ f ] [
|
||||
<dlist> 1 over push-back 2 over push-back
|
||||
dlist-front dlist-node-prev
|
||||
front>> prev>>
|
||||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
<dlist> 1 over push-back 2 over push-back
|
||||
dlist-front dlist-node-next dlist-node-obj
|
||||
front>> next>> obj>>
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [
|
||||
<dlist> 1 over push-back 2 over push-back
|
||||
dlist-front dlist-node-next dlist-node-prev dlist-node-obj
|
||||
front>> next>> prev>> obj>>
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
<dlist> 1 over push-back 2 over push-back
|
||||
dlist-front dlist-node-next dlist-node-next
|
||||
front>> next>> next>>
|
||||
] unit-test
|
||||
|
||||
[ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
|
||||
|
@ -50,55 +50,24 @@ IN: dlists.tests
|
|||
[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-contains? ] unit-test
|
||||
|
||||
[ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
|
||||
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dlist-empty? ] unit-test
|
||||
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dlist-empty? ] unit-test
|
||||
[ 0 ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dlist-length ] unit-test
|
||||
[ 1 ] [ <dlist> 1 over push-back 2 over push-back dup [ 1 = ] delete-node-if drop dlist-length ] unit-test
|
||||
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 1 = ] delete-node-if drop dlist-length ] unit-test
|
||||
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 2 = ] delete-node-if drop dlist-length ] unit-test
|
||||
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 3 = ] delete-node-if drop dlist-length ] unit-test
|
||||
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dequeue-empty? ] unit-test
|
||||
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dequeue-empty? ] unit-test
|
||||
[ 0 ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop dequeue-length ] unit-test
|
||||
[ 1 ] [ <dlist> 1 over push-back 2 over push-back dup [ 1 = ] delete-node-if drop dequeue-length ] unit-test
|
||||
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 1 = ] delete-node-if drop dequeue-length ] unit-test
|
||||
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 2 = ] delete-node-if drop dequeue-length ] unit-test
|
||||
[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 3 = ] delete-node-if drop dequeue-length ] unit-test
|
||||
|
||||
[ 0 ] [ <dlist> dlist-length ] unit-test
|
||||
[ 1 ] [ <dlist> 1 over push-front dlist-length ] unit-test
|
||||
[ 0 ] [ <dlist> 1 over push-front dup pop-front* dlist-length ] unit-test
|
||||
|
||||
: assert-same-elements
|
||||
[ prune natural-sort ] bi@ assert= ;
|
||||
|
||||
: dlist-delete-all [ dlist-delete drop ] curry each ;
|
||||
|
||||
: dlist>array [ [ , ] dlist-slurp ] { } make ;
|
||||
|
||||
[ ] [
|
||||
5 [ drop 30 random >fixnum ] map prune
|
||||
6 [ drop 30 random >fixnum ] map prune [
|
||||
<dlist>
|
||||
[ push-all-front ]
|
||||
[ dlist-delete-all ]
|
||||
[ dlist>array ] tri
|
||||
] 2keep swap diff assert-same-elements
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
<dlist> "d" set
|
||||
1 "d" get push-front
|
||||
2 "d" get push-front
|
||||
3 "d" get push-front
|
||||
4 "d" get push-front
|
||||
2 "d" get dlist-delete drop
|
||||
3 "d" get dlist-delete drop
|
||||
4 "d" get dlist-delete drop
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [ "d" get dlist-length ] unit-test
|
||||
[ 1 ] [ "d" get dlist>array length ] unit-test
|
||||
[ 0 ] [ <dlist> dequeue-length ] unit-test
|
||||
[ 1 ] [ <dlist> 1 over push-front dequeue-length ] unit-test
|
||||
[ 0 ] [ <dlist> 1 over push-front dup pop-front* dequeue-length ] unit-test
|
||||
|
||||
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node drop class dlist-node = ] unit-test
|
||||
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node drop class dlist-node = ] unit-test
|
||||
[ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node drop class dlist-node = ] unit-test
|
||||
[ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
|
||||
|
||||
[ <dlist> peek-front ] must-fail
|
||||
[ <dlist> peek-back ] must-fail
|
||||
[ <dlist> peek-front ] [ empty-dlist? ] must-fail-with
|
||||
[ <dlist> peek-back ] [ empty-dlist? ] must-fail-with
|
||||
[ <dlist> pop-front ] [ empty-dlist? ] must-fail-with
|
||||
[ <dlist> pop-back ] [ empty-dlist? ] must-fail-with
|
||||
|
|
|
@ -1,16 +1,17 @@
|
|||
! Copyright (C) 2007, 2008 Mackenzie Straight, Doug Coleman,
|
||||
! Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators kernel math sequences accessors inspector ;
|
||||
USING: combinators kernel math sequences accessors inspector
|
||||
dequeues ;
|
||||
IN: dlists
|
||||
|
||||
TUPLE: dlist front back length ;
|
||||
|
||||
: <dlist> ( -- obj )
|
||||
dlist new
|
||||
0 >>length ;
|
||||
0 >>length ;
|
||||
|
||||
: dlist-empty? ( dlist -- ? ) front>> not ;
|
||||
M: dlist dequeue-length length>> ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
@ -18,6 +19,8 @@ TUPLE: dlist-node obj prev next ;
|
|||
|
||||
C: <dlist-node> dlist-node
|
||||
|
||||
M: dlist-node node-value obj>> ;
|
||||
|
||||
: inc-length ( dlist -- )
|
||||
[ 1+ ] change-length drop ; inline
|
||||
|
||||
|
@ -57,69 +60,59 @@ C: <dlist-node> dlist-node
|
|||
: dlist-each-node ( dlist quot -- )
|
||||
[ f ] compose dlist-find-node 2drop ; inline
|
||||
|
||||
: unlink-node ( dlist-node -- )
|
||||
dup prev>> over next>> set-prev-when
|
||||
dup next>> swap prev>> set-next-when ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: push-front* ( obj dlist -- dlist-node )
|
||||
M: dlist push-front* ( obj dlist -- dlist-node )
|
||||
[ front>> f swap <dlist-node> dup dup set-next-prev ] keep
|
||||
[ (>>front) ] keep
|
||||
[ set-back-to-front ] keep
|
||||
inc-length ;
|
||||
|
||||
: push-front ( obj dlist -- )
|
||||
push-front* drop ;
|
||||
|
||||
: push-all-front ( seq dlist -- )
|
||||
[ push-front ] curry each ;
|
||||
|
||||
: push-back* ( obj dlist -- dlist-node )
|
||||
M: dlist push-back* ( obj dlist -- dlist-node )
|
||||
[ back>> f <dlist-node> ] keep
|
||||
[ back>> set-next-when ] 2keep
|
||||
[ (>>back) ] 2keep
|
||||
[ set-front-to-back ] keep
|
||||
inc-length ;
|
||||
|
||||
: push-back ( obj dlist -- )
|
||||
push-back* drop ;
|
||||
|
||||
: push-all-back ( seq dlist -- )
|
||||
[ push-back ] curry each ;
|
||||
|
||||
ERROR: empty-dlist ;
|
||||
|
||||
M: empty-dlist summary ( dlist -- )
|
||||
drop "Emtpy dlist" ;
|
||||
drop "Empty dlist" ;
|
||||
|
||||
: peek-front ( dlist -- obj )
|
||||
front>> [ empty-dlist ] unless* obj>> ;
|
||||
M: dlist peek-front ( dlist -- obj )
|
||||
front>> [ obj>> ] [ empty-dlist ] if* ;
|
||||
|
||||
: pop-front ( dlist -- obj )
|
||||
dup front>> [ empty-dlist ] unless*
|
||||
M: dlist pop-front* ( dlist -- )
|
||||
dup front>> [ empty-dlist ] unless
|
||||
[
|
||||
dup front>>
|
||||
dup next>>
|
||||
f rot (>>next)
|
||||
f over set-prev-when
|
||||
swap (>>front)
|
||||
] 2keep obj>>
|
||||
swap [ normalize-back ] keep dec-length ;
|
||||
] keep
|
||||
[ normalize-back ] keep
|
||||
dec-length ;
|
||||
|
||||
: pop-front* ( dlist -- )
|
||||
pop-front drop ;
|
||||
M: dlist peek-back ( dlist -- obj )
|
||||
back>> [ obj>> ] [ empty-dlist ] if* ;
|
||||
|
||||
: peek-back ( dlist -- obj )
|
||||
back>> [ empty-dlist ] unless* obj>> ;
|
||||
|
||||
: pop-back ( dlist -- obj )
|
||||
dup back>> [ empty-dlist ] unless*
|
||||
M: dlist pop-back* ( dlist -- )
|
||||
dup back>> [ empty-dlist ] unless
|
||||
[
|
||||
dup back>>
|
||||
dup prev>>
|
||||
f rot (>>prev)
|
||||
f over set-next-when
|
||||
swap (>>back)
|
||||
] 2keep obj>>
|
||||
swap [ normalize-front ] keep dec-length ;
|
||||
|
||||
: pop-back* ( dlist -- )
|
||||
pop-back drop ;
|
||||
] keep
|
||||
[ normalize-front ] keep
|
||||
dec-length ;
|
||||
|
||||
: dlist-find ( dlist quot -- obj/f ? )
|
||||
[ obj>> ] prepose
|
||||
|
@ -128,21 +121,20 @@ M: empty-dlist summary ( dlist -- )
|
|||
: dlist-contains? ( dlist quot -- ? )
|
||||
dlist-find nip ; inline
|
||||
|
||||
: unlink-node ( dlist-node -- )
|
||||
dup prev>> over next>> set-prev-when
|
||||
dup next>> swap prev>> set-next-when ;
|
||||
M: dlist dequeue-member? ( value dlist -- ? )
|
||||
[ = ] curry dlist-contains? ;
|
||||
|
||||
: delete-node ( dlist dlist-node -- )
|
||||
M: dlist delete-node ( dlist-node dlist -- )
|
||||
{
|
||||
{ [ over front>> over eq? ] [ drop pop-front* ] }
|
||||
{ [ over back>> over eq? ] [ drop pop-back* ] }
|
||||
[ unlink-node dec-length ]
|
||||
{ [ 2dup front>> eq? ] [ nip pop-front* ] }
|
||||
{ [ 2dup back>> eq? ] [ nip pop-back* ] }
|
||||
[ dec-length unlink-node ]
|
||||
} cond ;
|
||||
|
||||
: delete-node-if* ( dlist quot -- obj/f ? )
|
||||
dupd dlist-find-node [
|
||||
dup [
|
||||
[ delete-node ] keep obj>> t
|
||||
[ swap delete-node ] keep obj>> t
|
||||
] [
|
||||
2drop f f
|
||||
] if
|
||||
|
@ -151,13 +143,9 @@ M: empty-dlist summary ( dlist -- )
|
|||
] if ; inline
|
||||
|
||||
: delete-node-if ( dlist quot -- obj/f )
|
||||
[ obj>> ] prepose
|
||||
delete-node-if* drop ; inline
|
||||
[ obj>> ] prepose delete-node-if* drop ; inline
|
||||
|
||||
: dlist-delete ( obj dlist -- obj/f )
|
||||
swap [ eq? ] curry delete-node-if ;
|
||||
|
||||
: dlist-delete-all ( dlist -- )
|
||||
M: dlist clear-dequeue ( dlist -- )
|
||||
f >>front
|
||||
f >>back
|
||||
0 >>length
|
||||
|
@ -166,9 +154,6 @@ M: empty-dlist summary ( dlist -- )
|
|||
: dlist-each ( dlist quot -- )
|
||||
[ obj>> ] prepose dlist-each-node ; inline
|
||||
|
||||
: dlist-slurp ( dlist quot -- )
|
||||
over dlist-empty?
|
||||
[ 2drop ] [ [ >r pop-back r> call ] 2keep dlist-slurp ] if ;
|
||||
inline
|
||||
|
||||
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
||||
|
||||
INSTANCE: dlist dequeue
|
||||
|
|
|
@ -0,0 +1,19 @@
|
|||
IN: search-dequeues
|
||||
USING: help.markup help.syntax kernel dlists hashtables
|
||||
dequeues assocs ;
|
||||
|
||||
ARTICLE: "search-dequeues" "Search dequeues"
|
||||
"A search dequeue is a data structure with constant-time insertion and removal of elements at both ends, and constant-time membership tests. Inserting an element more than once has no effect. Search dequeues implement all dequeue operations in terms of an underlying dequeue, and membership testing with " { $link dequeue-member? } " is implemented with an underlying assoc. Search dequeues are defined in the " { $vocab-link "search-dequeues" } " vocabulary."
|
||||
$nl
|
||||
"Creating a search dequeue:"
|
||||
{ $subsection <search-dequeue> }
|
||||
"Default implementation:"
|
||||
{ $subsection <hashed-dlist> } ;
|
||||
|
||||
HELP: <search-dequeue> ( assoc dequeue -- search-dequeue )
|
||||
{ $values { "assoc" assoc } { "dequeue" dequeue } { "search-dequeue" search-dequeue } }
|
||||
{ $description "Creates a new " { $link search-dequeue } "." } ;
|
||||
|
||||
HELP: <hashed-dlist> ( -- search-dequeue )
|
||||
{ $values { "search-dequeue" search-dequeue } }
|
||||
{ $description "Creates a new " { $link search-dequeue } " backed by a " { $link dlist } ", with a " { $link hashtable } " for fast membership tests." } ;
|
|
@ -0,0 +1,35 @@
|
|||
IN: search-dequeues.tests
|
||||
USING: search-dequeues tools.test namespaces
|
||||
kernel sequences words dequeues vocabs ;
|
||||
|
||||
<hashed-dlist> "h" set
|
||||
|
||||
[ t ] [ "h" get dequeue-empty? ] unit-test
|
||||
|
||||
[ ] [ 3 "h" get push-front* "1" set ] unit-test
|
||||
[ ] [ 1 "h" get push-front ] unit-test
|
||||
[ ] [ 3 "h" get push-front* "2" set ] unit-test
|
||||
[ ] [ 3 "h" get push-front* "3" set ] unit-test
|
||||
[ ] [ 7 "h" get push-front ] unit-test
|
||||
|
||||
[ t ] [ "1" get "2" get eq? ] unit-test
|
||||
[ t ] [ "2" get "3" get eq? ] unit-test
|
||||
|
||||
[ 3 ] [ "h" get dequeue-length ] unit-test
|
||||
[ t ] [ 7 "h" get dequeue-member? ] unit-test
|
||||
|
||||
[ 3 ] [ "1" get node-value ] unit-test
|
||||
[ ] [ "1" get "h" get delete-node ] unit-test
|
||||
|
||||
[ 2 ] [ "h" get dequeue-length ] unit-test
|
||||
[ 1 ] [ "h" get pop-back ] unit-test
|
||||
[ 7 ] [ "h" get pop-back ] unit-test
|
||||
|
||||
[ f ] [ 7 "h" get dequeue-member? ] unit-test
|
||||
|
||||
[ ] [
|
||||
<hashed-dlist>
|
||||
[ all-words swap [ push-front ] curry each ]
|
||||
[ [ drop ] slurp-dequeue ]
|
||||
bi
|
||||
] unit-test
|
|
@ -0,0 +1,53 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel assocs dequeues dlists hashtables ;
|
||||
IN: search-dequeues
|
||||
|
||||
TUPLE: search-dequeue assoc dequeue ;
|
||||
|
||||
C: <search-dequeue> search-dequeue
|
||||
|
||||
: <hashed-dlist> ( -- search-dequeue )
|
||||
0 <hashtable> <dlist> <search-dequeue> ;
|
||||
|
||||
M: search-dequeue dequeue-length dequeue>> dequeue-length ;
|
||||
|
||||
M: search-dequeue peek-front dequeue>> peek-front ;
|
||||
|
||||
M: search-dequeue peek-back dequeue>> peek-back ;
|
||||
|
||||
M: search-dequeue push-front*
|
||||
2dup assoc>> at* [ 2nip ] [
|
||||
drop
|
||||
[ dequeue>> push-front* ] [ assoc>> ] 2bi
|
||||
[ 2drop ] [ set-at ] 3bi
|
||||
] if ;
|
||||
|
||||
M: search-dequeue push-back*
|
||||
2dup assoc>> at* [ 2nip ] [
|
||||
drop
|
||||
[ dequeue>> push-back* ] [ assoc>> ] 2bi
|
||||
[ 2drop ] [ set-at ] 3bi
|
||||
] if ;
|
||||
|
||||
M: search-dequeue pop-front*
|
||||
[ [ dequeue>> peek-front ] [ assoc>> ] bi delete-at ]
|
||||
[ dequeue>> pop-front* ]
|
||||
bi ;
|
||||
|
||||
M: search-dequeue pop-back*
|
||||
[ [ dequeue>> peek-back ] [ assoc>> ] bi delete-at ]
|
||||
[ dequeue>> pop-back* ]
|
||||
bi ;
|
||||
|
||||
M: search-dequeue delete-node
|
||||
[ dequeue>> delete-node ]
|
||||
[ [ node-value ] [ assoc>> ] bi* delete-at ] 2bi ;
|
||||
|
||||
M: search-dequeue clear-dequeue
|
||||
[ dequeue>> clear-dequeue ] [ assoc>> clear-assoc ] bi ;
|
||||
|
||||
M: search-dequeue dequeue-member?
|
||||
assoc>> key? ;
|
||||
|
||||
INSTANCE: search-dequeue dequeue
|
|
@ -157,12 +157,17 @@ ARTICLE: "collections" "Collections"
|
|||
{ $subsection "hashtables" }
|
||||
{ $subsection "alists" }
|
||||
{ $subsection "enums" }
|
||||
{ $heading "Double-ended queues" }
|
||||
{ $subsection "dequeues" }
|
||||
"Implementations:"
|
||||
{ $subsection "dlists" }
|
||||
{ $subsection "search-dequeues" }
|
||||
{ $heading "Other collections" }
|
||||
{ $subsection "boxes" }
|
||||
{ $subsection "dlists" }
|
||||
{ $subsection "heaps" }
|
||||
{ $subsection "graphs" }
|
||||
{ $subsection "buffers" } ;
|
||||
{ $subsection "buffers" }
|
||||
"There are many other collections in " { $snippet "extra/" } ", such as " { $vocab-link "disjoint-set" } ", " { $vocab-link "persistent-vectors" } ", and " { $vocab-link "tuple-arrays" } "." ;
|
||||
|
||||
USING: io.sockets io.launcher io.mmap io.monitors
|
||||
io.encodings.utf8 io.encodings.utf16 io.encodings.binary io.encodings.ascii io.files ;
|
||||
|
|
Loading…
Reference in New Issue