Clean up human sort, move it to basis
parent
bdcb33acf6
commit
82a076df79
|
@ -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
|
|
@ -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 ;
|
|
@ -131,23 +131,6 @@ PRIVATE>
|
|||
: power-set ( seq -- subsets )
|
||||
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
|
||||
: ?second ( seq -- second/f ) 1 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
|
||||
: (attempt-each-integer) ( i n quot -- result )
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue