| 
									
										
										
										
											2014-11-29 21:18:59 -05:00
										 |  |  | ! Copyright (C) 2014 John Benediktsson | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | USING: kernel locals math math.order math.ranges sequences | 
					
						
							|  |  |  | sequences.private ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | IN: sorting.bubble | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: (bubble-sort!) ( seq quot: ( obj1 obj2 -- <=> ) -- )
 | 
					
						
							| 
									
										
										
										
											2014-11-29 21:36:46 -05:00
										 |  |  |     seq length 1 - [ | 
					
						
							|  |  |  |         f over [0,b) [| i | | 
					
						
							| 
									
										
										
										
											2014-11-29 21:18:59 -05:00
										 |  |  |             i i 1 + [ seq nth-unsafe ] bi@ 2dup quot call +gt+ =
 | 
					
						
							| 
									
										
										
										
											2014-11-29 21:36:46 -05:00
										 |  |  |             [ i 1 + i [ seq set-nth-unsafe ] bi-curry@ bi* 2drop i t ] | 
					
						
							| 
									
										
										
										
											2014-11-29 21:18:59 -05:00
										 |  |  |             [ 2drop ] if
 | 
					
						
							|  |  |  |         ] each
 | 
					
						
							|  |  |  |     ] loop drop ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bubble-sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
 | 
					
						
							|  |  |  |     over length 2 < [ 2drop ] [ (bubble-sort!) ] if ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : natural-bubble-sort! ( seq -- )
 | 
					
						
							|  |  |  |     [ <=> ] bubble-sort! ;
 |