steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.statistics: change kth-object to properly clone underlying sequence first.

db4
John Benediktsson 2013-05-06 10:40:53 -07:00
parent 6a4638fa0f
commit 720db54f61
1 changed files with 5 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/math/statistics/statistics.factor
View File

@ -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 ;