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 )
|
: 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 )
|
||||||
[
|
[
|
||||||
|
|
Loading…
Reference in New Issue