extra/sets/extras/extras.factor

   1 ! Copyright (C) 2013 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs hash-sets kernel sequences sequences.extras
   4 sets ;
   5 IN: sets.extras
   6
   7 : setwise-xor ( seq1 seq2 -- set )
   8     [ append members ] [ intersect ] 2bi diff ;
   9
  10 : symmetric-diff ( set1 set2 -- set )
  11     [ union ] [ intersect ] 2bi diff ;
  12
  13 : proper-subset? ( set1 set2 -- ? )
  14     2dup subset? [ swap subset? not ] [ 2drop f ] if ;
  15
  16 : superset? ( set1 set2 -- ? )
  17     swap subset? ;
  18
  19 : disjoint? ( set1 set2 -- ? )
  20     intersects? not ;
  21
  22 :: non-repeating ( seq -- seq' )
  23     HS{ } clone :> visited
  24     0 seq new-resizable :> accum
  25     seq [
  26         accum over visited ?adjoin
  27         [ push ] [ remove-first! drop ] if
  28     ] each accum seq like ;
  29
  30 : adjoin-at* ( value key assoc -- set )
  31     [ [ HS{ } clone ] unless* [ adjoin ] keep dup ] change-at ;
  32
  33 : mapped-set ( ... seq quot: ( ... elt -- ... newelt ) -- ... set )
  34     over length <hash-set> [
  35         '[ @ _ adjoin ] each
  36     ] keep ; inline
  37
  38 : unique-by ( seq quot: ( elt -- key ) -- seq' )
  39     over length <hash-set> '[ @ _ ?adjoin ] filter ; inline