--- /dev/null
+Daniel Ehrenberg
--- /dev/null
+USING: help.markup help.syntax kernel sequences ;
+IN: persistent.deques
+
+ARTICLE: "persistent.deques" "Persistent deques"
+"A deque is a data structure that can be used as both a queue and a stack. That is, there are two ends, the left and the right, and values can be pushed onto and popped off of both ends. These operations take O(1) amortized time and space in a normal usage pattern."
+$nl
+"This vocabulary provides a deque implementation which is persistent and purely functional: old versions of deques are not modified by operations. Instead, each push and pop operation creates a new deque based off the old one."
+$nl
+"The class of persistent deques:"
+{ $subsection deque }
+"To create a deque:"
+{ $subsection <deque> }
+{ $subsection sequence>deque }
+"To test if a deque is empty:"
+{ $subsection deque-empty? }
+"To manipulate deques:"
+{ $subsection push-left }
+{ $subsection push-right }
+{ $subsection pop-left }
+{ $subsection pop-right }
+{ $subsection deque>sequence } ;
+
+HELP: deque
+{ $class-description "This is the class of persistent (functional) double-ended queues. All deque operations can be done in O(1) amortized time for single-threaded access while maintaining the old version. For more information, see " { $link "persistent.deques" } "." } ;
+
+HELP: <deque>
+{ $values { "deque" "an empty deque" } }
+{ $description "Creates an empty deque." } ;
+
+HELP: sequence>deque
+{ $values { "sequence" sequence } { "deque" deque } }
+{ $description "Given a sequence, creates a deque containing those elements in the order such that the beginning of the sequence is on the left and the end is on the right." } ;
+
+HELP: deque>sequence
+{ $values { "deque" deque } { "sequence" sequence } }
+{ $description "Given a deque, creates a sequence containing those elements, such that the left side of the deque is the beginning of the sequence." } ;
+
+HELP: deque-empty?
+{ $values { "deque" deque } { "?" "t/f" } }
+{ $description "Returns true if the deque is empty. This takes constant time." } ;
+
+HELP: push-left
+{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the given object pushed onto the left side. This takes constant time." } ;
+
+HELP: push-right
+{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the given object pushed onto the right side. This takes constant time." } ;
+
+HELP: pop-left
+{ $values { "deque" object } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the leftmost item removed. This takes amortized constant time with single-threaded access." } ;
+
+HELP: pop-right
+{ $values { "deque" object } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the rightmost item removed. This takes amortized constant time with single-threaded access." } ;
--- /dev/null
+! Copyright (C) 2008 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test persistent.deques kernel math ;
+IN: persistent.deques.tests
+
+[ 3 2 1 t ]
+[ { 1 2 3 } sequence>deque 3 [ pop-right ] times deque-empty? ] unit-test
+
+[ 1 2 3 t ]
+[ { 1 2 3 } sequence>deque 3 [ pop-left ] times deque-empty? ] unit-test
+
+[ 1 3 2 t ]
+[ { 1 2 3 } sequence>deque pop-left 2 [ pop-right ] times deque-empty? ]
+unit-test
+
+[ { 2 3 4 5 6 1 } ]
+[ { 1 2 3 4 5 6 } sequence>deque pop-left swap push-right deque>sequence ]
+unit-test
+
+[ 1 t ] [ <deque> 1 push-left pop-right deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-left pop-left deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-right pop-left deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-right pop-right deque-empty? ] unit-test
+
+[ 1 f ]
+[ <deque> 1 push-left 2 push-left pop-right deque-empty? ] unit-test
+
+[ 1 f ]
+[ <deque> 1 push-right 2 push-right pop-left deque-empty? ] unit-test
+
+[ 2 f ]
+[ <deque> 1 push-right 2 push-right pop-right deque-empty? ] unit-test
+
+[ 2 f ]
+[ <deque> 1 push-left 2 push-left pop-left deque-empty? ] unit-test
--- /dev/null
+! Copyright (C) 2008 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors math qualified ;
+QUALIFIED: sequences
+IN: persistent.deques
+
+! Amortized O(1) push/pop on both ends for single-threaded access
+! In a pathological case, if there are m modified versions from the
+! same source, it could take O(m) amortized time per update.
+
+<PRIVATE
+TUPLE: cons { car read-only } { cdr read-only } ;
+C: <cons> cons
+
+: each ( list quot -- )
+ over
+ [ [ >r car>> r> call ] [ >r cdr>> r> ] 2bi each ]
+ [ 2drop ] if ; inline
+
+: reduce ( list start quot -- end )
+ swapd each ; inline
+
+: reverse ( list -- reversed )
+ f [ swap <cons> ] reduce ;
+
+: length ( list -- length )
+ 0 [ drop 1+ ] reduce ;
+
+: cut ( list index -- back front-reversed )
+ f swap [ >r [ cdr>> ] [ car>> ] bi r> <cons> ] times ;
+
+: split-reverse ( list -- back-reversed front )
+ dup length 2/ cut [ reverse ] bi@ ;
+PRIVATE>
+
+TUPLE: deque { lhs read-only } { rhs read-only } ;
+: <deque> ( -- deque ) T{ deque } ;
+
+: deque-empty? ( deque -- ? )
+ [ lhs>> ] [ rhs>> ] bi or not ;
+
+: push-left ( deque item -- newdeque )
+ swap [ lhs>> <cons> ] [ rhs>> ] bi deque boa ;
+
+: push-right ( deque item -- newdeque )
+ swap [ rhs>> <cons> ] [ lhs>> ] bi swap deque boa ;
+
+<PRIVATE
+: (pop-left) ( deque -- item newdeque )
+ [ lhs>> car>> ] [ [ lhs>> cdr>> ] [ rhs>> ] bi deque boa ] bi ;
+
+: transfer-left ( deque -- item newdeque )
+ rhs>> [ split-reverse deque boa (pop-left) ]
+ [ "Popping from an empty deque" throw ] if* ;
+PRIVATE>
+
+: pop-left ( deque -- item newdeque )
+ dup lhs>> [ (pop-left) ] [ transfer-left ] if ;
+
+<PRIVATE
+: (pop-right) ( deque -- item newdeque )
+ [ rhs>> car>> ] [ [ lhs>> ] [ rhs>> cdr>> ] bi deque boa ] bi ;
+
+: transfer-right ( deque -- newdeque item )
+ lhs>> [ split-reverse deque boa (pop-left) ]
+ [ "Popping from an empty deque" throw ] if* ;
+PRIVATE>
+
+: pop-right ( deque -- item newdeque )
+ dup rhs>> [ (pop-right) ] [ transfer-right ] if ;
+
+: sequence>deque ( sequence -- deque )
+ <deque> [ push-right ] sequences:reduce ;
+
+: deque>sequence ( deque -- sequence )
+ [ dup deque-empty? not ] [ pop-left swap ] [ ] sequences:produce nip ;
--- /dev/null
+Persistent amortized O(1) deques
--- /dev/null
+collections
projects / factor.git / commitdiff