| 
									
										
										
										
											2013-10-14 18:28:05 -04:00
										 |  |  | USING: kernel locals math sequences sequences.private ;
 | 
					
						
							| 
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 |  |  | IN: sorting.insertion | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | <PRIVATE
 | 
					
						
							| 
									
										
										
										
											2014-04-27 20:13:26 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-09 02:38:10 -05:00
										 |  |  | :: insert ( ... seq quot: ( ... elt -- ... elt' ) n -- ... )
 | 
					
						
							| 
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 |  |  |     n zero? [ | 
					
						
							| 
									
										
										
										
											2014-04-28 01:41:37 -04:00
										 |  |  |         n n 1 - [ seq nth-unsafe ] bi@
 | 
					
						
							|  |  |  |         2dup [ quot call ] bi@ >= [ 2drop ] [ | 
					
						
							|  |  |  |             n 1 - n [ seq set-nth-unsafe ] bi-curry@ bi*
 | 
					
						
							| 
									
										
										
										
											2009-08-13 20:21:44 -04:00
										 |  |  |             seq quot n 1 - insert | 
					
						
							| 
									
										
										
										
											2014-04-28 01:41:37 -04:00
										 |  |  |         ] if
 | 
					
						
							| 
									
										
										
										
											2008-07-18 20:22:59 -04:00
										 |  |  |     ] unless ; inline recursive
 | 
					
						
							| 
									
										
										
										
											2014-04-27 20:13:26 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-09-22 20:19:51 -04:00
										 |  |  | : insertion-sort ( ... seq quot: ( ... elt -- ... elt' ) -- ... )
 | 
					
						
							| 
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 |  |  |     ! quot is a transformation on elements | 
					
						
							| 
									
										
										
										
											2014-07-22 09:09:26 -04:00
										 |  |  |     over length [ insert ] 2with 1 -rot (each-integer) ; inline
 |