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

sequences: cleanup shared code between supremum-by and infimum-by.

db4
John Benediktsson 2013-04-17 15:29:42 -07:00
parent b5f2fb891e
commit 89d4fdfb75
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
core/sequences/sequences.factor
View File

@ -1031,17 +1031,23 @@ M: object sum 0 [ + ] binary-reduce ; inline
: each-from ( ... seq quot: ( ... x -- ... ) i -- ... ) : each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
-rot (each) (each-integer) ; inline -rot (each) (each-integer) ; inline
<PRIVATE
: select-by ( ... seq quot: ( ... elt -- ... x ) compare: ( obj1 obj2 -- ? ) -- ... elt )
[
[ keep swap ] curry [ [ first ] dip call ] 2keep
[ curry 2dip pick over ] curry
] [
[ [ 2drop ] [ [ 2drop ] 2dip ] if ] compose
] bi* compose 1 each-from drop ; inline
PRIVATE>
: supremum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt ) : supremum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt )
[ keep swap ] curry [ [ first ] dip call ] 2keep [ [ after? ] select-by ; inline
curry 2dip pick over after?
[ 2drop ] [ [ 2drop ] 2dip ] if
] curry 1 each-from drop ; inline
: infimum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt ) : infimum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt )
[ keep swap ] curry [ [ first ] dip call ] 2keep [ [ before? ] select-by ; inline
curry 2dip pick over before?
[ 2drop ] [ [ 2drop ] 2dip ] if
] curry 1 each-from drop ; inline
: shortest ( seqs -- elt ) [ length ] infimum-by ; : shortest ( seqs -- elt ) [ length ] infimum-by ;