net2o: Hex Artifact Content

Artifact 6a606b09ca14ce8c2c7aa2b34f6fd443b96d5c95:

File heap1.fs — part of check-in [2f6563a420] at 2012-09-03 15:46:13 on branch trunk — Heap tests with vfx (user: bernd size: 2153)
0000: 5c 20 62 69 6e 61 72 79 20 68 65 61 70 0a 0a 5c  \ binary heap..\
0010: 20 61 20 62 69 6e 61 72 79 20 68 65 61 70 20 69   a binary heap i
0020: 73 20 61 20 73 74 72 75 63 74 75 72 65 20 74 6f  s a structure to
0030: 20 6b 65 65 70 20 61 20 70 61 72 74 69 61 6c 6c   keep a partiall
0040: 79 20 73 6f 72 74 65 64 20 73 65 74 0a 5c 20 73  y sorted set.\ s
0050: 6f 20 74 68 61 74 20 79 6f 75 20 63 61 6e 20 65  o that you can e
0060: 61 73 69 6c 79 20 69 6e 73 65 72 74 20 65 6c 65  asily insert ele
0070: 6d 65 6e 74 73 2c 20 61 6e 64 20 65 78 74 72 61  ments, and extra
0080: 63 74 20 74 68 65 20 6c 65 61 73 74 20 65 6c 65  ct the least ele
0090: 6d 65 6e 74 0a 0a 5b 64 65 66 69 6e 65 64 5d 20  ment..[defined] 
00a0: 6e 74 69 6d 65 20 30 3d 20 5b 49 46 5d 0a 20 20  ntime 0= [IF].  
00b0: 20 20 6c 69 62 72 61 72 79 3a 20 6c 69 62 72 74    library: librt
00c0: 2e 73 6f 2e 31 0a 20 20 20 20 65 78 74 65 72 6e  .so.1.    extern
00d0: 3a 20 69 6e 74 20 63 6c 6f 63 6b 5f 67 65 74 74  : int clock_gett
00e0: 69 6d 65 20 28 20 69 6e 74 20 2c 20 69 6e 74 20  ime ( int , int 
00f0: 29 3b 0a 0a 20 20 20 20 32 56 61 72 69 61 62 6c  );..    2Variabl
0100: 65 20 74 69 6d 65 73 70 65 63 0a 20 20 20 20 3a  e timespec.    :
0110: 20 6e 74 69 6d 65 20 28 20 2d 2d 20 64 20 29 20   ntime ( -- d ) 
0120: 20 30 20 74 69 6d 65 73 70 65 63 20 63 6c 6f 63   0 timespec cloc
0130: 6b 5f 67 65 74 74 69 6d 65 20 64 72 6f 70 0a 09  k_gettime drop..
0140: 74 69 6d 65 73 70 65 63 20 32 40 20 23 31 30 30  timespec 2@ #100
0150: 30 30 30 30 30 30 30 20 75 6d 2a 20 72 6f 74 20  0000000 um* rot 
0160: 30 20 64 2b 20 3b 0a 5b 54 48 45 4e 5d 0a 0a 62  0 d+ ;.[THEN]..b
0170: 65 67 69 6e 2d 73 74 72 75 63 74 75 72 65 20 68  egin-structure h
0180: 65 61 70 0a 66 69 65 6c 64 3a 20 68 61 72 72 61  eap.field: harra
0190: 79 0a 66 69 65 6c 64 3a 20 68 73 69 7a 65 0a 66  y.field: hsize.f
01a0: 69 65 6c 64 3a 20 68 6d 61 78 73 69 7a 65 0a 65  ield: hmaxsize.e
01b0: 6e 64 2d 73 74 72 75 63 74 75 72 65 0a 0a 3a 20  nd-structure..: 
01c0: 68 6c 65 73 73 20 28 20 69 31 20 69 32 20 68 65  hless ( i1 i2 he
01d0: 61 70 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20  ap -- flag ).   
01e0: 20 68 61 72 72 61 79 20 40 20 74 75 63 6b 20 2b   harray @ tuck +
01f0: 20 40 20 3e 72 20 2b 20 40 20 72 3e 20 3c 20 3b   @ >r + @ r> < ;
0200: 0a 3a 20 68 73 77 61 70 20 28 20 69 31 20 69 32  .: hswap ( i1 i2
0210: 20 68 65 61 70 20 2d 2d 20 29 0a 20 20 20 20 68   heap -- ).    h
0220: 61 72 72 61 79 20 40 20 74 75 63 6b 20 2b 20 3e  array @ tuck + >
0230: 72 20 2b 20 72 3e 20 7b 20 69 31 20 69 32 20 7d  r + r> { i1 i2 }
0240: 0a 20 20 20 20 69 31 20 40 20 69 32 20 40 20 20  .    i1 @ i2 @  
0250: 69 31 20 21 20 69 32 20 21 20 3b 0a 0a 3a 20 68  i1 ! i2 ! ;..: h
0260: 6e 65 77 20 28 20 2d 2d 20 68 65 61 70 20 29 0a  new ( -- heap ).
0270: 20 20 20 20 68 65 61 70 20 61 6c 6c 6f 63 61 74      heap allocat
0280: 65 20 74 68 72 6f 77 20 3e 72 0a 20 20 20 20 63  e throw >r.    c
0290: 65 6c 6c 20 64 75 70 20 72 40 20 68 6d 61 78 73  ell dup r@ hmaxs
02a0: 69 7a 65 20 21 20 30 20 72 40 20 68 73 69 7a 65  ize ! 0 r@ hsize
02b0: 20 21 0a 20 20 20 20 61 6c 6c 6f 63 61 74 65 20   !.    allocate 
02c0: 74 68 72 6f 77 20 72 40 20 68 61 72 72 61 79 20  throw r@ harray 
02d0: 21 20 72 3e 20 3b 0a 0a 3a 20 68 72 65 73 69 7a  ! r> ;..: hresiz
02e0: 65 3e 20 28 20 68 65 61 70 20 2d 2d 20 29 20 3e  e> ( heap -- ) >
02f0: 72 0a 20 20 20 20 72 40 20 68 6d 61 78 73 69 7a  r.    r@ hmaxsiz
0300: 65 20 40 20 72 40 20 68 73 69 7a 65 20 40 20 75  e @ r@ hsize @ u
0310: 3c 20 49 46 0a 09 72 40 20 68 61 72 72 61 79 20  < IF..r@ harray 
0320: 40 0a 09 72 40 20 68 6d 61 78 73 69 7a 65 20 40  @..r@ hmaxsize @
0330: 20 32 2a 20 64 75 70 20 72 40 20 68 6d 61 78 73   2* dup r@ hmaxs
0340: 69 7a 65 20 21 20 72 65 73 69 7a 65 20 74 68 72  ize ! resize thr
0350: 6f 77 0a 09 72 40 20 68 61 72 72 61 79 20 21 0a  ow..r@ harray !.
0360: 20 20 20 20 54 48 45 4e 20 72 3e 20 64 72 6f 70      THEN r> drop
0370: 20 3b 0a 0a 3a 20 68 72 65 73 69 7a 65 3c 20 28   ;..: hresize< (
0380: 20 68 65 61 70 20 2d 2d 20 29 20 3e 72 0a 20 20   heap -- ) >r.  
0390: 20 20 72 40 20 68 6d 61 78 73 69 7a 65 20 40 20    r@ hmaxsize @ 
03a0: 32 2f 20 72 40 20 68 73 69 7a 65 20 40 20 75 3e  2/ r@ hsize @ u>
03b0: 20 49 46 0a 09 72 40 20 68 61 72 72 61 79 20 40   IF..r@ harray @
03c0: 0a 09 72 40 20 68 6d 61 78 73 69 7a 65 20 40 20  ..r@ hmaxsize @ 
03d0: 32 2f 20 64 75 70 20 72 40 20 68 6d 61 78 73 69  2/ dup r@ hmaxsi
03e0: 7a 65 20 21 20 72 65 73 69 7a 65 20 74 68 72 6f  ze ! resize thro
03f0: 77 0a 09 72 40 20 68 61 72 72 61 79 20 21 0a 20  w..r@ harray !. 
0400: 20 20 20 54 48 45 4e 20 72 3e 20 64 72 6f 70 20     THEN r> drop 
0410: 3b 0a 0a 3a 20 62 75 62 62 6c 65 2d 75 70 20 28  ;..: bubble-up (
0420: 20 69 6e 64 65 78 20 68 65 61 70 20 2d 2d 20 29   index heap -- )
0430: 0a 20 20 20 20 30 20 7b 20 69 6e 64 65 78 20 68  .    0 { index h
0440: 65 61 70 20 69 6e 64 65 78 2f 32 20 7d 0a 20 20  eap index/2 }.  
0450: 20 20 42 45 47 49 4e 0a 09 69 6e 64 65 78 20 63    BEGIN..index c
0460: 65 6c 6c 20 2f 20 31 2d 20 32 2f 20 63 65 6c 6c  ell / 1- 2/ cell
0470: 73 20 64 75 70 20 74 6f 20 69 6e 64 65 78 2f 32  s dup to index/2
0480: 20 30 3c 20 30 3d 20 57 48 49 4c 45 0a 09 20 20   0< 0= WHILE..  
0490: 20 20 69 6e 64 65 78 20 69 6e 64 65 78 2f 32 20    index index/2 
04a0: 68 65 61 70 20 68 6c 65 73 73 20 20 57 48 49 4c  heap hless  WHIL
04b0: 45 0a 09 09 69 6e 64 65 78 20 69 6e 64 65 78 2f  E...index index/
04c0: 32 20 68 65 61 70 20 68 73 77 61 70 0a 09 09 69  2 heap hswap...i
04d0: 6e 64 65 78 20 69 6e 64 65 78 2f 32 20 74 6f 20  ndex index/2 to 
04e0: 69 6e 64 65 78 0a 20 20 20 20 30 3d 20 55 4e 54  index.    0= UNT
04f0: 49 4c 20 20 54 48 45 4e 20 54 48 45 4e 20 3b 0a  IL  THEN THEN ;.
0500: 0a 3a 20 68 69 6e 73 65 72 74 20 28 20 2e 2e 2e  .: hinsert ( ...
0510: 20 68 65 61 70 20 2d 2d 20 29 20 7b 20 68 65 61   heap -- ) { hea
0520: 70 20 7d 0a 20 20 20 20 68 65 61 70 20 68 73 69  p }.    heap hsi
0530: 7a 65 20 40 20 64 75 70 20 3e 72 0a 20 20 20 20  ze @ dup >r.    
0540: 63 65 6c 6c 20 68 65 61 70 20 68 73 69 7a 65 20  cell heap hsize 
0550: 2b 21 20 68 65 61 70 20 68 72 65 73 69 7a 65 3e  +! heap hresize>
0560: 0a 20 20 20 20 68 65 61 70 20 68 61 72 72 61 79  .    heap harray
0570: 20 40 20 2b 20 21 0a 20 20 20 20 72 3e 20 68 65   @ + !.    r> he
0580: 61 70 20 62 75 62 62 6c 65 2d 75 70 20 3b 0a 0a  ap bubble-up ;..
0590: 3a 20 62 75 62 62 6c 65 2d 64 6f 77 6e 20 28 20  : bubble-down ( 
05a0: 68 65 61 70 20 2d 2d 20 29 20 30 20 73 77 61 70  heap -- ) 0 swap
05b0: 0a 20 20 20 20 63 65 6c 6c 20 6f 76 65 72 20 68  .    cell over h
05c0: 73 69 7a 65 20 40 20 30 20 7b 20 69 6e 64 65 78  size @ 0 { index
05d0: 20 68 65 61 70 20 73 69 7a 65 20 68 73 69 7a 65   heap size hsize
05e0: 20 69 6e 64 65 78 2a 32 20 7d 0a 20 20 20 20 42   index*2 }.    B
05f0: 45 47 49 4e 0a 09 69 6e 64 65 78 20 64 75 70 20  EGIN..index dup 
0600: 32 2a 20 63 65 6c 6c 2b 20 74 6f 20 69 6e 64 65  2* cell+ to inde
0610: 78 2a 32 0a 09 69 6e 64 65 78 2a 32 20 68 73 69  x*2..index*2 hsi
0620: 7a 65 20 75 3c 20 20 57 48 49 4c 45 0a 09 20 20  ze u<  WHILE..  
0630: 20 20 69 6e 64 65 78 20 69 6e 64 65 78 2a 32 20    index index*2 
0640: 68 65 61 70 20 68 6c 65 73 73 20 30 3d 20 49 46  heap hless 0= IF
0650: 0a 09 09 64 72 6f 70 20 69 6e 64 65 78 2a 32 20  ...drop index*2 
0660: 20 54 48 45 4e 0a 09 20 20 20 20 69 6e 64 65 78   THEN..    index
0670: 2a 32 20 73 69 7a 65 20 2b 20 68 73 69 7a 65 20  *2 size + hsize 
0680: 75 3c 20 20 49 46 0a 09 09 64 75 70 20 69 6e 64  u<  IF...dup ind
0690: 65 78 2a 32 20 63 65 6c 6c 2b 20 68 65 61 70 20  ex*2 cell+ heap 
06a0: 68 6c 65 73 73 20 30 3d 20 49 46 0a 09 09 20 20  hless 0= IF...  
06b0: 20 20 64 72 6f 70 20 69 6e 64 65 78 2a 32 20 63    drop index*2 c
06c0: 65 6c 6c 2b 20 20 54 48 45 4e 20 20 54 48 45 4e  ell+  THEN  THEN
06d0: 0a 09 20 20 20 20 69 6e 64 65 78 20 6f 76 65 72  ..    index over
06e0: 20 20 68 65 61 70 20 68 73 77 61 70 0a 09 20 20    heap hswap..  
06f0: 20 20 64 75 70 20 69 6e 64 65 78 20 3d 20 73 77    dup index = sw
0700: 61 70 20 74 6f 20 69 6e 64 65 78 0a 09 55 4e 54  ap to index..UNT
0710: 49 4c 20 20 45 58 49 54 20 20 54 48 45 4e 20 64  IL  EXIT  THEN d
0720: 72 6f 70 20 3b 0a 0a 3a 20 68 64 65 6c 65 74 65  rop ;..: hdelete
0730: 20 28 20 68 65 61 70 20 2d 2d 20 2e 2e 2e 20 29   ( heap -- ... )
0740: 20 3e 72 0a 20 20 20 20 72 40 20 68 73 69 7a 65   >r.    r@ hsize
0750: 20 40 20 30 3d 20 61 62 6f 72 74 22 20 68 65 61   @ 0= abort" hea
0760: 70 20 65 6d 70 74 79 22 0a 20 20 20 20 72 40 20  p empty".    r@ 
0770: 68 61 72 72 61 79 20 40 20 40 0a 20 20 20 20 63  harray @ @.    c
0780: 65 6c 6c 20 6e 65 67 61 74 65 20 72 40 20 68 73  ell negate r@ hs
0790: 69 7a 65 20 2b 21 0a 20 20 20 20 72 40 20 68 61  ize +!.    r@ ha
07a0: 72 72 61 79 20 40 20 72 40 20 68 73 69 7a 65 20  rray @ r@ hsize 
07b0: 40 20 2b 20 40 20 72 40 20 68 61 72 72 61 79 20  @ + @ r@ harray 
07c0: 40 20 21 0a 20 20 20 20 72 40 20 68 72 65 73 69  @ !.    r@ hresi
07d0: 7a 65 3c 0a 20 20 20 20 72 3e 20 62 75 62 62 6c  ze<.    r> bubbl
07e0: 65 2d 64 6f 77 6e 20 3b 0a 0a 3a 20 68 73 69 7a  e-down ;..: hsiz
07f0: 65 40 20 28 20 68 65 61 70 20 2d 2d 20 29 0a 20  e@ ( heap -- ). 
0800: 20 20 20 68 73 69 7a 65 20 40 20 63 65 6c 6c 20     hsize @ cell 
0810: 2f 20 3b 0a 0a 3a 20 2e 68 65 61 70 20 7b 20 68  / ;..: .heap { h
0820: 65 61 70 20 2d 2d 20 7d 0a 20 20 20 20 68 65 61  eap -- }.    hea
0830: 70 20 68 61 72 72 61 79 20 40 20 68 65 61 70 20  p harray @ heap 
0840: 68 73 69 7a 65 20 40 20 62 6f 75 6e 64 73 20 3f  hsize @ bounds ?
0850: 44 4f 0a 09 49 20 3f 0a 20 20 20 20 63 65 6c 6c  DO..I ?.    cell
0860: 20 2b 4c 4f 4f 50 20 3b 0a                        +LOOP ;.