Search Tools Links Login

Sort_TwoDimensionBubble


Sorts a 2-dimensional array

Original Author: Gordon Fuller

Inputs

TempArray Variant
iElement Integer
iDimension Integer
bAscOrder Boolean

Assumptions

Best used for smaller arrays, since the bubblesort algorithm is not suited to very large arrays

Returns

Boolean if the sort was successful

Code

'????????????????????????????????????????????????????????????
' Name:     Sort_TwoDimensionBubble
' VB Version:  6.00
' Called by:  Procedures     Events
'        ----------     ------
'
' Author:    Gordon McI. Fuller
' Copyright:  ?2000 Force 10 Automation
' Created:   Friday, March 17, 2000
' Modified:   [Friday, March 17, 2000]
' Purpose:
' Inputs:  Param    Name          Type    Meaning
'      -----    ----          ----    -------
'            TempArray        Variant
'      Optional  iElement        Integer
'      Optional  iDimension       Integer = 1
'      Optional  bAscOrder        Boolean = True
' Returns:   True/False for success of the sort
' Global Used:
' Module used:
'------------------------------------------------------------
' Notes:    This is a bubble sort
'        For large arrays it may not be the most efficient
'          option, but I haven't found anything in a
'          multi-dimension sort using another algorithm.
'
'  Sample array  array(0,0) = Apples
'          array(0,1) = 5
'          array(0,2) = Tree
'          array(1,0) = Grapes
'          ...
'      Apples     5    Tree
'      Grapes     2    Vine
'      Pears      3    Tree
'  The iDimension is 1 because it am sorting by the "rows" of the
'    first dimension rather than the "columns" of the 2nd
'  Since we would want to sort by the numeric value,
'    the iElement variable is 1
'  bAscOrder indicates whether the sort order is ascending or descending
'
'  If the array were structured as
'         array(0,0) = "Apples"
'         array(1,0) = 5
'         array(2,0) = Tree
'         ...
'      Apples     Grapes   Tree
'      5        2      3
'      Tree      Vine    Tree
'  iDimension will be 2 since we are sorting on the "columns"
'  iElement will still be 1 since we are sorting by that numeric value
'????????????????????????????????????????????????????????????
Function Sort_TwoDimensionBubble(TempArray As Variant, _
            Optional iElement As Integer = 1, _
            Optional iDimension As Integer = 1, _
            Optional bAscOrder As Boolean = True) As Boolean
  Dim arrTemp As Variant
  Dim i%, j%
  Dim NoExchanges As Integer
  On Error GoTo Error_BubbleSort
  ' Loop until no more "exchanges" are made.
  If iDimension% = 1 Then
    ReDim arrTemp(1, UBound(TempArray, 2))
  Else
    ReDim arrTemp(UBound(TempArray, 1), 1)
  End If
  
  Do
    NoExchanges = True
    ' Loop through each element in the array.
    If iDimension% = 1 Then
      For i% = LBound(TempArray, iDimension%) To UBound(TempArray, iDimension%) - 1
  
        ' If the element is greater than the element
        ' following it, exchange the two elements.
        If (bAscOrder And (TempArray(i%, iElement%) > TempArray(i% + 1, iElement%))) _
            Or (Not bAscOrder And (TempArray(i%, iElement%) < TempArray(i% + 1, iElement%))) _
          Then
            NoExchanges = False
            For j% = LBound(TempArray, 2) To UBound(TempArray, 2)
              arrTemp(1, j%) = TempArray(i%, j%)
            Next j%
            For j% = LBound(TempArray, 2) To UBound(TempArray, 2)
              TempArray(i%, j%) = TempArray(i% + 1, j%)
            Next j%
            For j% = LBound(TempArray, 2) To UBound(TempArray, 2)
              TempArray(i% + 1, j%) = arrTemp(1, j%)
            Next j%
        End If
      Next i%
    Else
      For i% = LBound(TempArray, iDimension%) To UBound(TempArray, iDimension%) - 1
  
        ' If the element is greater than the element
        ' following it, exchange the two elements.
        If (bAscOrder And (TempArray(iElement%, i%) > TempArray(iElement%, i% + 1))) _
            Or (Not bAscOrder And (TempArray(iElement%, i%) < TempArray(iElement%, i% + 1))) _
          Then
            NoExchanges = False
            For j% = LBound(TempArray, 1) To UBound(TempArray, 1)
              arrTemp(j%, 1) = TempArray(j%, i%)
            Next j%
            For j% = LBound(TempArray, 1) To UBound(TempArray, 1)
              TempArray(j%, i%) = TempArray(j%, i% + 1)
            Next j%
            For j% = LBound(TempArray, 1) To UBound(TempArray, 1)
              TempArray(j%, i% + 1) = arrTemp(j%, 1)
            Next j%
        End If
      Next i%
    End If
  Loop While Not (NoExchanges)
  Sort_TwoDimensionBubble = True
  On Error GoTo 0
  Exit Function
Error_BubbleSort:
  On Error GoTo 0
  Sort_TwoDimensionBubble = False
End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 92 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.