extra/sequences/extras/extras.factor

   1 USING: arrays kernel locals math sequences ;
   2 IN: sequences.extras
   3 : reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
   4
   5 :: reduce-r
   6     ( list identity quot: ( obj1 obj2 -- obj ) -- result )
   7     list empty?
   8     [ identity ]
   9     [ list rest identity quot reduce-r list first quot call ] if ;
  10     inline recursive
  11
  12 ! Quot must have static stack effect, unlike "reduce"
  13 :: reduce* ( seq id quot -- result ) seq
  14     [ id ]
  15     [ unclip id swap quot call( prev elt -- next ) quot reduce* ] if-empty ; inline recursive
  16
  17 :: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
  18 : find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
  19     [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
  20
  21 : insert-sorted ( elt seq -- seq ) 2dup [ < ] with find drop over length or swap insert-nth ;