math.statistics: change kth-object to properly clone underlying sequence first.
parent
6a4638fa0f
commit
720db54f61
|
@ -70,7 +70,7 @@ PRIVATE>
|
||||||
seq length 1 - :> m!
|
seq length 1 - :> m!
|
||||||
[ l m < ]
|
[ l m < ]
|
||||||
[
|
[
|
||||||
k seq nth x!
|
k seq nth-unsafe x!
|
||||||
l i!
|
l i!
|
||||||
m j!
|
m j!
|
||||||
[ i j <= ]
|
[ i j <= ]
|
||||||
|
@ -87,18 +87,17 @@ PRIVATE>
|
||||||
j k < [ i l! ] when
|
j k < [ i l! ] when
|
||||||
k i < [ j m! ] when
|
k i < [ j m! ] when
|
||||||
] while
|
] while
|
||||||
k seq nth ; inline
|
k seq nth-unsafe ; inline
|
||||||
|
|
||||||
: (kth-object) ( seq k nth-quot exchange-quot quot: ( x y -- ? ) -- elt )
|
: (kth-object) ( seq k nth-quot exchange-quot quot: ( x y -- ? ) -- elt )
|
||||||
#! The algorithm modifiers seq, so we clone it
|
#! The algorithm modifiers seq, so we clone it
|
||||||
[ clone ] 4dip ((kth-object)) ; inline
|
[ { } clone-like ] 4dip ((kth-object)) ; inline
|
||||||
|
|
||||||
: kth-object-unsafe ( seq k quot: ( x y -- ? ) -- elt )
|
: kth-object-unsafe ( seq k quot: ( x y -- ? ) -- elt )
|
||||||
[ [ nth-unsafe ] [ exchange-unsafe ] ] dip (kth-object) ; inline
|
[ [ nth-unsafe ] [ exchange-unsafe ] ] dip (kth-object) ; inline
|
||||||
|
|
||||||
: kth-objects-unsafe ( seq kths quot: ( x y -- ? ) -- elts )
|
: kth-objects-unsafe ( seq kths quot: ( x y -- ? ) -- elts )
|
||||||
[ clone ] 2dip
|
'[ _ kth-object-unsafe ] with map ; inline
|
||||||
'[ [ nth-unsafe ] [ exchange-unsafe ] _ ((kth-object)) ] with map ; inline
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -106,8 +105,7 @@ PRIVATE>
|
||||||
[ [ nth ] [ exchange ] ] dip (kth-object) ; inline
|
[ [ nth ] [ exchange ] ] dip (kth-object) ; inline
|
||||||
|
|
||||||
: kth-objects ( seq kths quot: ( x y -- ? ) -- elts )
|
: kth-objects ( seq kths quot: ( x y -- ? ) -- elts )
|
||||||
[ clone ] 2dip
|
'[ _ kth-object ] with map ; inline
|
||||||
'[ [ nth ] [ exchange ] _ ((kth-object)) ] with map ; inline
|
|
||||||
|
|
||||||
: kth-smallests ( seq kths -- elts ) [ < ] kth-objects-unsafe ;
|
: kth-smallests ( seq kths -- elts ) [ < ] kth-objects-unsafe ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue