| 
									
										
										
										
											2009-01-12 02:51:38 -05:00
										 |  |  | ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: assocs hashtables kernel sequences vectors ;
 | 
					
						
							|  |  |  | IN: sets | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-05-25 20:44:37 -04:00
										 |  |  | : adjoin ( elt seq -- ) [ delete ] [ push ] 2bi ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : conjoin ( elt assoc -- ) dupd set-at ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | : (prune) ( elt hash vec -- )
 | 
					
						
							| 
									
										
										
										
											2008-05-25 20:44:37 -04:00
										 |  |  |     3dup drop key? [ 3drop ] [ | 
					
						
							|  |  |  |         [ drop conjoin ] [ nip push ] 3bi
 | 
					
						
							|  |  |  |     ] if ; inline
 | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : prune ( seq -- newseq )
 | 
					
						
							|  |  |  |     [ ] [ length <hashtable> ] [ length <vector> ] tri
 | 
					
						
							|  |  |  |     [ [ (prune) ] 2curry each ] keep ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-07-13 21:46:41 -04:00
										 |  |  | : duplicates ( seq -- newseq )
 | 
					
						
							|  |  |  |     H{ } clone [ [ key? ] [ conjoin ] 2bi ] curry filter ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-06-12 06:49:46 -04:00
										 |  |  | : gather ( seq quot -- newseq )
 | 
					
						
							|  |  |  |     map concat prune ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | : unique ( seq -- assoc )
 | 
					
						
							|  |  |  |     [ dup ] H{ } map>assoc ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : (all-unique?) ( elt hash -- ? )
 | 
					
						
							| 
									
										
										
										
											2008-05-25 20:44:37 -04:00
										 |  |  |     2dup key? [ 2drop f ] [ conjoin t ] if ;
 | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : all-unique? ( seq -- ? )
 | 
					
						
							|  |  |  |     dup length <hashtable> [ (all-unique?) ] curry all? ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-12 02:51:38 -05:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : tester ( seq -- quot ) unique [ key? ] curry ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | : intersect ( seq1 seq2 -- newseq )
 | 
					
						
							| 
									
										
										
										
											2009-01-12 02:51:38 -05:00
										 |  |  |     tester filter ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-12 15:32:14 -05:00
										 |  |  | : intersects? ( seq1 seq2 -- ? )
 | 
					
						
							| 
									
										
										
										
											2009-01-29 23:19:07 -05:00
										 |  |  |     tester any? ;
 | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : diff ( seq1 seq2 -- newseq )
 | 
					
						
							| 
									
										
										
										
											2009-01-12 02:51:38 -05:00
										 |  |  |     tester [ not ] compose filter ;
 | 
					
						
							| 
									
										
										
										
											2008-04-14 03:20:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : union ( seq1 seq2 -- newseq )
 | 
					
						
							|  |  |  |     append prune ;
 | 
					
						
							| 
									
										
										
										
											2008-05-01 21:01:57 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : subset? ( seq1 seq2 -- ? )
 | 
					
						
							| 
									
										
										
										
											2009-01-12 02:51:38 -05:00
										 |  |  |     tester all? ;
 | 
					
						
							| 
									
										
										
										
											2008-05-01 21:01:57 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : set= ( seq1 seq2 -- ? )
 | 
					
						
							|  |  |  |     [ unique ] bi@ = ;
 |