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" } ]
|
[ { "4dup" "4nip" "5drop" "nip" "nip2" "nipd" } ]
|
||||||
[ { "nip" "4dup" "4nip" "5drop" "nip2" "nipd" } [ human<=> ] sort ] unit-test
|
[ { "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.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel math math.order math.parser peg.ebnf
|
USING: accessors fry kernel make math math.order math.parser
|
||||||
sequences sorting.functor ;
|
sequences sorting.functor strings unicode.case
|
||||||
|
unicode.categories ;
|
||||||
IN: sorting.human
|
IN: sorting.human
|
||||||
|
|
||||||
: find-numbers ( string -- seq )
|
: cut-find ( seq pred -- before after )
|
||||||
[EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
|
[ 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
|
! For comparing integers or sequences
|
||||||
TUPLE: hybrid obj ;
|
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 <=>
|
M: hybrid <=>
|
||||||
[ obj>> ] bi@
|
[ obj>> ] bi@
|
||||||
2dup [ integer? ] bi@ xor [
|
2dup [ integer? ] bi@ xor [
|
||||||
drop integer? [ +lt+ ] [ +gt+ ] if
|
drop integer? +lt+ +gt+ ?
|
||||||
] [
|
] [
|
||||||
<=>
|
<=>
|
||||||
] if ;
|
] 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