home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap36 / heap.bas < prev    next >
Encoding:
BASIC Source File  |  1995-09-19  |  3.4 KB  |  120 lines
  1. Attribute VB_Name = "basHeap"
  2. '=====================================================================
  3. 'HEAP.BAS by Frank Font 1995
  4. '
  5. 'This VB4 file implements the interface to heap functions for the
  6. 'MakeTeam program.
  7. '
  8. 'Internally, the heap functionality is only simulated.  A real heap
  9. 'implementation would enhance the performance of the program very
  10. 'significantly.
  11. '
  12. 'The heap is simulated by an array of type memrec_t.  The memrec_t
  13. 'type is defined elsewhere.
  14. '
  15. '*********************************************************************
  16. 'NOTE: This program is for entertainment purposes ONLY.
  17. '=====================================================================
  18. Option Explicit
  19.  
  20. '---------------------------------------------------------------------
  21. 'Initialize the heap so that it is empty.
  22. '---------------------------------------------------------------------
  23. Sub InitHeap()
  24.   
  25.   NodeHeapSize = ((JobsInProject * EmpsInPool) / 2) + 1024
  26.   ReDim nodeHeap(NodeHeapSize + 1)
  27.   Dim i As Long
  28.   
  29.   For i = 0 To NodeHeapSize
  30.     nodeHeap(i) = -1
  31.   Next i
  32. End Sub
  33.  
  34.  
  35. '---------------------------------------------------------------------
  36. 'Returns true if heap is empty.
  37. '---------------------------------------------------------------------
  38. Public Function EmptyHeap() As Boolean
  39.   Dim i As Long
  40.   For i = 0 To NodeHeapSize
  41.     'Find one non-empty node and we have non-empty heap.
  42.     If nodeHeap(i) >= 0 Then
  43.       EmptyHeap = False
  44.       Exit Function
  45.     End If
  46.   Next i
  47.   EmptyHeap = True
  48. End Function
  49.  
  50.  
  51.  
  52. '---------------------------------------------------------------------
  53. 'Returns index to smallest node of heap and deletes it.
  54. '---------------------------------------------------------------------
  55. Public Function DeleteMin() As Long
  56.   Dim i As Long
  57.   Dim si As Long
  58.   Dim smallest As Double
  59.  
  60.   'Initialize the temporary variables.
  61.   si = -1                   'Initialize to flag value.
  62.   smallest = MAX_Double    'Initialize to huge number.
  63.  
  64.   'Search the fake heap.
  65.   For i = 0 To NodeHeapSize
  66.     If nodeHeap(i) >= 0 Then
  67.       If memPool(nodeHeap(i)).cost <= smallest Then
  68.         si = i                'Index to smallest so far.
  69.         smallest = memPool(nodeHeap(i)).cost
  70.       End If
  71.     End If
  72.   Next i
  73.  
  74.   i = nodeHeap(si)            'Record the pointer value.
  75.   nodeHeap(si) = -1           'Delete the node from the heap.
  76.   DeleteMin = i               'Return the node of the lowest cost.
  77.  
  78. End Function
  79.  
  80.  
  81.  
  82. '---------------------------------------------------------------------
  83. 'Pass in node pointer (np) of node to put into the heap.
  84. '---------------------------------------------------------------------
  85. Public Sub AddHeap(np As Long)
  86.   Dim i As Long
  87.   Dim h As mejrec_t
  88.  
  89.   'Keep looping until we find a node.
  90.   While True
  91.     
  92.     'This is not a real heap.
  93.     For i = 0 To NodeHeapSize
  94.       If nodeHeap(i) < 0 Then
  95.         nodeHeap(i) = np
  96.         Exit Sub
  97.       End If
  98.     Next i
  99.     
  100.     'We ran out of space - allocate some more.
  101.     On Error GoTo addHeap_NoMemory
  102.     NodeHeapSize = NodeHeapSize + 256
  103.     ReDim Preserve nodeHeap(NodeHeapSize)
  104.     Dim j  'Here for speed.
  105.     For j = i To NodeHeapSize
  106.       nodeHeap(j) = -1
  107.     Next j
  108.     On Error GoTo 0
  109.     DoEvents
  110.     
  111.   Wend
  112.  
  113. addHeap_NoMemory:
  114.   Beep
  115.   MsgBox "Fatal Error - Not cannot allocate more internal heap space!", 16, gProgramTitle
  116.   End
  117. End Sub
  118.  
  119.  
  120.