Human sort is unusable with pegs (too slow). Make a case-insensitive version humani<=>
parent
b361e1b694
commit
8bc3c09050
|
@ -12,3 +12,10 @@ IN: sorting.human.tests
|
|||
|
||||
[ { "4dup" "4nip" "5drop" "nip" "nip2" "nipd" } ]
|
||||
[ { "nip" "4dup" "4nip" "5drop" "nip2" "nipd" } [ human<=> ] sort ] unit-test
|
||||
|
||||
|
||||
{ { "Abc" "abc" "def" "gh" } }
|
||||
[ { "abc" "Abc" "def" "gh" } [ human<=> ] sort ] unit-test
|
||||
|
||||
{ { "abc" "Abc" "def" "gh" } }
|
||||
[ { "abc" "Abc" "def" "gh" } [ humani<=> ] sort ] unit-test
|
||||
|
|
|
@ -1,21 +1,47 @@
|
|||
! Copyright (C) 2008 Doug Coleman, Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math math.order math.parser peg.ebnf
|
||||
sequences sorting.functor ;
|
||||
USING: accessors fry kernel make math math.order math.parser
|
||||
sequences sorting.functor strings unicode.case
|
||||
unicode.categories ;
|
||||
IN: sorting.human
|
||||
|
||||
: find-numbers ( string -- seq )
|
||||
[EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
|
||||
: cut-find ( seq pred -- before after )
|
||||
[ drop ] [ find drop ] 2bi dup [ cut ] when ; inline
|
||||
|
||||
: cut3 ( seq pred -- first mid last )
|
||||
[ cut-find ] keep [ not ] compose cut-find ; inline
|
||||
|
||||
: find-sequences ( sequence pred quot -- seq )
|
||||
'[
|
||||
[
|
||||
_ cut3 [
|
||||
[ , ]
|
||||
[ [ @ , ] when* ] bi*
|
||||
] dip dup
|
||||
] loop drop
|
||||
] { } make ; inline
|
||||
|
||||
: find-numbers ( seq -- newseq )
|
||||
[ digit? ] [ string>number ] find-sequences ;
|
||||
|
||||
! For comparing integers or sequences
|
||||
TUPLE: hybrid obj ;
|
||||
|
||||
: <hybrid> ( obj -- hybrid )
|
||||
hybrid new
|
||||
swap >>obj ; inline
|
||||
|
||||
: <hybrid-insensitive> ( obj -- hybrid )
|
||||
hybrid new
|
||||
swap dup string? [ >case-fold ] when >>obj ; inline
|
||||
|
||||
M: hybrid <=>
|
||||
[ obj>> ] bi@
|
||||
2dup [ integer? ] bi@ xor [
|
||||
drop integer? [ +lt+ ] [ +gt+ ] if
|
||||
drop integer? +lt+ +gt+ ?
|
||||
] [
|
||||
<=>
|
||||
] if ;
|
||||
|
||||
<< "human" [ find-numbers [ hybrid boa ] map ] define-sorting >>
|
||||
<< "human" [ find-numbers [ <hybrid> ] map ] define-sorting >>
|
||||
<< "humani" [ find-numbers [ <hybrid-insensitive> ] map ] define-sorting >>
|
||||
|
|
Loading…
Reference in New Issue