From 6f5e1f16e0394e294ef6e541b847c87571bd6b7d Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 14 May 2012 16:44:07 -0700 Subject: [PATCH] sequences.extras: adding supremum-by and infimum-by that call the "map" quot once per element. --- extra/sequences/extras/extras.factor | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 5faff77634..07ca0c3e22 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -45,6 +45,18 @@ IN: sequences.extras : minimum ( seq quot: ( ... elt -- ... x ) -- elt ) [ dup ?first ] dip [ min-by ] curry reduce ; inline +: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt ) + [ [ first dup ] dip call ] 2keep [ + dupd call pick dupd max over = + [ [ 2drop ] 2dip ] [ 2nip ] if + ] curry 1 each-from drop ; inline + +: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt ) + [ [ first dup ] dip call ] 2keep [ + dupd call pick dupd min over = + [ [ 2drop ] 2dip ] [ 2nip ] if + ] curry 1 each-from drop ; inline + : all-subseqs ( seq -- seqs ) dup length [1,b] [ ] with map concat ;