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 -- ) [ remove! drop ] [ push ] 2bi ;
   7
   8 : conjoin ( elt assoc -- ) dupd set-at ;
   9
  10 : conjoin-at ( value key assoc -- )
  11     [ dupd ?set-at ] change-at ;
  12
  13 : (prune) ( elt hash vec -- )
  14     3dup drop key? [ 3drop ] [
  15         [ drop conjoin ] [ nip push ] 3bi
  16     ] if ; inline
  17
  18 : prune ( seq -- newseq )
  19     [ ] [ length <hashtable> ] [ length <vector> ] tri
  20     [ [ (prune) ] 2curry each ] keep ;
  21
  22 : duplicates ( seq -- newseq )
  23     H{ } clone [ [ key? ] [ conjoin ] 2bi ] curry filter ;
  24
  25 : gather ( seq quot -- newseq )
  26     map concat prune ; inline
  27
  28 : unique ( seq -- assoc )
  29     [ dup ] H{ } map>assoc ;
  30
  31 : (all-unique?) ( elt hash -- ? )
  32     2dup key? [ 2drop f ] [ conjoin t ] if ;
  33
  34 : all-unique? ( seq -- ? )
  35     dup length <hashtable> [ (all-unique?) ] curry all? ;
  36
  37 <PRIVATE
  38
  39 : tester ( seq -- quot ) unique [ key? ] curry ; inline
  40
  41 PRIVATE>
  42
  43 : intersect ( seq1 seq2 -- newseq )
  44     tester filter ;
  45
  46 : intersects? ( seq1 seq2 -- ? )
  47     tester any? ;
  48
  49 : diff ( seq1 seq2 -- newseq )
  50     tester [ not ] compose filter ;
  51
  52 : union ( seq1 seq2 -- newseq )
  53     append prune ;
  54
  55 : subset? ( seq1 seq2 -- ? )
  56     tester all? ;
  57
  58 : set= ( seq1 seq2 -- ? )
  59     [ unique ] bi@ = ;