2008-10-01 15:19:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Marc Fauconneau.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: parser kernel arrays math accessors sequences
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								math.vectors math.order sorting binary-search sets assocs fry ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: suffix-arrays
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:49:21 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-16 10:03:30 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: suffixes ( string -- suffixes-seq )
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-14 10:10:13 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup length iota [ tail-slice ] with map ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:49:21 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: prefix<=> ( begin seq -- <=> )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ <=> ] [ swap head? ] 2bi [ drop +eq+ ] when ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								 
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 17:00:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: find-index ( begin suffix-array -- index/f )
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:49:21 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ prefix<=> ] with search drop ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 17:00:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: from-to ( index begin suffix-array -- from/f to/f )
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:49:21 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    swap '[ _ head? not ]
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-13 20:21:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ find-last-from drop dup [ 1 + ] when ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ find-from drop ] 3bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 17:00:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <funky-slice> ( from/f to/f seq -- slice )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-05 18:03:24 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ drop 0 or ] [ length or ] bi-curry bi*
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 17:00:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ min ] keep
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 21:55:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] keep <slice> ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 17:00:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:49:21 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: >suffix-array ( seq -- array )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ suffixes ] map concat natural-sort ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-21 02:27:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								SYNTAX: SA{ \ } [ >suffix-array ] parse-literal ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: query ( begin suffix-array -- matches )
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 21:55:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    2dup find-index dup
							 | 
						
					
						
							
								
									
										
										
										
											2010-02-27 14:52:24 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ -rot [ from-to ] keep <funky-slice> [ seq>> ] map members ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-01 21:55:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ 3drop { } ] if ;
							 |