sorting.extras: adding bisect-right and bisect-left.
parent
dba072e9f2
commit
13db93639f
|
@ -10,3 +10,11 @@ IN: sorting.extras
|
||||||
{ "green" "blue" "purple" } [ length ] map-sort
|
{ "green" "blue" "purple" } [ length ] map-sort
|
||||||
] unit-test
|
] unit-test
|
||||||
{ 1 { 1 2 3 4 } } [ 1 { 4 2 1 3 } [ dupd + ] map-sort ] unit-test
|
{ 1 { 1 2 3 4 } } [ 1 { 4 2 1 3 } [ dupd + ] map-sort ] unit-test
|
||||||
|
|
||||||
|
{ 0 } [ 0 { 1 } bisect-right ] unit-test
|
||||||
|
{ 1 } [ 1 { 1 } bisect-right ] unit-test
|
||||||
|
{ 1 } [ 2 { 1 } bisect-right ] unit-test
|
||||||
|
|
||||||
|
{ 0 } [ 0 { 1 } bisect-left ] unit-test
|
||||||
|
{ 0 } [ 1 { 1 } bisect-left ] unit-test
|
||||||
|
{ 1 } [ 2 { 1 } bisect-left ] unit-test
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: arrays assocs kernel kernel.private sequences
|
USING: arrays assocs kernel kernel.private locals math
|
||||||
sequences.private sorting ;
|
math.order sequences sequences.private sorting ;
|
||||||
IN: sorting.extras
|
IN: sorting.extras
|
||||||
|
|
||||||
: argsort ( seq quot: ( obj1 obj2 -- <=> ) -- sortedseq )
|
: argsort ( seq quot: ( obj1 obj2 -- <=> ) -- sortedseq )
|
||||||
|
@ -11,3 +11,21 @@ IN: sorting.extras
|
||||||
[ map ] curry keep zip
|
[ map ] curry keep zip
|
||||||
[ { array } declare first-unsafe ] sort-with
|
[ { array } declare first-unsafe ] sort-with
|
||||||
[ { array } declare second-unsafe ] map ; inline
|
[ { array } declare second-unsafe ] map ; inline
|
||||||
|
|
||||||
|
:: bisect-left ( obj seq -- i )
|
||||||
|
0 seq length [ 2dup < ] [
|
||||||
|
2dup + 2/ dup seq nth-unsafe obj before?
|
||||||
|
[ swap [ nip 1 + ] dip ] [ nip ] if
|
||||||
|
] while drop ;
|
||||||
|
|
||||||
|
:: bisect-right ( obj seq -- i )
|
||||||
|
0 seq length [ 2dup < ] [
|
||||||
|
2dup + 2/ dup seq nth-unsafe obj after?
|
||||||
|
[ nip ] [ swap [ nip 1 + ] dip ] if
|
||||||
|
] while drop ;
|
||||||
|
|
||||||
|
: insort-left ( obj seq -- seq' )
|
||||||
|
[ bisect-left ] 2keep swapd insert-nth ;
|
||||||
|
|
||||||
|
: insort-right ( obj seq -- seq' )
|
||||||
|
[ bisect-right ] 2keep swapd insert-nth ;
|
||||||
|
|
Loading…
Reference in New Issue