Clean up human sort, move it to basis

db4
Slava Pestov 2008-09-12 15:49:46 -05:00
parent bdcb33acf6
commit 82a076df79
3 changed files with 16 additions and 25 deletions

View File

@ -0,0 +1,6 @@
USING: sorting.human tools.test ;
IN: sorting.human.tests
\ human-sort must-infer
[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test

View File

@ -0,0 +1,10 @@
! Copyright (C) 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: peg.ebnf math.parser kernel assocs sorting ;
IN: sorting.human
: find-numbers ( string -- seq )
[EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
: human-sort ( seq -- seq' )
[ dup find-numbers ] { } map>assoc sort-values keys ;

View File

@ -131,23 +131,6 @@ PRIVATE>
: power-set ( seq -- subsets ) : power-set ( seq -- subsets )
2 over length exact-number-strings swap [ switches ] curry map ; 2 over length exact-number-strings swap [ switches ] curry map ;
: cut-find ( seq pred -- before after )
dupd find drop dup [ cut ] when ;
: cut3 ( seq pred -- first mid last )
[ cut-find ] keep [ not ] compose cut-find ;
: (cut-all) ( seq pred quot -- )
[ >r cut3 r> dip >r >r , r> [ , ] when* r> ] 2keep
pick [ (cut-all) ] [ 3drop ] if ;
: cut-all ( seq pred quot -- first mid last )
[ (cut-all) ] { } make ;
: human-sort ( seq -- newseq )
[ dup [ digit? ] [ string>number ] cut-all ] { } map>assoc
sort-values keys ;
: ?first ( seq -- first/f ) 0 swap ?nth ; inline : ?first ( seq -- first/f ) 0 swap ?nth ; inline
: ?second ( seq -- second/f ) 1 swap ?nth ; inline : ?second ( seq -- second/f ) 1 swap ?nth ; inline
: ?third ( seq -- third/f ) 2 swap ?nth ; inline : ?third ( seq -- third/f ) 2 swap ?nth ; inline
@ -164,14 +147,6 @@ USE: continuations
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! List the positions of obj in seq
: indices ( seq obj -- seq )
>r dup length swap r>
[ = [ ] [ drop f ] if ] curry
2map
sift ;
<PRIVATE <PRIVATE
: (attempt-each-integer) ( i n quot -- result ) : (attempt-each-integer) ( i n quot -- result )
[ [