assoc-heaps: adding / fixing test case.
							parent
							
								
									c0a8d0cf1f
								
							
						
					
					
						commit
						3a1fb4d588
					
				| 
						 | 
					@ -21,11 +21,6 @@ TUPLE: heap { data vector } ;
 | 
				
			||||||
: <heap> ( class -- heap )
 | 
					: <heap> ( class -- heap )
 | 
				
			||||||
    V{ } clone swap boa ; inline
 | 
					    V{ } clone swap boa ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
ERROR: not-a-heap object ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: check-heap ( heap -- heap )
 | 
					 | 
				
			||||||
    dup heap? [ not-a-heap ] unless ; inline
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
TUPLE: entry value key heap index ;
 | 
					TUPLE: entry value key heap index ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: <entry> ( value key heap -- entry )
 | 
					: <entry> ( value key heap -- entry )
 | 
				
			||||||
| 
						 | 
					@ -148,7 +143,6 @@ M: heap heap-pop
 | 
				
			||||||
    [ data-first >entry< ] [ heap-pop* ] bi ;
 | 
					    [ data-first >entry< ] [ heap-pop* ] bi ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: slurp-heap ( ... heap quot: ( ... value key -- ... ) -- ... )
 | 
					: slurp-heap ( ... heap quot: ( ... value key -- ... ) -- ... )
 | 
				
			||||||
    [ check-heap ] dip
 | 
					 | 
				
			||||||
    [ drop '[ _ heap-empty? ] ]
 | 
					    [ drop '[ _ heap-empty? ] ]
 | 
				
			||||||
    [ '[ _ heap-pop @ ] until ] 2bi ; inline
 | 
					    [ '[ _ heap-pop @ ] until ] 2bi ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,4 +1,11 @@
 | 
				
			||||||
! Copyright (C) 2008 Doug Coleman.
 | 
					! Copyright (C) 2008 Doug Coleman.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: tools.test assoc-heaps ;
 | 
					USING: assoc-heaps combinators heaps kernel tools.test ;
 | 
				
			||||||
IN: assoc-heaps.tests
 | 
					
 | 
				
			||||||
 | 
					{ { { 0 "zero" } { 1 "one" } { 2 "two" } } } [
 | 
				
			||||||
 | 
					    <unique-min-heap>
 | 
				
			||||||
 | 
					    "two" 2 pick heap-push
 | 
				
			||||||
 | 
					    "zero" 0 pick heap-push
 | 
				
			||||||
 | 
					    "one" 1 pick heap-push
 | 
				
			||||||
 | 
					    heap-pop-all
 | 
				
			||||||
 | 
					] unit-test
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -25,3 +25,5 @@ M: assoc-heap heap-pop heap>> heap-pop ;
 | 
				
			||||||
M: assoc-heap heap-peek heap>> heap-peek ;
 | 
					M: assoc-heap heap-peek heap>> heap-peek ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: assoc-heap heap-empty? heap>> heap-empty? ;
 | 
					M: assoc-heap heap-empty? heap>> heap-empty? ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: assoc-heap heap-size heap>> heap-size ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue