C/sorting.and.searching.cormen.algo/src/vsq2.txt

   1
   2 ' qsort
   3
   4 Public Sub QSort(ByRef A() As Variant, ByVal Lb As Long, ByVal Ub As Long)
   5     Dim lbStack(32) As Long
   6     Dim ubStack(32) As Long
   7     Dim sp As Long              ' stack pointer
   8     Dim lbx As Long             ' current lower-bound
   9     Dim ubx As Long             ' current upper-bound
  10     Dim m As Long
  11     Dim p As Long               ' index to pivot
  12     Dim i As Long
  13     Dim j As Long
  14     Dim t As Variant            ' temp used for exchanges
  15
  16     lbStack(0) = Lb
  17     ubStack(0) = Ub
  18     sp = 0
  19     Do While sp >= 0
  20         lbx = lbStack(sp)
  21         ubx = ubStack(sp)
  22
  23         Do While (lbx < ubx)
  24
  25             ' select pivot and exchange with 1st element
  26             p = lbx + (ubx - lbx) \ 2
  27
  28             ' exchange lbx, p
  29             t = A(lbx)
  30             A(lbx) = A(p)
  31             A(p) = t
  32
  33             ' partition into two segments
  34             i = lbx + 1
  35             j = ubx
  36             Do
  37                 Do While i < j
  38                     If A(lbx) <= A(i) Then Exit Do
  39                     i = i + 1
  40                 Loop
  41
  42                 Do While j >= i
  43                     If A(j) <= A(lbx) Then Exit Do
  44                     j = j - 1
  45                 Loop
  46
  47                 If i >= j Then Exit Do
  48
  49                 ' exchange i, j
  50                 t = A(i)
  51                 A(i) = A(j)
  52                 A(j) = t
  53
  54                 j = j - 1
  55                 i = i + 1
  56             Loop
  57
  58             ' pivot belongs in A[j]
  59             ' exchange lbx, j
  60             t = A(lbx)
  61             A(lbx) = A(j)
  62             A(j) = t
  63
  64             m = j
  65
  66             ' keep processing smallest segment, and stack largest
  67             If m - lbx <= ubx - m Then
  68                 If m + 1 < ubx Then
  69                     lbStack(sp) = m + 1
  70                     ubStack(sp) = ubx
  71                     sp = sp + 1
  72                 End If
  73                 ubx = m - 1
  74             Else
  75                 If m - 1 > lbx Then
  76                     lbStack(sp) = lbx
  77                     ubStack(sp) = m - 1
  78                     sp = sp + 1
  79                 End If
  80                 lbx = m + 1
  81             End If
  82         Loop
  83         sp = sp - 1
  84     Loop
  85 End Sub