1 USING: arrays assocs kernel kernel.private math math.order
2 sequences sequences.extras sequences.private sorting ;
5 : argsort ( seq quot: ( obj1 obj2 -- <=> ) -- sortedseq )
7 [ [ first-unsafe ] bi@ ] prepose
8 sort-with [ second-unsafe ] map! ; inline
10 : map-sort ( ... seq quot: ( ... elt -- ... key ) -- ... sortedseq )
11 [ keep ] curry { } map>assoc
12 [ { array } declare first-unsafe ] sort-by
13 [ { array } declare second-unsafe ] map ; inline
15 :: bisect-left ( obj seq -- i )
16 0 seq length [ 2dup < ] [
17 2dup + 2/ dup seq nth-unsafe obj before?
18 [ swap [ nip 1 + ] dip ] [ nip ] if
21 :: bisect-right ( obj seq -- i )
22 0 seq length [ 2dup < ] [
23 2dup + 2/ dup seq nth-unsafe obj after?
24 [ nip ] [ swap [ nip 1 + ] dip ] if
27 : insort-left ( obj seq -- seq' )
28 [ bisect-left ] 2keep swapd insert-nth ;
30 : insort-right ( obj seq -- seq' )
31 [ bisect-right ] 2keep swapd insert-nth ;
33 : insort-left! ( obj seq -- seq )
34 [ bisect-left ] 2keep swapd [ insert-nth! ] keep ;
36 : insort-right! ( obj seq -- seq )
37 [ bisect-right ] 2keep swapd [ insert-nth! ] keep ;
39 MACRO: compare-with ( quots -- <=> )
41 [ '[ _ 2keep rot dup +eq+ eq? [ drop @ ] [ 2nip ] if ] ]