extra/adsoda/combinators/combinators.factor

   1 ! Copyright (C) 2008 Jeff Bigot\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: kernel arrays sequences fry math combinators ;\r
   4 \r
   5 IN: adsoda.combinators\r
   6 \r
   7 ! : (combinations) ( seq -- seq ) [ 1 tail ] dip combinations ;\r
   8 \r
   9 ! : prefix-each [ prefix ] curry map ; inline\r
  10 \r
  11 ! : combinations ( seq n -- seqs )\r
  12 !    {\r
  13 !        { [ dup 0 = ] [ 2drop { { } } ] }\r
  14 !        { [ over empty? ] [ 2drop { } ] }\r
  15 !        { [ t ] [ \r
  16 !            [ [ 1 - (combinations) ] [ drop first ] 2bi prefix-each ]\r
  17 !            [ (combinations) ] 2bi append\r
  18 !        ] }\r
  19 !    } cond ;\r
  20 \r
  21 : columnize ( array -- array ) [ 1array ] map ; inline\r
  22 \r
  23 : among ( array n -- array )\r
  24     2dup swap length \r
  25     {\r
  26         { [ over 1 = ] [ 3drop columnize ] }\r
  27         { [ over 0 = ] [ 2drop 2drop { } ] }\r
  28         { [ 2dup < ] [ 2drop [ 1 cut ] dip  \r
  29                          [ 1 - among [ append ] with map  ] \r
  30                          [ among append ] 2bi\r
  31                        ] }\r
  32         { [ 2dup = ] [ 3drop 1array ] }\r
  33         { [ 2dup > ] [ 2drop 2drop {  } ] } \r
  34     } cond\r
  35 ;\r
  36 \r
  37 : concat-nth ( seq1 seq2 -- seq )  \r
  38     [ nth append ] curry map-index ;\r
  39 \r
  40 : do-cycle   ( array -- array )   dup first suffix ;\r
  41 \r
  42 : map-but ( seq i quot -- seq )\r
  43     ! quot : ( seq x -- seq )\r
  44     '[ _ = [ @ ] unless ] map-index ; inline\r
  45 \r