Remove old heap from unmaintained
Doug Coleman
parent
a86a138b08
commit
3c28446ac3
|
|
@ -1,74 +0,0 @@
|
|||
! Binary Min Heap
|
||||
! Copyright 2007 Ryan Murphy
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: kernel math sequences ;
|
||||
IN: heap
|
||||
|
||||
: [comp] ( elt elt -- ? ) <=> 0 > ;
|
||||
|
||||
: <heap> ( -- heap ) V{ } clone ;
|
||||
|
||||
: left ( index -- index ) ! left child
|
||||
2 * 1 + ;
|
||||
|
||||
: leftv ( heap index -- value )
|
||||
left swap nth ;
|
||||
|
||||
: right ( index -- index ) ! right child
|
||||
2 * 2 + ;
|
||||
|
||||
: rightv ( heap index -- value )
|
||||
right swap nth ;
|
||||
|
||||
: l-oob ( i heap -- ? ) swap left swap length >= ;
|
||||
: r-oob ( i heap -- ? ) swap right swap length >= ;
|
||||
|
||||
: up ( index -- index ) ! parent node
|
||||
1 - 2 /i ;
|
||||
|
||||
: upv ( heap index -- value ) ! parent's value
|
||||
up swap nth ;
|
||||
|
||||
: lasti ( seq -- index ) length 1 - ;
|
||||
|
||||
: swapup ( heap index -- ) dup up rot exchange ;
|
||||
|
||||
: (farchild) ( heap index -- index ) tuck 2dup leftv -rot rightv [comp] [ right ] [ left ] if ;
|
||||
|
||||
: farchild ( heap index -- index ) dup right pick length >= [ nip left ] [ (farchild) ] if ;
|
||||
|
||||
: farchildv ( heap index -- value ) dupd farchild swap nth ;
|
||||
|
||||
: swapdown ( heap index -- ) 2dup farchild rot exchange ;
|
||||
|
||||
: upheap ( heap -- )
|
||||
dup dup lasti upv over peek [comp]
|
||||
[ dup lasti 2dup swapup up 1 + head-slice upheap ] [ drop ] if ;
|
||||
|
||||
: add ( elt heap -- )
|
||||
tuck push upheap ;
|
||||
|
||||
: add-many ( seq heap -- )
|
||||
swap [ swap add ] each-with ;
|
||||
|
||||
DEFER: (downheap)
|
||||
|
||||
: (downheap2) ( i heap -- )
|
||||
2dup nth -rot
|
||||
2dup swap farchild dup pick nth 2swap
|
||||
>r >r
|
||||
swapd [comp]
|
||||
[ r> r> tuck swap swapdown (downheap) ] [ drop r> r> 2drop ] if ;
|
||||
|
||||
: (downheap) ( i heap -- )
|
||||
over left over length >= [ 2drop ] [ (downheap2) ] if ;
|
||||
|
||||
: downheap ( heap -- )
|
||||
0 swap (downheap) ;
|
||||
|
||||
: bump ( heap -- )
|
||||
dup peek 0 pick set-nth dup pop* downheap ;
|
||||
|
||||
: gbump ( heap -- first )
|
||||
dup first swap bump ;
|
||||
|
|
@ -1,76 +0,0 @@
|
|||
! Binary Min Heap
|
||||
! Copyright 2007 Ryan Murphy
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: help heap sequences ;
|
||||
|
||||
ARTICLE: { "heap" "heap" } "Binary Min Heap"
|
||||
"A vector-based implementation of a binary min heap. Elements are simply stored in a vector, so use " { $link first } " to access the root of the heap."
|
||||
{ $subsection <heap> }
|
||||
{ $subsection add }
|
||||
{ $subsection add-many }
|
||||
{ $subsection bump }
|
||||
{ $subsection gbump }
|
||||
{ $subsection print-heap }
|
||||
;
|
||||
|
||||
HELP: <heap>
|
||||
"Creates a new heap with nothing on it." ;
|
||||
|
||||
HELP: add
|
||||
"Adds 1 element to the heap."
|
||||
{ $examples
|
||||
{ $code
|
||||
"USE: heap"
|
||||
"<heap> 3 over add 4 over add 5 over add"
|
||||
"print-heap"
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
HELP: add-many
|
||||
"For each element in the sequence, add it to the heap."
|
||||
{ $examples
|
||||
{ $code
|
||||
"USE: heap"
|
||||
"<heap> { 7 6 5 4 3 2 1 } over add-many"
|
||||
"print-heap"
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
HELP: bump
|
||||
"\"Bumps\" the root element off of the heap, rearranging the remaining elements so that the heap remains valid."
|
||||
{ $examples
|
||||
{ $code
|
||||
"USE: heap"
|
||||
"<heap> { 7 6 5 4 3 2 1 } over add-many"
|
||||
"dup print-heap"
|
||||
"dup bump \"(bump)\" print dup print-heap"
|
||||
"dup bump \"(bump)\" print dup print-heap"
|
||||
"dup bump \"(bump)\" print dup print-heap"
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
HELP: gbump
|
||||
"(\"Get-bump\") Does a " { $link bump } ", but leaves the bumped element on the stack instead of discarding it."
|
||||
{ $examples
|
||||
{ $code
|
||||
"USE: heap"
|
||||
"<heap> { 7 6 5 4 3 2 1 } over add-many"
|
||||
"dup gbump"
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
HELP: print-heap
|
||||
"Prints the heap in tree form."
|
||||
{ $examples
|
||||
{ $code
|
||||
"USE: heap"
|
||||
"<heap> { 7 6 5 4 3 2 1 } over add-many"
|
||||
"print-heap"
|
||||
}
|
||||
}
|
||||
;
|
||||
|
|
@ -1,100 +0,0 @@
|
|||
: test-agg2 ( -- )
|
||||
{
|
||||
} >vector
|
||||
{
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
} >vector
|
||||
aggregate2 [ print ] each "" print
|
||||
|
||||
{
|
||||
"aa"
|
||||
"aa"
|
||||
} >vector
|
||||
{
|
||||
} >vector
|
||||
aggregate2 [ print ] each "" print
|
||||
|
||||
{
|
||||
} >vector
|
||||
{
|
||||
} >vector
|
||||
aggregate2 [ print ] each "" print
|
||||
|
||||
{
|
||||
"aaaaaaa"
|
||||
"aaaaaaa"
|
||||
"aaaaaaa"
|
||||
"aaaaaaa"
|
||||
"aaaaaaa"
|
||||
"aaaaaaa"
|
||||
} >vector
|
||||
{
|
||||
"bbbb"
|
||||
"bbbb"
|
||||
"bbbb"
|
||||
} >vector
|
||||
aggregate2 [ print ] each "" print
|
||||
|
||||
{
|
||||
"aaaa"
|
||||
"aaaa"
|
||||
"aaaa"
|
||||
} >vector
|
||||
{
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
"bbbbbbb"
|
||||
} >vector
|
||||
aggregate2 [ print ] each "" print
|
||||
;
|
||||
|
||||
|
||||
|
||||
|
||||
: test-agg ( -- )
|
||||
{
|
||||
"....5.."
|
||||
"...|.|."
|
||||
"..7...9"
|
||||
".|....."
|
||||
"8......"
|
||||
} >vector
|
||||
{
|
||||
"..3.."
|
||||
".|.|."
|
||||
"4...4"
|
||||
} >vector
|
||||
{
|
||||
".2."
|
||||
"|.|"
|
||||
} >vector
|
||||
aggregate3 [ print ] each "" print
|
||||
|
||||
{
|
||||
"....5.."
|
||||
"...|.|."
|
||||
"..7...9"
|
||||
".|....."
|
||||
"8......"
|
||||
} >vector
|
||||
{
|
||||
"......3...."
|
||||
".....|.|..."
|
||||
"....4...4.."
|
||||
"...|.|....."
|
||||
"..5...6...."
|
||||
".|........."
|
||||
"6.........."
|
||||
} >vector
|
||||
{
|
||||
".2."
|
||||
"|.|"
|
||||
} >vector
|
||||
aggregate3 [ print ] each "" print
|
||||
;
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
! Binary Min Heap
|
||||
! Copyright 2007 Ryan Murphy
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
PROVIDE: libs/heap
|
||||
|
||||
{ +files+ {
|
||||
"heap.factor"
|
||||
"print.factor"
|
||||
|
||||
"heap.facts"
|
||||
} }
|
||||
|
||||
{ +tests+ {
|
||||
"tests.factor"
|
||||
} } ;
|
||||
|
|
@ -1,51 +0,0 @@
|
|||
! Binary Min Heap
|
||||
! Copyright 2007 Ryan Murphy
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: namespaces kernel math sequences prettyprint io ;
|
||||
IN: heap
|
||||
|
||||
: spaces ( n -- str )
|
||||
[ [ " " % ] times ] "" make ;
|
||||
|
||||
: prepend-s ( v1 n -- v1' )
|
||||
spaces swap [ append ] map-with ;
|
||||
|
||||
: append-s ( v1 v2 -- v1' )
|
||||
spaces swap [ swap append ] map-with ;
|
||||
|
||||
: pad-r ( lv rv -- rv' )
|
||||
dup first length spaces pick length pick length -
|
||||
[ [ dup , ] times ] V{ } make
|
||||
nip append nip ;
|
||||
|
||||
: pad-l ( lv rv -- lv' )
|
||||
swap pad-r ;
|
||||
|
||||
: (aggregate2) ( lv rv -- v )
|
||||
over length over length >= [ dupd pad-r ] [ tuck pad-l swap ] if
|
||||
[ append ] 2map ;
|
||||
|
||||
: aggregate2 ( lv rv -- v )
|
||||
dup empty? [ drop ] [ over empty? [ nip ] [ (aggregate2) ] if ] if ;
|
||||
|
||||
: (agg3len) ( v -- len )
|
||||
dup empty? [ drop 0 ] [ first length ] if ;
|
||||
|
||||
: aggregate3 ( lv rv pv -- v )
|
||||
dup (agg3len) -roll
|
||||
pick (agg3len) prepend-s
|
||||
over (agg3len) append-s
|
||||
-roll -rot swap append-s
|
||||
swap aggregate2 append ;
|
||||
|
||||
: output-node ( elt -- str ) [ [ pprint ] string-out , ] V{ } make ;
|
||||
|
||||
: (print-heap) ( i heap -- vector )
|
||||
2dup l-oob [ V{ } clone ] [ over left over (print-heap) ] if -rot
|
||||
2dup r-oob [ V{ } clone ] [ over right over (print-heap) ] if -rot
|
||||
V{ } clone pick pick nth output-node append
|
||||
-rot 2drop aggregate3 ;
|
||||
|
||||
: print-heap ( heap -- )
|
||||
dup empty? [ drop ] [ 0 swap (print-heap) [ print ] each ] if ;
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
! Binary Min Heap
|
||||
! Copyright 2007 Ryan Murphy
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: heap test kernel ;
|
||||
|
||||
{ 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test
|
||||
{ t } [ 5 3 [comp] ] unit-test
|
||||
{ V{ } } [ <heap> ] unit-test
|
||||
|
||||
{ V{ -6 -4 2 1 5 3 2 4 3 7 6 8 3 4 4 6 5 5 } } [ <heap> { 3 5 4 6 7 8 2 4 3 5 6 1 3 2 4 5 -6 -4 } over add-many ] unit-test
|
||||
|
||||
|
||||
|
||||
{ V{ "hire" "hose" } } [ V{ "hi" "ho" } V{ "re" "se" } aggregate2 ] unit-test
|
||||
{ V{ "hire" "hose" " it" } } [ V{ "hi" "ho" } V{ "re" "se" "it" } aggregate2 ] unit-test
|
||||
{ V{ "tracks" "snacks" "crack " } } [ V{ "track" "snack" "crack" } V{ "s" "s" } aggregate2 ] unit-test
|
||||
|
||||
|
||||
|
||||
{ V{ " top " "left right" } } [ V{ "left" } V{ "right" } V{ "top" } aggregate3 ] unit-test
|
||||
|
||||
{ V{ " top "
|
||||
" dog "
|
||||
"left right"
|
||||
"over on "
|
||||
" man " } } [ V{ "left" "over" } V{ "right" "on " "man " } V{ "top" "dog" } aggregate3 ] unit-test
|
||||
|
||||
{ V{ " -6 "
|
||||
" -4 2 "
|
||||
" 1 5 3 2 "
|
||||
" 4 3 7 6 8 3 4 4"
|
||||
"6 5 5 " } } [ 0 <heap> { 3 5 4 6 7 8 2 4 3 5 6 1 3 2 4 5 -6 -4 } over add-many (print-heap) ] unit-test
|
||||
|
||||
{ V{ 5 6 6 7 8 } } [ <heap> { 3 5 4 6 5 7 6 8 } over add-many dup bump dup bump dup bump ] unit-test
|
||||
Loading…
Reference in New Issue