See the Tirupati Post....
I am coming up with different Sorting Techniques and hope this might
help you in the future.
Function fSortArray(aSortThisArray)
Set oArrayList = CreateObject("System.Collections.ArrayList" )
For iElement = 0 To UBound(aSortThisArray)
oArrayList.Add aSortThisArray(iElement)
Next
oArrayList.Sort
Set fSortArray = oArrayList
Set oArrayList = Nothing
End Function
Dim arrSortOut(9)
Dim tmp(9)
arrSortOut(0) = "Seenu"
arrSortOut(1) = "xerox"
arrSortOut(2) = "yours lovingly"
arrSortOut(3) = "Honesty is the best policy"
arrSortOut(4) = "Sing Sang Sung "
arrSortOut(5) = "!what why when"
arrSortOut(6) = "!HOW ARE YOU"
arrSortOut(7) = "Khaleja"
arrSortOut(8) = "dil ki dhadkan"
arrSortOut(9) = "seenu"
Print VbCrLf & "The Actual Array Before Sorting: " & VbCrLf
For x=0 to 8
Print arrSortOut(x)
Next
For i = UBound(arrSortOut) - 1 To 0 Step -1
For j= 0 To i
'If arrSortOut(j) > arrSortOut(j+1) Then
If StrComp(arrSortOut(j),arrSortOut(j+1),1) = 1 Then
temp = arrSortOut(j+1)
arrSortOut(j+1) = arrSortOut(j)
arrSortOut(j) = temp
End If
Next
Next
Print VbCrLf & "Normal Sorting Method: " & VbCrLf
For x = LBound(arrSortOut) To UBound(arrSortOut)
Print arrSortOut(x)
Next
Public Sub bubbleSort( ByRef arr)
Dim i, j, tmp
Services.StartTransaction "BubbleSort"
For i = ( UBound( arr ) - 1 ) To 0 Step -1
For j = 0 to i
' If arr( j ) > arr( j + 1 ) Then
' tmp = arr( j + 1 )
' arr( j + 1 ) = arr( j )
' arr( j ) = tmp
' End If
If StrComp(arr( j ),arr( j + 1 ),1) = 1 Then
tmp = arr( j + 1 )
arr( j + 1 ) = arr( j )
arr( j ) = tmp
End If
Next
Next
Services.EndTransaction "BubbleSort"
End Sub
'Print VbCrLf & "ArrayList Sorting Method: " & VbCrLf
'Set dList = fSortArray(arrSortOut)
'For Each strItem in dList
' Print strItem
'Next
Print VbCrLf & "Bubble Sorting Method: " & VbCrLf
Call bubbleSort(arrSortOut)
For x = LBound(arrSortOut) To UBound(arrSortOut)
Print arrSortOut(x)
Next
Public Sub MergeSort( ByRef arr, ByRef temp, ByVal nFirstIndex, ByVal
nLastIndex )
Dim nMiddle
If nLastIndex > nFirstIndex Then
' ** Recursively sort the two halves of the list.
nMiddle = ( nFirstIndex + nLastIndex ) \ 2
Call MergeSort( arr, temp, nFirstIndex, nMiddle )
Call MergeSort( arr, temp, nMiddle + 1, nLastIndex )
' ** Merge the results.
Call Merge( arr, temp, nFirstIndex, nMiddle + 1, nLastIndex )
End If
End Sub
Print VbCrLf & "Merge Sorting Method: " & VbCrLf
intFirstIndex = LBound(arrSortOut)
intLastIndex = UBound(arrSortOut)
Call MergeSort(arrSortOut, tmp, intFirstIndex, intLastIndex )
For x = LBound(arrSortOut) To UBound(arrSortOut)
Print arrSortOut(x)
Next
Private Sub Merge( ByRef arr(), ByRef temp(), ByVal nLeft, ByVal
nMiddle, ByVal nRight )
Dim i, left_end, num_elements, tmp_pos
left_end = nMiddle - 1
tmp_pos = nLeft
num_elements = nRight - nLeft + 1
' Do While( nLeft <= left_end ) And ( nMiddle <= nRight )
' If arr( nLeft ) <= arr ( nMiddle ) Then
' temp( tmp_pos ) = arr( nLeft )
' tmp_pos = tmp_pos + 1
' nLeft = nLeft + 1
' Else
' temp( tmp_pos ) = arr( nMiddle )
' tmp_pos = tmp_pos + 1
' nMiddle = nMiddle + 1
' End If
' Loop
Do While( nLeft <= left_end ) And ( nMiddle <= nRight )
If StrComp(arr( nLeft ), arr ( nMiddle ),1) <= 0 Then
temp( tmp_pos ) = arr( nLeft )
tmp_pos = tmp_pos + 1
nLeft = nLeft + 1
Else
temp( tmp_pos ) = arr( nMiddle )
tmp_pos = tmp_pos + 1
nMiddle = nMiddle + 1
End If
Loop
Do While nLeft <= left_end
temp( tmp_pos ) = arr( nLeft )
nLeft = nLeft + 1
tmp_pos = tmp_pos + 1
Loop
Do While nMiddle <= nRight
temp( tmp_pos ) = arr( nMiddle )
nMiddle = nMiddle + 1
tmp_pos = tmp_pos + 1
Loop
For i = 0 To num_elements - 1
arr( nRight ) = temp( nRight )
nRight = nRight - 1
Next
End Sub
Public Sub QuickSortArray( ByRef arr, ByVal nLow, ByVal nHigh )
Dim pivot, tmpSwap, tmpLow, tmpHigh
tmpLow = nLow
tmpHigh = nHigh
pivot = arr( ( nLow + nHigh ) / 2 )
Do While tmpLow <= tmpHigh
'Do While( arr( tmpLow ) < pivot And tmpLow < nHigh )
Do While( StrComp(arr( tmpLow ),pivot,1) = -1 And tmpLow <
nHigh )
tmpLow = tmpLow + 1
Loop
'Do While( pivot < arr( tmpHigh ) And tmpHigh > nLow )
Do While(StrComp(pivot,arr( tmpHigh ),1) = -1 And tmpHigh >
nLow )
tmpHigh = tmpHigh - 1
Loop
If tmpLow <= tmpHigh Then
tmpSwap = arr( tmpLow )
arr( tmpLow ) = arr( tmpHigh )
arr( tmpHigh ) = tmpSwap
tmpLow = tmpLow + 1
tmpHigh = tmpHigh - 1
End If
Loop
If nLow < tmpHigh Then Call QuickSortArray( arr, nLow, tmpHigh )
If tmpLow < nHigh Then Call QuickSortArray( arr, tmpLow, nHigh )
End Sub
Print VbCrLf & "QuickSort Sorting Method: " & VbCrLf
intLow = LBound(arrSortOut)
intHigh = UBound(arrSortOut)
Call QuickSortArray(arrSortOut, intLow, intHigh )
For x = LBound(arrSortOut) To UBound(arrSortOut)
Print arrSortOut(x)
Next
Public Sub heapSort( ByRef arr)
Dim i, temp, arrSize
arrSize = UBound( arr ) + 1
For i = ( arrSize / 2 ) - 1 To 0 Step - 1
Call siftDown( arr, i, arrSize )
Next
For i = arrSize - 1 To 1 Step - 1
temp = arr( 0 )
arr( 0 ) = arr( i )
arr( i ) = temp
Call siftDown( arr, 0, i - 1 )
Next
End Sub
Print VbCrLf & "HeapSort Sorting Method: " & VbCrLf
Call heapSort(arrSortOut)
For x = LBound(arrSortOut) To UBound(arrSortOut)
Print arrSortOut(x)
Next
Private Sub siftDown( ByRef arr, ByVal root, ByVal bottom )
Dim done, maxChild, temp
done = 0
On Error Resume Next
Do While( root * 2 <= bottom ) And ( Not done )
If root * 2 = bottom Then
maxChild = root * 2
'ElseIf arr( root * 2 ) > arr( root * 2 + 1 ) Then
ElseIf StrComp(arr( root * 2 ),arr( root * 2 + 1 ),1) = 1 Then
maxChild = root * 2
Else
maxChild = root * 2 + 1
End If
'If arr( root ) < arr( maxChild ) Then
If StrComp(arr( root ),arr(maxChild),1) = -1 Then
temp = arr( root )
arr( root ) = arr( maxChild )
arr( maxChild ) = temp
root = maxChild
Else
done = True
End If
Loop
On Error GoTo 0
End Sub
Print VbCrLf & "ArrayList Sorting Method: " & VbCrLf
Set dList = fSortArray(arrSortOut)
For Each strItem In dList
Print strItem
Next
' Sorting an Array with System.Collections.ArrayList Object
Set DataList = CreateObject("System.Collections.ArrayList")
' Add the items in the Object
DataList.Add "A"
DataList.Add "E"
DataList.Add "D"
DataList.Add "F"
DataList.Add "B"
DataList.Add "C"
' Sort the Array using Sort Method
DataList.Sort()
' Reversing the Sorted List
DataList.Reverse()
Print VbCrLf & "2nd Array Sorting List in Reverse: " & VbCrLf
For Each strItem in DataList
Print strItem
Next
I will keep you posted.
Happy Learning.....
--
Regards and Thanks,
Tirupati. J
"Coming together is a beginning, Keeping together is progress, Working
together is success."
YOU ARE WHAT YOU WISH TO BE.
On 7/3/11, Roman Zilber <[email protected]> wrote:
> maybe the the values in ARR1 are not not unique?
>
> On Sat, Jul 2, 2011 at 6:20 AM, Shalabh Dixit
> <[email protected]>wrote:
>
>> Hi All,
>>
>> I'm facing one strange problem.
>>
>> I'm storing the two arrays ARR1 and ARR2 into the DICTIONARY as keys
>> and values respectively. i.e.I'm storing ARR1 as KEYS and ARR2 as
>> ITEMS
>>
>> both arrays contains same number of items i.e. 75
>>
>> Set objDict = CreateObject("Scripting.Dictionary")
>> For tb = 0 To UBound(ARR1)
>> objDict.Add ARR1(tb),ARR2(tb)
>> Next
>>
>> Now the dictionary is just storing 45 elements only of both the arrays
>> instead of complete 75.
>>
>> Thanks in anticipation.
>>
>> --
>> You received this message because you are subscribed to the Google
>> "QTP - HP Quick Test Professional - Automated Software Testing"
>> group.
>> To post to this group, send email to [email protected]
>> To unsubscribe from this group, send email to
>> [email protected]
>> For more options, visit this group at
>> http://groups.google.com/group/MercuryQTP?hl=en
>
> --
> You received this message because you are subscribed to the Google
> "QTP - HP Quick Test Professional - Automated Software Testing"
> group.
> To post to this group, send email to [email protected]
> To unsubscribe from this group, send email to
> [email protected]
> For more options, visit this group at
> http://groups.google.com/group/MercuryQTP?hl=en
--
Happy Tester,
Byzoor,
+91 95977 11082
--
You received this message because you are subscribed to the Google
"QTP - HP Quick Test Professional - Automated Software Testing"
group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/MercuryQTP?hl=en
