extra/sets/extras/extras.factor

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