Artifact
50392f771d3f3608cee646b3944c22f9b0ae4a89
File
heap.fs
— part of check-in
[54222f0bc1]
at
2012-09-08 22:42:58
on branch trunk
— heap/heap1 changes
(user:
bernd
size: 2556)
File
testing/heap.fs
— part of check-in
[560fb86b36]
at
2012-10-22 22:04:40
on branch trunk
— Move unnecessary stuff to testing/
(user:
bernd
size: 2556)
0000: 5c 20 62 69 6e 61 72 79 20 68 65 61 70 0a 0a 72 \ binary heap..r
0010: 65 71 75 69 72 65 20 6d 69 6e 69 2d 6f 6f 66 2e equire mini-oof.
0020: 66 73 0a 0a 5b 64 65 66 69 6e 65 64 5d 20 6e 74 fs..[defined] nt
0030: 69 6d 65 20 30 3d 20 5b 49 46 5d 0a 20 20 20 20 ime 0= [IF].
0040: 6c 69 62 72 61 72 79 3a 20 6c 69 62 72 74 2e 73 library: librt.s
0050: 6f 2e 31 0a 20 20 20 20 65 78 74 65 72 6e 3a 20 o.1. extern:
0060: 69 6e 74 20 63 6c 6f 63 6b 5f 67 65 74 74 69 6d int clock_gettim
0070: 65 20 28 20 69 6e 74 20 2c 20 69 6e 74 20 29 3b e ( int , int );
0080: 0a 0a 20 20 20 20 32 56 61 72 69 61 62 6c 65 20 .. 2Variable
0090: 74 69 6d 65 73 70 65 63 0a 20 20 20 20 3a 20 6e timespec. : n
00a0: 74 69 6d 65 20 28 20 2d 2d 20 64 20 29 20 20 30 time ( -- d ) 0
00b0: 20 74 69 6d 65 73 70 65 63 20 63 6c 6f 63 6b 5f timespec clock_
00c0: 67 65 74 74 69 6d 65 20 64 72 6f 70 0a 09 74 69 gettime drop..ti
00d0: 6d 65 73 70 65 63 20 32 40 20 23 31 30 30 30 30 mespec 2@ #10000
00e0: 30 30 30 30 30 20 75 6d 2a 20 72 6f 74 20 30 20 00000 um* rot 0
00f0: 64 2b 20 3b 0a 5b 54 48 45 4e 5d 0a 0a 5c 20 61 d+ ;.[THEN]..\ a
0100: 20 62 69 6e 61 72 79 20 68 65 61 70 20 69 73 20 binary heap is
0110: 61 20 73 74 72 75 63 74 75 72 65 20 74 6f 20 6b a structure to k
0120: 65 65 70 20 61 20 70 61 72 74 69 61 6c 6c 79 20 eep a partially
0130: 73 6f 72 74 65 64 20 73 65 74 0a 5c 20 73 6f 20 sorted set.\ so
0140: 74 68 61 74 20 79 6f 75 20 63 61 6e 20 65 61 73 that you can eas
0150: 69 6c 79 20 69 6e 73 65 72 74 20 65 6c 65 6d 65 ily insert eleme
0160: 6e 74 73 2c 20 61 6e 64 20 65 78 74 72 61 63 74 nts, and extract
0170: 20 74 68 65 20 6c 65 61 73 74 20 65 6c 65 6d 65 the least eleme
0180: 6e 74 0a 0a 6f 62 6a 65 63 74 20 63 6c 61 73 73 nt..object class
0190: 0a 20 20 20 20 63 65 6c 6c 20 76 61 72 20 68 61 . cell var ha
01a0: 72 72 61 79 0a 20 20 20 20 63 65 6c 6c 20 76 61 rray. cell va
01b0: 72 20 68 73 69 7a 65 0a 20 20 20 20 63 65 6c 6c r hsize. cell
01c0: 20 76 61 72 20 68 6d 61 78 73 69 7a 65 0a 20 20 var hmaxsize.
01d0: 20 20 6d 65 74 68 6f 64 20 68 6c 65 73 73 0a 20 method hless.
01e0: 20 20 20 6d 65 74 68 6f 64 20 68 73 77 61 70 0a method hswap.
01f0: 20 20 20 20 6d 65 74 68 6f 64 20 68 63 65 6c 6c method hcell
0200: 0a 20 20 20 20 6d 65 74 68 6f 64 20 68 65 61 70 . method heap
0210: 40 0a 20 20 20 20 6d 65 74 68 6f 64 20 68 65 61 @. method hea
0220: 70 21 0a 20 20 20 20 6d 65 74 68 6f 64 20 2e 68 p!. method .h
0230: 0a 65 6e 64 2d 63 6c 61 73 73 20 68 65 61 70 0a .end-class heap.
0240: 0a 3a 6e 6f 6e 61 6d 65 20 28 20 69 31 20 69 32 .:noname ( i1 i2
0250: 20 68 65 61 70 20 2d 2d 20 66 6c 61 67 20 29 0a heap -- flag ).
0260: 20 20 20 20 68 61 72 72 61 79 20 40 20 74 75 63 harray @ tuc
0270: 6b 20 2b 20 40 20 3e 72 20 2b 20 40 20 72 3e 20 k + @ >r + @ r>
0280: 3c 20 3b 20 68 65 61 70 20 64 65 66 69 6e 65 73 < ; heap defines
0290: 20 68 6c 65 73 73 0a 3a 6e 6f 6e 61 6d 65 20 28 hless.:noname (
02a0: 20 69 31 20 69 32 20 68 65 61 70 20 2d 2d 20 29 i1 i2 heap -- )
02b0: 0a 20 20 20 20 68 61 72 72 61 79 20 40 20 74 75 . harray @ tu
02c0: 63 6b 20 2b 20 3e 72 20 2b 20 72 3e 20 7b 20 69 ck + >r + r> { i
02d0: 31 20 69 32 20 7d 0a 20 20 20 20 69 31 20 40 20 1 i2 }. i1 @
02e0: 69 32 20 40 20 20 69 31 20 21 20 69 32 20 21 20 i2 @ i1 ! i2 !
02f0: 3b 20 68 65 61 70 20 64 65 66 69 6e 65 73 20 68 ; heap defines h
0300: 73 77 61 70 0a 3a 6e 6f 6e 61 6d 65 20 64 72 6f swap.:noname dro
0310: 70 20 2e 20 3b 20 68 65 61 70 20 64 65 66 69 6e p . ; heap defin
0320: 65 73 20 2e 68 0a 3a 6e 6f 6e 61 6d 65 20 64 72 es .h.:noname dr
0330: 6f 70 20 63 65 6c 6c 20 3b 20 68 65 61 70 20 64 op cell ; heap d
0340: 65 66 69 6e 65 73 20 68 63 65 6c 6c 0a 3a 6e 6f efines hcell.:no
0350: 6e 61 6d 65 20 64 72 6f 70 20 40 20 3b 20 68 65 name drop @ ; he
0360: 61 70 20 64 65 66 69 6e 65 73 20 68 65 61 70 40 ap defines heap@
0370: 0a 3a 6e 6f 6e 61 6d 65 20 64 72 6f 70 20 21 20 .:noname drop !
0380: 3b 20 68 65 61 70 20 64 65 66 69 6e 65 73 20 68 ; heap defines h
0390: 65 61 70 21 0a 0a 3a 20 68 6e 65 77 20 28 20 2d eap!..: hnew ( -
03a0: 2d 20 68 65 61 70 20 29 0a 20 20 20 20 68 65 61 - heap ). hea
03b0: 70 20 6e 65 77 20 3e 72 0a 20 20 20 20 72 40 20 p new >r. r@
03c0: 68 63 65 6c 6c 20 64 75 70 20 72 40 20 68 6d 61 hcell dup r@ hma
03d0: 78 73 69 7a 65 20 21 20 30 20 72 40 20 68 73 69 xsize ! 0 r@ hsi
03e0: 7a 65 20 21 0a 20 20 20 20 61 6c 6c 6f 63 61 74 ze !. allocat
03f0: 65 20 74 68 72 6f 77 20 72 40 20 68 61 72 72 61 e throw r@ harra
0400: 79 20 21 20 72 3e 20 3b 0a 0a 3a 20 68 72 65 73 y ! r> ;..: hres
0410: 69 7a 65 3e 20 28 20 68 65 61 70 20 2d 2d 20 29 ize> ( heap -- )
0420: 20 3e 72 0a 20 20 20 20 72 40 20 68 6d 61 78 73 >r. r@ hmaxs
0430: 69 7a 65 20 40 20 72 40 20 68 73 69 7a 65 20 40 ize @ r@ hsize @
0440: 20 75 3c 20 49 46 0a 09 72 40 20 68 61 72 72 61 u< IF..r@ harra
0450: 79 20 40 0a 09 72 40 20 68 6d 61 78 73 69 7a 65 y @..r@ hmaxsize
0460: 20 40 20 32 2a 20 64 75 70 20 72 40 20 68 6d 61 @ 2* dup r@ hma
0470: 78 73 69 7a 65 20 21 20 72 65 73 69 7a 65 20 74 xsize ! resize t
0480: 68 72 6f 77 0a 09 72 40 20 68 61 72 72 61 79 20 hrow..r@ harray
0490: 21 0a 20 20 20 20 54 48 45 4e 20 72 3e 20 64 72 !. THEN r> dr
04a0: 6f 70 20 3b 0a 0a 3a 20 68 72 65 73 69 7a 65 3c op ;..: hresize<
04b0: 20 28 20 68 65 61 70 20 2d 2d 20 29 20 3e 72 0a ( heap -- ) >r.
04c0: 20 20 20 20 72 40 20 68 6d 61 78 73 69 7a 65 20 r@ hmaxsize
04d0: 40 20 32 2f 20 72 40 20 68 73 69 7a 65 20 40 20 @ 2/ r@ hsize @
04e0: 75 3e 20 49 46 0a 09 72 40 20 68 61 72 72 61 79 u> IF..r@ harray
04f0: 20 40 0a 09 72 40 20 68 6d 61 78 73 69 7a 65 20 @..r@ hmaxsize
0500: 40 20 32 2f 20 64 75 70 20 72 40 20 68 6d 61 78 @ 2/ dup r@ hmax
0510: 73 69 7a 65 20 21 20 72 65 73 69 7a 65 20 74 68 size ! resize th
0520: 72 6f 77 0a 09 72 40 20 68 61 72 72 61 79 20 21 row..r@ harray !
0530: 0a 20 20 20 20 54 48 45 4e 20 72 3e 20 64 72 6f . THEN r> dro
0540: 70 20 3b 0a 0a 3a 20 62 75 62 62 6c 65 2d 75 70 p ;..: bubble-up
0550: 20 28 20 69 6e 64 65 78 20 68 65 61 70 20 2d 2d ( index heap --
0560: 20 29 0a 20 20 20 20 64 75 70 20 68 63 65 6c 6c ). dup hcell
0570: 20 30 20 7b 20 69 6e 64 65 78 20 68 65 61 70 20 0 { index heap
0580: 73 69 7a 65 20 69 6e 64 65 78 2f 32 20 7d 0a 20 size index/2 }.
0590: 20 20 20 42 45 47 49 4e 0a 09 69 6e 64 65 78 20 BEGIN..index
05a0: 73 69 7a 65 20 2f 20 31 2d 20 32 2f 20 73 69 7a size / 1- 2/ siz
05b0: 65 20 2a 20 64 75 70 20 74 6f 20 69 6e 64 65 78 e * dup to index
05c0: 2f 32 20 30 3c 20 30 3d 20 57 48 49 4c 45 0a 09 /2 0< 0= WHILE..
05d0: 20 20 20 20 69 6e 64 65 78 20 69 6e 64 65 78 2f index index/
05e0: 32 20 68 65 61 70 20 68 6c 65 73 73 20 20 57 48 2 heap hless WH
05f0: 49 4c 45 0a 09 09 69 6e 64 65 78 20 69 6e 64 65 ILE...index inde
0600: 78 2f 32 20 68 65 61 70 20 68 73 77 61 70 0a 09 x/2 heap hswap..
0610: 09 69 6e 64 65 78 20 69 6e 64 65 78 2f 32 20 74 .index index/2 t
0620: 6f 20 69 6e 64 65 78 0a 20 20 20 20 30 3d 20 55 o index. 0= U
0630: 4e 54 49 4c 20 20 54 48 45 4e 20 54 48 45 4e 20 NTIL THEN THEN
0640: 3b 0a 0a 3a 20 68 69 6e 73 65 72 74 20 28 20 2e ;..: hinsert ( .
0650: 2e 2e 20 68 65 61 70 20 2d 2d 20 29 20 7b 20 68 .. heap -- ) { h
0660: 65 61 70 20 7d 0a 20 20 20 20 68 65 61 70 20 68 eap }. heap h
0670: 73 69 7a 65 20 40 20 64 75 70 20 3e 72 0a 20 20 size @ dup >r.
0680: 20 20 68 65 61 70 20 68 63 65 6c 6c 20 68 65 61 heap hcell hea
0690: 70 20 68 73 69 7a 65 20 2b 21 20 68 65 61 70 20 p hsize +! heap
06a0: 68 72 65 73 69 7a 65 3e 0a 20 20 20 20 68 65 61 hresize>. hea
06b0: 70 20 68 61 72 72 61 79 20 40 20 2b 20 68 65 61 p harray @ + hea
06c0: 70 20 68 65 61 70 21 0a 20 20 20 20 72 3e 20 68 p heap!. r> h
06d0: 65 61 70 20 62 75 62 62 6c 65 2d 75 70 20 3b 0a eap bubble-up ;.
06e0: 0a 3a 20 62 75 62 62 6c 65 2d 64 6f 77 6e 20 28 .: bubble-down (
06f0: 20 68 65 61 70 20 2d 2d 20 29 20 30 20 73 77 61 heap -- ) 0 swa
0700: 70 0a 20 20 20 20 64 75 70 20 68 63 65 6c 6c 20 p. dup hcell
0710: 6f 76 65 72 20 68 73 69 7a 65 20 40 20 30 20 7b over hsize @ 0 {
0720: 20 69 6e 64 65 78 20 68 65 61 70 20 73 69 7a 65 index heap size
0730: 20 68 73 69 7a 65 20 69 6e 64 65 78 2a 32 20 7d hsize index*2 }
0740: 0a 20 20 20 20 42 45 47 49 4e 0a 09 69 6e 64 65 . BEGIN..inde
0750: 78 20 64 75 70 20 32 2a 20 73 69 7a 65 20 2b 20 x dup 2* size +
0760: 74 6f 20 69 6e 64 65 78 2a 32 0a 09 69 6e 64 65 to index*2..inde
0770: 78 2a 32 20 68 73 69 7a 65 20 75 3c 20 20 57 48 x*2 hsize u< WH
0780: 49 4c 45 0a 09 20 20 20 20 69 6e 64 65 78 20 69 ILE.. index i
0790: 6e 64 65 78 2a 32 20 68 65 61 70 20 68 6c 65 73 ndex*2 heap hles
07a0: 73 20 30 3d 20 49 46 0a 09 09 64 72 6f 70 20 69 s 0= IF...drop i
07b0: 6e 64 65 78 2a 32 20 20 54 48 45 4e 0a 09 20 20 ndex*2 THEN..
07c0: 20 20 69 6e 64 65 78 2a 32 20 73 69 7a 65 20 2b index*2 size +
07d0: 20 68 73 69 7a 65 20 75 3c 20 20 49 46 0a 09 09 hsize u< IF...
07e0: 64 75 70 20 69 6e 64 65 78 2a 32 20 73 69 7a 65 dup index*2 size
07f0: 20 2b 20 68 65 61 70 20 68 6c 65 73 73 20 30 3d + heap hless 0=
0800: 20 49 46 0a 09 09 20 20 20 20 64 72 6f 70 20 69 IF... drop i
0810: 6e 64 65 78 2a 32 20 73 69 7a 65 20 2b 20 20 54 ndex*2 size + T
0820: 48 45 4e 20 20 54 48 45 4e 0a 09 20 20 20 20 69 HEN THEN.. i
0830: 6e 64 65 78 20 6f 76 65 72 20 20 68 65 61 70 20 ndex over heap
0840: 68 73 77 61 70 0a 09 20 20 20 20 64 75 70 20 69 hswap.. dup i
0850: 6e 64 65 78 20 3d 20 73 77 61 70 20 74 6f 20 69 ndex = swap to i
0860: 6e 64 65 78 0a 09 55 4e 54 49 4c 20 20 45 58 49 ndex..UNTIL EXI
0870: 54 20 20 54 48 45 4e 20 64 72 6f 70 20 3b 0a 0a T THEN drop ;..
0880: 3a 20 68 64 65 6c 65 74 65 20 28 20 68 65 61 70 : hdelete ( heap
0890: 20 2d 2d 20 2e 2e 2e 20 29 20 3e 72 0a 20 20 20 -- ... ) >r.
08a0: 20 72 40 20 68 73 69 7a 65 20 40 20 30 3d 20 61 r@ hsize @ 0= a
08b0: 62 6f 72 74 22 20 68 65 61 70 20 65 6d 70 74 79 bort" heap empty
08c0: 22 0a 20 20 20 20 72 40 20 68 61 72 72 61 79 20 ". r@ harray
08d0: 40 20 72 40 20 68 65 61 70 40 0a 20 20 20 20 72 @ r@ heap@. r
08e0: 40 20 68 63 65 6c 6c 20 6e 65 67 61 74 65 20 72 @ hcell negate r
08f0: 40 20 68 73 69 7a 65 20 2b 21 0a 20 20 20 20 72 @ hsize +!. r
0900: 40 20 68 61 72 72 61 79 20 40 20 72 40 20 68 73 @ harray @ r@ hs
0910: 69 7a 65 20 40 20 2b 20 72 40 20 68 65 61 70 40 ize @ + r@ heap@
0920: 20 72 40 20 68 61 72 72 61 79 20 40 20 72 40 20 r@ harray @ r@
0930: 68 65 61 70 21 0a 20 20 20 20 72 40 20 68 72 65 heap!. r@ hre
0940: 73 69 7a 65 3c 0a 20 20 20 20 72 3e 20 62 75 62 size<. r> bub
0950: 62 6c 65 2d 64 6f 77 6e 20 3b 0a 0a 3a 20 68 73 ble-down ;..: hs
0960: 69 7a 65 40 20 28 20 68 65 61 70 20 2d 2d 20 29 ize@ ( heap -- )
0970: 0a 20 20 20 20 64 75 70 20 68 73 69 7a 65 20 40 . dup hsize @
0980: 20 73 77 61 70 20 68 63 65 6c 6c 20 2f 20 3b 0a swap hcell / ;.
0990: 0a 3a 20 2e 68 65 61 70 20 7b 20 68 65 61 70 20 .: .heap { heap
09a0: 2d 2d 20 7d 0a 20 20 20 20 68 65 61 70 20 68 61 -- }. heap ha
09b0: 72 72 61 79 20 40 20 68 65 61 70 20 68 73 69 7a rray @ heap hsiz
09c0: 65 20 40 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 e @ bounds ?DO..
09d0: 49 20 68 65 61 70 20 68 65 61 70 40 20 68 65 61 I heap heap@ hea
09e0: 70 20 2e 68 0a 20 20 20 20 68 65 61 70 20 68 63 p .h. heap hc
09f0: 65 6c 6c 20 2b 4c 4f 4f 50 20 3b 0a ell +LOOP ;.