From 8fdb3bb27aeb1969315585630d8d6c5c9caeba89 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Apr 2009 19:43:10 -0500 Subject: [PATCH 1/3] define a sort-by to take a sequence of comparators without slots --- basis/sorting/slots/slots-tests.factor | 18 +++++++++++++++++- basis/sorting/slots/slots.factor | 14 ++++++++++++-- 2 files changed, 29 insertions(+), 3 deletions(-) diff --git a/basis/sorting/slots/slots-tests.factor b/basis/sorting/slots/slots-tests.factor index 46824c6fdb..83900461c3 100644 --- a/basis/sorting/slots/slots-tests.factor +++ b/basis/sorting/slots/slots-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors math.order sorting.slots tools.test -sorting.human arrays sequences kernel assocs multiline ; +sorting.human arrays sequences kernel assocs multiline +sorting.functor ; IN: sorting.literals.tests TUPLE: sort-test a b c tuple2 ; @@ -76,6 +77,9 @@ TUPLE: tuple2 d ; [ { } ] [ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test +[ { } ] +[ { } { } sort-by-slots ] unit-test + [ { T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } } @@ -143,3 +147,15 @@ TUPLE: tuple2 d ; T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } } } { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map ] unit-test + + +[ { "a" "b" "c" } ] [ { "b" "c" "a" } { <=> <=> } sort-by ] unit-test +[ { "b" "c" "a" } ] [ { "b" "c" "a" } { } sort-by ] unit-test + +<< "length-test" [ length ] define-sorting >> + +[ { { 1 } { 1 2 3 } { 1 3 2 } { 3 2 1 } } ] +[ + { { 3 2 1 } { 1 2 3 } { 1 3 2 } { 1 } } + { length-test<=> <=> } sort-by +] unit-test diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor index bce9442e44..4b6743af5c 100644 --- a/basis/sorting/slots/slots.factor +++ b/basis/sorting/slots/slots.factor @@ -7,6 +7,9 @@ IN: sorting.slots MACRO: compare-slots ( sort-specs -- <=> ) #! sort-spec: { accessors comparator } - '[ _ [ slot-comparator ] map 2|| +eq+ or ] ; + [ slot-comparator ] map '[ _ 2|| +eq+ or ] ; -: sort-by-slots ( seq sort-specs -- seq' ) +: sort-by-slots ( seq sort-specs -- sortedseq ) '[ _ compare-slots ] sort ; +MACRO: compare-seq ( seq -- quot ) + [ short-circuit-comparator ] map '[ _ 2|| +eq+ or ] ; + +: sort-by ( seq sort-seq -- sortedseq ) + '[ _ compare-seq ] sort ; + + MACRO: split-by-slots ( accessor-seqs -- quot ) [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map '[ [ _ 2&& ] slice monotonic-slice ] ; From c97ca399d8ea5434b332c30ba1d25ab04d14c109 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Apr 2009 19:49:49 -0500 Subject: [PATCH 2/3] refactor a bit, document sort-by --- basis/sorting/slots/slots-docs.factor | 15 ++++++++++++--- basis/sorting/slots/slots.factor | 7 +++---- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/basis/sorting/slots/slots-docs.factor b/basis/sorting/slots/slots-docs.factor index a3bdbf9ac1..cc89d497e7 100644 --- a/basis/sorting/slots/slots-docs.factor +++ b/basis/sorting/slots/slots-docs.factor @@ -14,7 +14,7 @@ HELP: compare-slots HELP: sort-by-slots { $values { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" } - { "seq'" sequence } + { "sortedseq" 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." } { $examples @@ -39,11 +39,20 @@ HELP: split-by-slots } { $description "Splits a sequence of tuples into a sequence of slices of tuples that have the same values in all slots in the accessor sequence. This word is only useful for splitting a sorted sequence, but is more efficient than partitioning in such a case." } ; +HELP: sort-by +{ $values + { "seq" sequence } { "sort-seq" "a sequence of comparators" } + { "sortedseq" sequence } +} +{ $description "Sorts a sequence by comparing elements by comparators, using subsequent comparators when there is a tie." } ; + ARTICLE: "sorting.slots" "Sorting by slots" "The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl "Comparing two objects by a sequence of slots:" { $subsection compare-slots } -"Sorting a sequence by a sequence of slots:" -{ $subsection sort-by-slots } ; +"Sorting a sequence of tuples by a slot/comparator pairs:" +{ $subsection sort-by-slots } +"Sorting a sequence by a sequence of comparators:" +{ $subsection sort-by } ; ABOUT: "sorting.slots" diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor index 4b6743af5c..2dccc60821 100644 --- a/basis/sorting/slots/slots.factor +++ b/basis/sorting/slots/slots.factor @@ -8,7 +8,7 @@ IN: sorting.slots @@ -29,12 +29,11 @@ MACRO: compare-slots ( sort-specs -- <=> ) '[ _ compare-slots ] sort ; MACRO: compare-seq ( seq -- quot ) - [ short-circuit-comparator ] map '[ _ 2|| +eq+ or ] ; + [ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ; : sort-by ( seq sort-seq -- sortedseq ) '[ _ compare-seq ] sort ; - MACRO: split-by-slots ( accessor-seqs -- quot ) [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map '[ [ _ 2&& ] slice monotonic-slice ] ; From 4c7b2f93379cf5925550747780f10d654d4577c2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Apr 2009 20:05:19 -0500 Subject: [PATCH 3/3] fix deriving urls in spider --- extra/spider/spider.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index aeb4676767..5398e32ff4 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -84,7 +84,7 @@ TUPLE: unique-deque assoc deque ; : normalize-hrefs ( links spider -- links' ) currently-spidering>> present swap - [ dup url-absolute? [ derive-url ] [ url-append-path >url ] if ] with map ; + [ [ >url ] bi@ derive-url ] with map ; : print-spidering ( url depth -- ) "depth: " write number>string write