Quick And Dirty Asp Array Sorting

or How I stopped worrying and hacked someone else's code.

One of the most frustrating non-options with VB Scripting is the inability to sort arrays. If you've rolled your own, most people opt for the bubble sort method. This works great until you have a medium to large array. Then it becomes horribly inefficient.

On the 4 Guys From Rolla web site, they have a nifty ASP function published called Quick Sort that can handle multi-dimensional sorting. It's based on the algorithm given in Data Abstractions & Structures using C++ by Mark Headington and David Riley, (pg. 586).

The 4 Guys From Rolla QuickSort is very nice, but has a few short comings. One: It does not offer an option for Ascending/Descending Sorting. Two: It does string compares for all field comparisons. Three: You must have the array structured as Row,Column which is backwards from how ADO returns an array via the getRows function. [rant]MvHO it's ADO that returns the array backwards. Why couldn't MS offer both ways if there was a need to "maintain backwards compatibility" with a historically fubarred thought process??[/rant]

Anywho - I hacked the 4 Guys From Rolla Quick Sort routine (it's nice to be able to stand on the shoulders of giants) to support sorting direction as well as embedded a function that checks to see if the two fields being compared can both be evaluated as Numeric or as Strings (default) and "cloned" the QuickSort routine for the ADO way of array thinking.

The only thing lacking now with QuickSortv2 and QuickSortv2_ADO is a second column sort - but I'll leave that to someone better qualified to implement. ;-)

To utilize the Quick Sort routines, call it this way:

QuickSortADO vec, loBound, hiBound, SortField, SortDir

QuickSort vec, loBound, hiBound, SortField, SortDir

Parameters:

• vec - array to be sorted
  
  
• loBound &
• hiBound - are simply the upper and lower bounds of the array's "row" dimension. [ADO = UBound(vec,2), Regular = UBound(vec,1)] It's probably easiest to use the LBound and UBound functions to set these.
  
  
• SortField - The field to sort on (1st dimension value)
  
  
• SortDir - ASC, ascending; DESC, descending

Note: The PrintArray and PrintArrayADO are quick and dirty functions to print out your array in a table structure to quickly evaluate the sorting routine. So at minimum you need three functions: QuickSortADO, SwapRowsADO, and FormatCompare and/or QuickSort, SwapRows, and FormatCompare. Obviously you only need one copy of FormatCompare if you want both QuickSort routines in your library.

***Quick Sort v2***

''' Regular Array Sort
Sub QuickSort(vec,loBound,hiBound,SortField,SortDir)
  '==--------------------------------------------------------==
  '== Sort a multi dimensional array on SortField            ==
  '==                                                        ==
  '== This procedure is adapted from the algorithm given in: ==
  '==    ~ Data Abstractions & Structures using C++ by ~     ==
  '==    ~ Mark Headington and David Riley, pg. 586    ~     ==
  '== Quicksort is the fastest array sorting routine for     ==
  '== unordered arrays.  Its big O is n log n                ==
  '==                                                        ==
  '== Parameters:                                            ==
  '== vec       - array to be sorted                         ==
  '== SortField - The field to sort on (1st dimension value) ==
  '== loBound and hiBound are simply the upper and lower     ==
  '==   bounds of the array's "row" dimension. It's probably ==
  '==   easiest to use the LBound and UBound functions to    ==
  '==   set these.                                           ==
  '== SortDir   - ASC, ascending; DESC, Descending           ==
  '==--------------------------------------------------------==
  if not (hiBound - loBound = 0) then
      Dim pivot(),loSwap,hiSwap,temp,counter
      Redim pivot (Ubound(vec,2))
      SortDir = UCase(SortDir)
      '== Two items to sort
      if hiBound - loBound = 1 then
        if (SortDir = "ASC") then
            if FormatCompare(vec(loBound,SortField),vec(hiBound,SortField)) > FormatCompare(vec(hiBound,SortField),vec(loBound,SortField)) then Call SwapRows(vec,hiBound,loBound)
        else
            if FormatCompare(vec(loBound,SortField),vec(hiBound,SortField)) < FormatCompare(vec(hiBound,SortField),vec(loBound,SortField)) then Call SwapRows(vec,hiBound,loBound)
        end if
      End If
      '== Three or more items to sort
      For counter = 0 to Ubound(vec,2)
        pivot(counter) = vec(int((loBound + hiBound) / 2),counter)
        vec(int((loBound + hiBound) / 2),counter) = vec(loBound,counter)
        vec(loBound,counter) = pivot(counter)
      Next
      loSwap = loBound + 1
      hiSwap = hiBound
      do
        '== Find the right loSwap
        if (SortDir = "ASC") then
            while loSwap < hiSwap and FormatCompare(vec(loSwap,SortField),pivot(SortField)) <= FormatCompare(pivot(SortField),vec(loSwap,SortField))
              loSwap = loSwap + 1
            wend
        else
            while loSwap < hiSwap and FormatCompare(vec(loSwap,SortField),pivot(SortField)) >= FormatCompare(pivot(SortField),vec(loSwap,SortField))
              loSwap = loSwap + 1
            wend
        end if
        '== Find the right hiSwap
        if (SortDir = "ASC") then
            while FormatCompare(vec(hiSwap,SortField),pivot(SortField)) > FormatCompare(pivot(SortField),vec(hiSwap,SortField))
              hiSwap = hiSwap - 1
            wend
        else
            while FormatCompare(vec(hiSwap,SortField),pivot(SortField)) < FormatCompare(pivot(SortField),vec(hiSwap,SortField))
              hiSwap = hiSwap - 1
            wend
        end if
        '== Swap values if loSwap is less then hiSwap
        if loSwap < hiSwap then Call SwapRows(vec,loSwap,hiSwap)
      loop while loSwap < hiSwap
      For counter = 0 to Ubound(vec,2)
        vec(loBound,counter) = vec(hiSwap,counter)
        vec(hiSwap,counter) = pivot(counter)
      Next
      '== Recursively call function .. the beauty of Quicksort
        '== 2 or more items in first section
        if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1,SortField,SortDir)
        '== 2 or more items in second section
        if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound,SortField,SortDir)
  end if
End Sub  'QuickSort
Sub SwapRows(ary,row1,row2)
  '==------------------------------------------==
  '== This proc swaps two rows of an array     ==
  '==------------------------------------------==
  Dim x,tempvar
  For x = 0 to Ubound(ary,2)
    tempvar = ary(row1,x)
    ary(row1,x) = ary(row2,x)
    ary(row2,x) = tempvar
  Next
End Sub  'SwapRows
function FormatCompare(sOne,sTwo)
  '==------------------------------------------==
  '==  Checks sOne & sTwo, returns sOne as a   ==
  '==  Numeric if both pass isNumeric, if not  ==
  '==  returns sOne as a string.               ==
  '==------------------------------------------==
    if (isNumeric(Trim(sOne)) AND isNumeric(Trim(sTwo))) then
        FormatCompare = CDbl(Trim(sOne))
    else
        FormatCompare = Trim(sOne)
    end if
end function
Sub PrintArray(vec,loRow,hiRow,markCol)
  '==------------------------------------------==
  '== Print out an array  Highlight the column ==
  '==  whose number matches param markCol      ==
  '==------------------------------------------==
  Dim ColNmbr,RowNmbr
  Response.Write "<table border=""1"" cellspacing=""0"">"
  For RowNmbr = loRow to hiRow
    Response.Write "<tr>"
    For ColNmbr = 0 to (Ubound(vec,2) - 1)
      If ColNmbr = markCol then
        Response.Write "<td bgcolor=""FFFFCC"">"
      Else
        Response.Write "<td>"
      End If
      Response.Write vec(RowNmbr,ColNmbr) & "</td>"
    Next
    Response.Write "</tr>"
  Next
  Response.Write "</table>"
End Sub  'PrintArray

***Quick Sort v2 ADO***

''' ADO Array Sort
Sub QuickSortADO(vec,loBound,hiBound,SortField,SortDir)
  '==--------------------------------------------------------==
  '== Sort a multi dimensional array on SortField            ==
  '==                                                        ==
  '== This procedure is adapted from the algorithm given in: ==
  '==    ~ Data Abstractions & Structures using C++ by ~     ==
  '==    ~ Mark Headington and David Riley, pg. 586    ~     ==
  '== Quicksort is the fastest array sorting routine for     ==
  '== unordered arrays.  Its big O is n log n                ==
  '==                                                        ==
  '== Parameters:                                            ==
  '== vec       - array to be sorted                         ==
  '== SortField - The field to sort on (1st dimension value) ==
  '== loBound and hiBound are simply the upper and lower     ==
  '==   bounds of the array's "row" dimension. It's probably ==
  '==   easiest to use the LBound and UBound functions to    ==
  '==   set these.                                           ==
  '== SortDir   - ASC, ascending; DESC, Descending           ==
  '==--------------------------------------------------------==
  if not (hiBound - loBound = 0) then
      Dim pivot(),loSwap,hiSwap,temp,counter
      Redim pivot (Ubound(vec,1))
      SortDir = UCase(SortDir)
      '== Two items to sort
      if hiBound - loBound = 1 then
        if (SortDir = "ASC") then
            if FormatCompare(vec(SortField,loBound),vec(SortField,hiBound)) > FormatCompare(vec(SortField,hiBound),vec(SortField,loBound)) then Call SwapRowsADO(vec,hiBound,loBound)
        else
            if FormatCompare(vec(SortField,loBound),vec(SortField,hiBound)) < FormatCompare(vec(SortField,hiBound),vec(SortField,loBound)) then Call SwapRowsADO(vec,hiBound,loBound)
        end if
      End If
      '== Three or more items to sort
      For counter = 0 to Ubound(vec,1)
        pivot(counter) = vec(counter,int((loBound + hiBound) / 2))
        vec(counter,int((loBound + hiBound) / 2)) = vec(counter,loBound)
        vec(counter,loBound) = pivot(counter)
      Next
      loSwap = loBound + 1
      hiSwap = hiBound
      do
        '== Find the right loSwap
        if (SortDir = "ASC") then
            while loSwap < hiSwap and FormatCompare(vec(SortField,loSwap),pivot(SortField)) <= FormatCompare(pivot(SortField),vec(SortField,loSwap))
              loSwap = loSwap + 1
            wend
        else
            while loSwap < hiSwap and FormatCompare(vec(SortField,loSwap),pivot(SortField)) >= FormatCompare(pivot(SortField),vec(SortField,loSwap))
              loSwap = loSwap + 1
            wend
        end if
        '== Find the right hiSwap
        if (SortDir = "ASC") then
            while FormatCompare(vec(SortField,hiSwap),pivot(SortField)) > FormatCompare(pivot(SortField),vec(SortField,hiSwap))
              hiSwap = hiSwap - 1
            wend
        else
            while FormatCompare(vec(SortField,hiSwap),pivot(SortField)) < FormatCompare(pivot(SortField),vec(SortField,hiSwap))
              hiSwap = hiSwap - 1
            wend
        end if
        '== Swap values if loSwap is less then hiSwap
        if loSwap < hiSwap then Call SwapRowsADO(vec,loSwap,hiSwap)
      loop while loSwap < hiSwap
      For counter = 0 to Ubound(vec,1)
        vec(counter,loBound) = vec(counter,hiSwap)
        vec(counter,hiSwap) = pivot(counter)
      Next
      '== Recursively call function .. the beauty of Quicksort
        '== 2 or more items in first section
        if loBound < (hiSwap - 1) then Call QuickSortADO(vec,loBound,hiSwap-1,SortField,SortDir)
        '== 2 or more items in second section
        if hiSwap + 1 < hibound then Call QuickSortADO(vec,hiSwap+1,hiBound,SortField,SortDir)
  end if
End Sub  'QuickSortADO
Sub SwapRowsADO(ary,row1,row2)
  '==------------------------------------------==
  '== This proc swaps two rows of an array     ==
  '==------------------------------------------==
  Dim x,tempvar
  For x = 0 to Ubound(ary,1)
    tempvar = ary(x,row1)
    ary(x,row1) = ary(x,row2)
    ary(x,row2) = tempvar
  Next
End Sub  'SwapRowsADO
function FormatCompare(sOne,sTwo)
  '==------------------------------------------==
  '==  Checks sOne & sTwo, returns sOne as a   ==
  '==  Numeric if both pass isNumeric, if not  ==
  '==  returns sOne as a string.               ==
  '==------------------------------------------==
    if (isNumeric(Trim(sOne)) AND isNumeric(Trim(sTwo))) then
        FormatCompare = CDbl(Trim(sOne))
    else
        FormatCompare = Trim(sOne)
    end if
end function
Sub PrintArrayADO(vec,loRow,hiRow,markCol)
  '==------------------------------------------==
  '== Print out an array  Highlight the column ==
  '==  whose number matches param markCol      ==
  '==------------------------------------------==
  Dim ColNmbr,RowNmbr
  Response.Write "<table border=""1"" cellspacing=""0"">"
  For RowNmbr = loRow to hiRow
    Response.Write "<tr>"
    For ColNmbr = 0 to Ubound(vec,1)
      If ColNmbr = markCol then
        Response.Write "<td bgcolor=""FFFFCC"">"
      Else
        Response.Write "<td>"
      End If
      Response.Write vec(ColNmbr,RowNmbr) & "</td>"
    Next
    Response.Write "</tr>"
  Next
  Response.Write "</table>"
End Sub  'PrintArray