core/sets/sets.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs hashtables kernel sequences vectors ;
   4 IN: sets
   5
   6 : adjoin ( elt seq -- ) [ delete ] [ push ] 2bi ;
   7
   8 : conjoin ( elt assoc -- ) dupd set-at ;
   9
  10 : (prune) ( elt hash vec -- )
  11     3dup drop key? [ 3drop ] [
  12         [ drop conjoin ] [ nip push ] 3bi
  13     ] if ; inline
  14
  15 : prune ( seq -- newseq )
  16     [ ] [ length <hashtable> ] [ length <vector> ] tri
  17     [ [ (prune) ] 2curry each ] keep ;
  18
  19 : duplicates ( seq -- newseq )
  20     H{ } clone [ [ key? ] [ conjoin ] 2bi ] curry filter ;
  21
  22 : gather ( seq quot -- newseq )
  23     map concat prune ; inline
  24
  25 : unique ( seq -- assoc )
  26     [ dup ] H{ } map>assoc ;
  27
  28 : (all-unique?) ( elt hash -- ? )
  29     2dup key? [ 2drop f ] [ conjoin t ] if ;
  30
  31 : all-unique? ( seq -- ? )
  32     dup length <hashtable> [ (all-unique?) ] curry all? ;
  33
  34 <PRIVATE
  35
  36 : tester ( seq -- quot ) unique [ key? ] curry ; inline
  37
  38 PRIVATE>
  39
  40 : intersect ( seq1 seq2 -- newseq )
  41     tester filter ;
  42
  43 : intersects? ( seq1 seq2 -- ? )
  44     tester any? ;
  45
  46 : diff ( seq1 seq2 -- newseq )
  47     tester [ not ] compose filter ;
  48
  49 : union ( seq1 seq2 -- newseq )
  50     append prune ;
  51
  52 : subset? ( seq1 seq2 -- ? )
  53     tester all? ;
  54
  55 : set= ( seq1 seq2 -- ? )
  56     [ unique ] bi@ = ;