| 
									
										
										
										
											2014-06-10 20:32:02 -04:00
										 |  |  | ! Copyright (C) 2014 John Benediktsson | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-12-01 18:16:47 -05:00
										 |  |  | USING: assocs fry heaps kernel sequences vectors ;
 | 
					
						
							| 
									
										
										
										
											2014-06-10 20:32:02 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | IN: sorting.heap | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : heapsort-with ( seq quot: ( elt -- key ) -- sorted-seq )
 | 
					
						
							|  |  |  |     [ | 
					
						
							| 
									
										
										
										
											2014-12-01 18:16:47 -05:00
										 |  |  |         over length <vector> min-heap boa
 | 
					
						
							|  |  |  |         [ '[ dup @ _ heap-push ] each ] keep
 | 
					
						
							|  |  |  |     ] [ | 
					
						
							|  |  |  |         drop [ length ] keep new-resizable
 | 
					
						
							|  |  |  |         [ '[ drop _ push ] slurp-heap ] keep
 | 
					
						
							|  |  |  |     ] [ | 
					
						
							|  |  |  |         drop like
 | 
					
						
							|  |  |  |     ] 2tri ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : heapsort ( seq -- sorted-seq ) [ ] heapsort-with ;
 |