Merge branch 'master' of git://factorcode.org/git/factor
commit
d1d0b7d34e
|
@ -272,8 +272,8 @@ HELP: nweave
|
||||||
|
|
||||||
HELP: n*quot
|
HELP: n*quot
|
||||||
{ $values
|
{ $values
|
||||||
{ "n" integer } { "seq" sequence }
|
{ "n" integer } { "quot" quotation }
|
||||||
{ "seq'" sequence }
|
{ "quot'" quotation }
|
||||||
}
|
}
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: generalizations prettyprint math ;"
|
{ $example "USING: generalizations prettyprint math ;"
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: generalizations
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
|
||||||
: n*quot ( n seq -- seq' ) <repetition> concat >quotation ;
|
: n*quot ( n quot -- seq' ) <repetition> concat >quotation ;
|
||||||
|
|
||||||
: repeat ( n obj quot -- ) swapd times ; inline
|
: repeat ( n obj quot -- ) swapd times ; inline
|
||||||
|
|
||||||
|
@ -94,4 +94,4 @@ MACRO: nweave ( n -- )
|
||||||
: nappend-as ( n exemplar -- seq )
|
: nappend-as ( n exemplar -- seq )
|
||||||
[ narray concat ] dip like ; inline
|
[ narray concat ] dip like ; inline
|
||||||
|
|
||||||
: nappend ( n -- seq ) narray concat ; inline
|
: nappend ( n -- seq ) narray concat ; inline
|
||||||
|
|
|
@ -14,7 +14,7 @@ HELP: compare-slots
|
||||||
HELP: sort-by-slots
|
HELP: sort-by-slots
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" }
|
{ "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" }
|
||||||
{ "sortedseq" sequence }
|
{ "seq'" sequence }
|
||||||
}
|
}
|
||||||
{ $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." }
|
{ $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -42,7 +42,7 @@ HELP: split-by-slots
|
||||||
HELP: sort-by
|
HELP: sort-by
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "sort-seq" "a sequence of comparators" }
|
{ "seq" sequence } { "sort-seq" "a sequence of comparators" }
|
||||||
{ "sortedseq" sequence }
|
{ "seq'" sequence }
|
||||||
}
|
}
|
||||||
{ $description "Sorts a sequence by comparing elements by comparators, using subsequent comparators when there is a tie." } ;
|
{ $description "Sorts a sequence by comparing elements by comparators, using subsequent comparators when there is a tie." } ;
|
||||||
|
|
||||||
|
|
|
@ -159,3 +159,15 @@ TUPLE: tuple2 d ;
|
||||||
{ { 3 2 1 } { 1 2 3 } { 1 3 2 } { 1 } }
|
{ { 3 2 1 } { 1 2 3 } { 1 3 2 } { 1 } }
|
||||||
{ length-test<=> <=> } sort-by
|
{ length-test<=> <=> } sort-by
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
[ { { 0 1 } { 1 2 } { 1 1 } { 3 2 } } ]
|
||||||
|
[
|
||||||
|
{ { 3 2 } { 1 2 } { 0 1 } { 1 1 } }
|
||||||
|
{ length-test<=> <=> } sort-keys-by
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { { 0 1 } { 1 1 } { 3 2 } { 1 2 } } ]
|
||||||
|
[
|
||||||
|
{ { 3 2 } { 1 2 } { 0 1 } { 1 1 } }
|
||||||
|
{ length-test<=> <=> } sort-values-by
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -8,12 +8,13 @@ IN: sorting.slots
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: short-circuit-comparator ( obj1 obj2 word -- comparator/? )
|
: short-circuit-comparator ( obj1 obj2 word -- comparator/? )
|
||||||
execute dup +eq+ eq? [ drop f ] when ; inline
|
execute( obj1 obj2 -- obj3 )
|
||||||
|
dup +eq+ eq? [ drop f ] when ; inline
|
||||||
|
|
||||||
: slot-comparator ( seq -- quot )
|
: slot-comparator ( seq -- quot )
|
||||||
[
|
[
|
||||||
but-last-slice
|
but-last-slice
|
||||||
[ '[ [ _ execute ] bi@ ] ] map concat
|
[ '[ [ _ execute( tuple -- value ) ] bi@ ] ] map concat
|
||||||
] [
|
] [
|
||||||
peek
|
peek
|
||||||
'[ @ _ short-circuit-comparator ]
|
'[ @ _ short-circuit-comparator ]
|
||||||
|
@ -25,21 +26,22 @@ MACRO: compare-slots ( sort-specs -- <=> )
|
||||||
#! sort-spec: { accessors comparator }
|
#! sort-spec: { accessors comparator }
|
||||||
[ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
|
[ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
|
||||||
|
|
||||||
MACRO: sort-by-slots ( sort-specs -- quot )
|
: sort-by-slots ( seq sort-specs -- seq' )
|
||||||
'[ [ _ compare-slots ] sort ] ;
|
'[ _ compare-slots ] sort ;
|
||||||
|
|
||||||
MACRO: compare-seq ( seq -- quot )
|
MACRO: compare-seq ( seq -- quot )
|
||||||
[ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
|
[ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
|
||||||
|
|
||||||
MACRO: sort-by ( sort-seq -- quot )
|
: sort-by ( seq sort-seq -- seq' )
|
||||||
'[ [ _ compare-seq ] sort ] ;
|
'[ _ compare-seq ] sort ;
|
||||||
|
|
||||||
MACRO: sort-keys-by ( sort-seq -- quot )
|
: sort-keys-by ( seq sort-seq -- seq' )
|
||||||
'[ [ first ] bi@ _ compare-seq ] sort ;
|
'[ [ first ] bi@ _ compare-seq ] sort ;
|
||||||
|
|
||||||
MACRO: sort-values-by ( sort-seq -- quot )
|
: sort-values-by ( seq sort-seq -- seq' )
|
||||||
'[ [ second ] bi@ _ compare-seq ] sort ;
|
'[ [ second ] bi@ _ compare-seq ] sort ;
|
||||||
|
|
||||||
MACRO: split-by-slots ( accessor-seqs -- quot )
|
MACRO: split-by-slots ( accessor-seqs -- quot )
|
||||||
[ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
|
[ [ '[ [ _ execute( tuple -- value ) ] bi@ ] ] map concat
|
||||||
|
[ = ] compose ] map
|
||||||
'[ [ _ 2&& ] slice monotonic-slice ] ;
|
'[ [ _ 2&& ] slice monotonic-slice ] ;
|
||||||
|
|
|
@ -222,7 +222,7 @@ M: slot-spec make-slot
|
||||||
[ make-slot ] map ;
|
[ make-slot ] map ;
|
||||||
|
|
||||||
: finalize-slots ( specs base -- specs )
|
: finalize-slots ( specs base -- specs )
|
||||||
over length [ + ] with map [ >>offset ] 2map ;
|
over length iota [ + ] with map [ >>offset ] 2map ;
|
||||||
|
|
||||||
: slot-named ( name specs -- spec/f )
|
: slot-named ( name specs -- spec/f )
|
||||||
[ name>> = ] with find nip ;
|
[ name>> = ] with find nip ;
|
||||||
|
|
Loading…
Reference in New Issue