| 
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 |  |  | ! Copyright (C) 2008 Marc Fauconneau. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2016-04-15 16:20:11 -04:00
										 |  |  | USING: accessors binary-search fry kernel math math.order parser | 
					
						
							|  |  |  | sequences sets sorting ;
 | 
					
						
							| 
									
										
										
										
											2008-10-01 15:19:28 -04:00
										 |  |  | 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 )
 | 
					
						
							| 
									
										
										
										
											2017-06-01 17:59:35 -04: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 ;
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -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
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2016-04-15 16:20:11 -04:00
										 |  |  | : query-from ( index begin suffix-array -- from )
 | 
					
						
							|  |  |  |     swap '[ _ head? not ] find-last-from drop [ 1 + ] [ 0 ] if* ;
 | 
					
						
							| 
									
										
										
										
											2008-10-01 17:00:23 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2016-04-15 16:20:11 -04:00
										 |  |  | : query-to ( index begin suffix-array -- to )
 | 
					
						
							|  |  |  |     [ swap '[ _ head? not ] find-from drop ] [ length or ] bi ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : query-range ( index begin suffix-array -- from to )
 | 
					
						
							|  |  |  |     [ query-from ] [ query-to ] 3bi [ min ] keep ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : (query) ( index begin suffix-array -- matches )
 | 
					
						
							|  |  |  |     [ query-range ] keep <slice> [ seq>> ] map members ;
 | 
					
						
							| 
									
										
										
										
											2008-10-01 17:00:23 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-10-01 15:49:21 -04:00
										 |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2016-04-15 16:20:11 -04:00
										 |  |  | : >suffix-array ( seq -- suffix-array )
 | 
					
						
							|  |  |  |     members [ suffixes ] map concat natural-sort ;
 | 
					
						
							| 
									
										
										
										
											2008-10-01 15:49:21 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											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 )
 | 
					
						
							| 
									
										
										
										
											2016-04-15 16:20:11 -04:00
										 |  |  |     [ find-index ] 2keep '[ _ _ (query) ] [ { } ] if* ;
 |