Merge branch 'master' of git://factorforge.org/git/littledan
commit
4b3bce6435
|
@ -5,8 +5,6 @@ USING: kernel math sequences arrays assocs sequences.private
|
|||
growable accessors math.order ;
|
||||
IN: heaps
|
||||
|
||||
MIXIN: priority-queue
|
||||
|
||||
GENERIC: heap-push* ( value key heap -- entry )
|
||||
GENERIC: heap-peek ( heap -- value key )
|
||||
GENERIC: heap-pop* ( heap -- )
|
||||
|
@ -36,13 +34,10 @@ TUPLE: max-heap < heap ;
|
|||
|
||||
: <max-heap> ( -- max-heap ) max-heap <heap> ;
|
||||
|
||||
INSTANCE: min-heap priority-queue
|
||||
INSTANCE: max-heap priority-queue
|
||||
|
||||
M: priority-queue heap-empty? ( heap -- ? )
|
||||
M: heap heap-empty? ( heap -- ? )
|
||||
data>> empty? ;
|
||||
|
||||
M: priority-queue heap-size ( heap -- n )
|
||||
M: heap heap-size ( heap -- n )
|
||||
data>> length ;
|
||||
|
||||
<PRIVATE
|
||||
|
@ -152,7 +147,7 @@ DEFER: down-heap
|
|||
|
||||
PRIVATE>
|
||||
|
||||
M: priority-queue heap-push* ( value key heap -- entry )
|
||||
M: heap heap-push* ( value key heap -- entry )
|
||||
[ <entry> dup ] keep [ data-push ] keep up-heap ;
|
||||
|
||||
: heap-push ( value key heap -- ) heap-push* drop ;
|
||||
|
@ -163,7 +158,7 @@ M: priority-queue heap-push* ( value key heap -- entry )
|
|||
: >entry< ( entry -- key value )
|
||||
[ value>> ] [ key>> ] bi ;
|
||||
|
||||
M: priority-queue heap-peek ( heap -- value key )
|
||||
M: heap heap-peek ( heap -- value key )
|
||||
data-first >entry< ;
|
||||
|
||||
: entry>index ( entry heap -- n )
|
||||
|
@ -172,7 +167,7 @@ M: priority-queue heap-peek ( heap -- value key )
|
|||
] unless
|
||||
entry-index ;
|
||||
|
||||
M: priority-queue heap-delete ( entry heap -- )
|
||||
M: heap heap-delete ( entry heap -- )
|
||||
[ entry>index ] keep
|
||||
2dup heap-size 1- = [
|
||||
nip data-pop*
|
||||
|
@ -182,10 +177,10 @@ M: priority-queue heap-delete ( entry heap -- )
|
|||
down-heap
|
||||
] if ;
|
||||
|
||||
M: priority-queue heap-pop* ( heap -- )
|
||||
M: heap heap-pop* ( heap -- )
|
||||
dup data-first swap heap-delete ;
|
||||
|
||||
M: priority-queue heap-pop ( heap -- value key )
|
||||
M: heap heap-pop ( heap -- value key )
|
||||
dup data-first [ swap heap-delete ] keep >entry< ;
|
||||
|
||||
: heap-pop-all ( heap -- alist )
|
||||
|
|
|
@ -1,9 +1,13 @@
|
|||
USING: help.syntax help.markup splitting kernel ;
|
||||
USING: help.syntax help.markup splitting kernel sequences ;
|
||||
IN: tuple-arrays
|
||||
|
||||
HELP: tuple-array
|
||||
{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link <tuple-array> } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back.." } ;
|
||||
{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link <tuple-array> } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back. To convert a sequence to a tuple array, use the word " { $link >tuple-array } "." } ;
|
||||
|
||||
HELP: <tuple-array>
|
||||
{ $values { "example" tuple } { "length" "a non-negative integer" } { "tuple-array" tuple-array } }
|
||||
{ $description "Creates an instance of the " { $link <tuple-array> } " class with the given length and containing the given tuple class. The tuple class is specified in the form of an example tuple. If the example tuple has a delegate, the tuple array will store a delegate for each element. Otherwise, the delegate will be assumed to be " { $link f } "." } ;
|
||||
{ $values { "class" "a tuple class" } { "length" "a non-negative integer" } { "tuple-array" tuple-array } }
|
||||
{ $description "Creates an instance of the " { $link <tuple-array> } " class with the given length and containing the given tuple class." } ;
|
||||
|
||||
HELP: >tuple-array
|
||||
{ $values { "seq" sequence } { "tuple-array" tuple-array } }
|
||||
{ $description "Converts a sequence into a homogeneous unboxed tuple array of the type indicated by the first element." } ;
|
||||
|
|
|
@ -1,16 +1,20 @@
|
|||
USING: tuple-arrays sequences tools.test namespaces kernel math ;
|
||||
USING: tuple-arrays sequences tools.test namespaces kernel math accessors ;
|
||||
IN: tuple-arrays.tests
|
||||
|
||||
SYMBOL: mat
|
||||
TUPLE: foo bar ;
|
||||
C: <foo> foo
|
||||
[ 2 ] [ 2 T{ foo } <tuple-array> dup mat set length ] unit-test
|
||||
[ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
|
||||
[ T{ foo } ] [ mat get first ] unit-test
|
||||
[ T{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test
|
||||
[ t ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test
|
||||
[ T{ foo f 3 } t ]
|
||||
[ mat get [ foo-bar 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test
|
||||
|
||||
[ 2 ] [ 2 T{ foo t } <tuple-array> dup mat set length ] unit-test
|
||||
[ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
|
||||
[ T{ foo } ] [ mat get first ] unit-test
|
||||
[ T{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test
|
||||
|
||||
TUPLE: baz { bing integer } bong ;
|
||||
[ 0 ] [ 1 baz <tuple-array> first bing>> ] unit-test
|
||||
[ f ] [ 1 baz <tuple-array> first bong>> ] unit-test
|
||||
|
|
|
@ -4,27 +4,26 @@ USING: splitting grouping classes.tuple classes math kernel
|
|||
sequences arrays accessors ;
|
||||
IN: tuple-arrays
|
||||
|
||||
TUPLE: tuple-array seq class ;
|
||||
TUPLE: tuple-array { seq read-only } { class read-only } ;
|
||||
|
||||
: <tuple-array> ( length example -- tuple-array )
|
||||
[ tuple>array length 1- [ * { } new-sequence ] keep <sliced-groups> ]
|
||||
[ class ] bi tuple-array boa ;
|
||||
: <tuple-array> ( length class -- tuple-array )
|
||||
[
|
||||
new tuple>array 1 tail
|
||||
[ <repetition> concat ] [ length ] bi <sliced-groups>
|
||||
] [ ] bi tuple-array boa ;
|
||||
|
||||
M: tuple-array nth
|
||||
[ seq>> nth ] [ class>> ] bi prefix >tuple ;
|
||||
|
||||
: deconstruct ( tuple -- seq )
|
||||
tuple>array 1 tail ;
|
||||
|
||||
M: tuple-array set-nth ( elt n seq -- )
|
||||
>r >r deconstruct r> r> seq>> set-nth ;
|
||||
>r >r tuple>array 1 tail r> r> seq>> set-nth ;
|
||||
|
||||
M: tuple-array new-sequence
|
||||
class>> new <tuple-array> ;
|
||||
class>> <tuple-array> ;
|
||||
|
||||
: >tuple-array ( seq -- tuple-array/seq )
|
||||
: >tuple-array ( seq -- tuple-array )
|
||||
dup empty? [
|
||||
0 over first <tuple-array> clone-like
|
||||
0 over first class <tuple-array> clone-like
|
||||
] unless ;
|
||||
|
||||
M: tuple-array like
|
||||
|
|
Loading…
Reference in New Issue