diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor index e55d1eb150..18bc7f14cf 100644 --- a/core/sorting/sorting-docs.factor +++ b/core/sorting/sorting-docs.factor @@ -3,6 +3,10 @@ sequences math.order ; IN: sorting ARTICLE: "sequences-sorting" "Sorting sequences" +"The " { $vocab-link "sorting" } " vocabulary implements the merge-sort algorithm. It runs in " { $snippet "O(n log n)" } " time, and is a " { $emphasis "stable" } " sort, meaning that the order of equal elements is preserved." +$nl +"The algorithm only allocates two additional arrays, both the size of the input sequence, and uses iteration rather than recursion, and thus is suitable for sorting large sequences." +$nl "Sorting combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- <=> )" } ", where the output value is one of the three " { $link "order-specifiers" } "." $nl "Sorting a sequence with a custom comparator:" diff --git a/core/sorting/sorting-tests.factor b/core/sorting/sorting-tests.factor index 5f3dab14bc..63e193c89f 100755 --- a/core/sorting/sorting-tests.factor +++ b/core/sorting/sorting-tests.factor @@ -18,3 +18,9 @@ unit-test ] unit-test [ ] [ { 1 2 } [ 2drop 1 ] sort drop ] unit-test + +! Is it a stable sort? +[ t ] [ { { 1 "a" } { 1 "b" } { 1 "c" } } dup sort-keys = ] unit-test + +[ { { 1 "a" } { 1 "b" } { 1 "c" } { 1 "e" } { 2 "d" } } ] +[ { { 1 "a" } { 1 "b" } { 1 "c" } { 2 "d" } { 1 "e" } } sort-keys ] unit-test diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index a6bcf92651..8b84ea8fe0 100755 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -24,11 +24,23 @@ TUPLE: merge { to2 array-capacity } ; : dump ( from to seq accum -- ) - #! Optimize common case where to - from = 1. - >r >r 2dup swap - 1 = - [ drop r> nth-unsafe r> push ] - [ r> r> push-all ] - if ; inline + #! Optimize common case where to - from = 1, 2, or 3. + >r >r 2dup swap - dup 1 = + [ 2drop r> nth-unsafe r> push ] [ + dup 2 = [ + 2drop dup 1+ + r> [ nth-unsafe ] curry bi@ + r> [ push ] curry bi@ + ] [ + dup 3 = [ + 2drop dup 1+ dup 1+ + r> [ nth-unsafe ] curry tri@ + r> [ push ] curry tri@ + ] [ + drop r> subseq r> push-all + ] if + ] if + ] if ; inline : l-elt [ from1>> ] [ seq>> ] bi nth-unsafe ; inline : r-elt [ from2>> ] [ seq>> ] bi nth-unsafe ; inline @@ -38,13 +50,13 @@ TUPLE: merge : dump-r [ [ from2>> ] [ to2>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline : l-next [ [ l-elt ] [ [ 1+ ] change-from1 drop ] bi ] [ accum>> ] bi push ; inline : r-next [ [ r-elt ] [ [ 1+ ] change-from2 drop ] bi ] [ accum>> ] bi push ; inline -: decide [ [ l-elt ] [ r-elt ] bi ] dip call +lt+ eq? ; inline +: decide [ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline : (merge) ( merge quot -- ) - over l-done? [ drop dump-r ] [ - over r-done? [ drop dump-l ] [ + over r-done? [ drop dump-l ] [ + over l-done? [ drop dump-r ] [ 2dup decide - [ over l-next ] [ over r-next ] if + [ over r-next ] [ over l-next ] if (merge) ] if ] if ; inline diff --git a/extra/usa-cities/usa-cities.factor b/extra/usa-cities/usa-cities.factor index a5abb53c62..c5e059c519 100644 --- a/extra/usa-cities/usa-cities.factor +++ b/extra/usa-cities/usa-cities.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files io.encodings.ascii sequences generalizations math.parser combinators kernel memoize csv symbols summary -words accessors math.order sorting ; +words accessors math.order binary-search ; IN: usa-cities SINGLETONS: AK AL AR AS AZ CA CO CT DC DE FL GA HI IA ID IL IN