musclejack
asked on
Additional question from http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20823568.html
Can someone show me the ASP version of this:
-------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
Option Explicit
Private Sub Command1_Click()
Dim arrMeng As Variant
Dim i As Integer
Dim strMeng As String
arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")
QuickSort arrMeng
strMeng = ""
For i = 0 To UBound(arrMeng)
strMeng = strMeng & arrMeng(i) & vbTab
Next i
MsgBox strMeng
End Sub
Sub QuickSort(arr As Variant, Optional numEls As Variant, _Optional descending As Boolean)
Dim value As Variant, temp As Variant
Dim sp As Integer
Dim leftStk(32) As Long, rightStk(32) As Long
Dim leftNdx As Long, rightNdx As Long
Dim i As Long, j As Long
Dim k As Long
Dim strPrevious As String
Dim strCurrent As String
Dim colTemp As Collection
' account for optional arguments
If IsMissing(numEls) Then numEls = UBound(arr)
' init pointers
leftNdx = LBound(arr)
rightNdx = numEls
' init stack
sp = 1
leftStk(sp) = leftNdx
rightStk(sp) = rightNdx
Do
If rightNdx > leftNdx Then
value = arr(rightNdx)
i = leftNdx - 1
j = rightNdx
' find the pivot item
If descending Then
Do
Do: i = i + 1: Loop Until arr(i) <= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) >= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
Else
Do
Do: i = i + 1: Loop Until arr(i) >= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) <= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
End If
' swap found items
temp = arr(j)
arr(j) = arr(i)
arr(i) = arr(rightNdx)
arr(rightNdx) = temp
' push on the stack the pair of pointers that differ most
sp = sp + 1
If (i - leftNdx) > (rightNdx - i) Then
leftStk(sp) = leftNdx
rightStk(sp) = i - 1
leftNdx = i + 1
Else
leftStk(sp) = i + 1
rightStk(sp) = rightNdx
rightNdx = i - 1
End If
Else
' pop a new pair of pointers off the stacks
leftNdx = leftStk(sp)
rightNdx = rightStk(sp)
sp = sp - 1
If sp = 0 Then Exit Do
End If
Loop
Set colTemp = New Collection
strPrevious = ""
For k = 0 To UBound(arr)
strCurrent = arr(k)
If strCurrent = strPrevious Then
Else
colTemp.Add strCurrent
End If
strPrevious = strCurrent
Next k
ReDim arr(colTemp.Count)
For k = 1 To colTemp.Count
strCurrent = colTemp.Item(k)
arr(k - 1) = strCurrent
Next k
End Sub
--------------------------
Option Explicit
Private Sub Command1_Click()
Dim arrMeng As Variant
Dim i As Integer
Dim strMeng As String
arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")
QuickSort arrMeng
strMeng = ""
For i = 0 To UBound(arrMeng)
strMeng = strMeng & arrMeng(i) & vbTab
Next i
MsgBox strMeng
End Sub
Sub QuickSort(arr As Variant, Optional numEls As Variant, _Optional descending As Boolean)
Dim value As Variant, temp As Variant
Dim sp As Integer
Dim leftStk(32) As Long, rightStk(32) As Long
Dim leftNdx As Long, rightNdx As Long
Dim i As Long, j As Long
Dim k As Long
Dim strPrevious As String
Dim strCurrent As String
Dim colTemp As Collection
' account for optional arguments
If IsMissing(numEls) Then numEls = UBound(arr)
' init pointers
leftNdx = LBound(arr)
rightNdx = numEls
' init stack
sp = 1
leftStk(sp) = leftNdx
rightStk(sp) = rightNdx
Do
If rightNdx > leftNdx Then
value = arr(rightNdx)
i = leftNdx - 1
j = rightNdx
' find the pivot item
If descending Then
Do
Do: i = i + 1: Loop Until arr(i) <= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) >= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
Else
Do
Do: i = i + 1: Loop Until arr(i) >= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) <= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
End If
' swap found items
temp = arr(j)
arr(j) = arr(i)
arr(i) = arr(rightNdx)
arr(rightNdx) = temp
' push on the stack the pair of pointers that differ most
sp = sp + 1
If (i - leftNdx) > (rightNdx - i) Then
leftStk(sp) = leftNdx
rightStk(sp) = i - 1
leftNdx = i + 1
Else
leftStk(sp) = i + 1
rightStk(sp) = rightNdx
rightNdx = i - 1
End If
Else
' pop a new pair of pointers off the stacks
leftNdx = leftStk(sp)
rightNdx = rightStk(sp)
sp = sp - 1
If sp = 0 Then Exit Do
End If
Loop
Set colTemp = New Collection
strPrevious = ""
For k = 0 To UBound(arr)
strCurrent = arr(k)
If strCurrent = strPrevious Then
Else
colTemp.Add strCurrent
End If
strPrevious = strCurrent
Next k
ReDim arr(colTemp.Count)
For k = 1 To colTemp.Count
strCurrent = colTemp.Item(k)
arr(k - 1) = strCurrent
Next k
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
musclejack,
this is not exactly a VB question. I couldn't exactly understand what you wanted. However, i referred to the other question mentioned in your link and understood what you wanted.
i have provided some ASP code which removes duplicates and then sorts the array for you. while copying the code, copy the below into notepad and then into your asp editor.
just copy paste as it is and try it.
cheers,
srimanth.
--------------------------
<%@ Language="VBScript" %>
<%
Function Sort(arrTemp, nFirstIndex, nLastIndex)
Dim strTemp, strIndex, nBegin, nEnd
If (nFirstIndex - nFirstIndex) = 1 Then
If (arrTemp(nFirstIndex) > arrTemp(nLastIndex)) Then
strTemp = arrTemp(nFirstIndex)
arrTemp(nFirstIndex) = arrTemp(nLastIndex)
arrTemp(nLastIndex) = strTemp
End If
End If
strIndex = arrTemp(Int((nFirstIndex + nLastIndex) / 2))
arrTemp(Int((nFirstIndex + nLastIndex) / 2)) = arrTemp(nFirstIndex)
arrTemp(nFirstIndex) = strIndex
nBegin = nFirstIndex + 1
nEnd = nLastIndex
Do
While ((nBegin < nEnd) And (arrTemp(nBegin) <= strIndex))
nBegin = nBegin + 1
Wend
While (arrTemp(nEnd) > strIndex)
nEnd = nEnd - 1
Wend
If (nBegin < nEnd) Then
strTemp = arrTemp(nBegin)
arrTemp(nBegin) = arrTemp(nEnd)
arrTemp(nEnd) = strTemp
End If
Loop While (nBegin < nEnd)
arrTemp(nFirstIndex) = arrTemp(nEnd)
arrTemp(nEnd) = strIndex
If (nFirstIndex < (nEnd - 1)) Then Sort arrTemp, nFirstIndex, nEnd - 1
If ((nEnd + 1) < nLastIndex) Then Sort arrTemp, nEnd + 1, nLastIndex
End Function
Function RemoveDuplicates(arrTemp, nFirstIndex, nLastIndex)
Dim objDictionary, nIndex, strTemp
Set objDictionary = Server.CreateObject("Scrip ting.Dicti onary")
For i = nFirstIndex to nLastIndex
If (Not objDictionary.Exists(arrTe mp(i))) Then objDictionary.Add arrTemp(i), arrTemp(i)
Next
nIndex = 0
Redim Preserve arrTemp(objDictionary.Coun t)
For Each strTemp in objDictionary
arrTemp(nIndex) = strTemp
nIndex = nIndex + 1
Next
Set objDictionary = Nothing
End Function
Function DisplayArray(arrTemp, nFirstIndex, nLastIndex)
Dim i
For i = nFirstIndex to nLastIndex
Response.Write arrTemp(i) & "<br>"
Next
End Function
'Main Code
Dim arrNames()
Redim arrNames(10)
arrNames(0) = "zero"
arrNames(1) = "one"
arrNames(2) = "two"
arrNames(3) = "three"
arrNames(4) = "four"
arrNames(5) = "five"
arrNames(6) = "one"
arrNames(7) = "two"
arrNames(8) = "three"
arrNames(9) = "four"
Response.Write "<b>Unsorted & Duplicates Array</b><br>"
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1
Response.Write "<br><b>Unsorted & Unique Array</b><br>"
RemoveDuplicates arrNames, LBound(arrNames), UBound(arrNames) - 1
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1
Response.Write "<br><b>Sorted & Unique Array</b><br>"
Sort arrNames, LBound(arrNames), UBound(arrNames) - 1
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1
%>
this is not exactly a VB question. I couldn't exactly understand what you wanted. However, i referred to the other question mentioned in your link and understood what you wanted.
i have provided some ASP code which removes duplicates and then sorts the array for you. while copying the code, copy the below into notepad and then into your asp editor.
just copy paste as it is and try it.
cheers,
srimanth.
--------------------------
<%@ Language="VBScript" %>
<%
Function Sort(arrTemp, nFirstIndex, nLastIndex)
Dim strTemp, strIndex, nBegin, nEnd
If (nFirstIndex - nFirstIndex) = 1 Then
If (arrTemp(nFirstIndex) > arrTemp(nLastIndex)) Then
strTemp = arrTemp(nFirstIndex)
arrTemp(nFirstIndex) = arrTemp(nLastIndex)
arrTemp(nLastIndex) = strTemp
End If
End If
strIndex = arrTemp(Int((nFirstIndex + nLastIndex) / 2))
arrTemp(Int((nFirstIndex + nLastIndex) / 2)) = arrTemp(nFirstIndex)
arrTemp(nFirstIndex) = strIndex
nBegin = nFirstIndex + 1
nEnd = nLastIndex
Do
While ((nBegin < nEnd) And (arrTemp(nBegin) <= strIndex))
nBegin = nBegin + 1
Wend
While (arrTemp(nEnd) > strIndex)
nEnd = nEnd - 1
Wend
If (nBegin < nEnd) Then
strTemp = arrTemp(nBegin)
arrTemp(nBegin) = arrTemp(nEnd)
arrTemp(nEnd) = strTemp
End If
Loop While (nBegin < nEnd)
arrTemp(nFirstIndex) = arrTemp(nEnd)
arrTemp(nEnd) = strIndex
If (nFirstIndex < (nEnd - 1)) Then Sort arrTemp, nFirstIndex, nEnd - 1
If ((nEnd + 1) < nLastIndex) Then Sort arrTemp, nEnd + 1, nLastIndex
End Function
Function RemoveDuplicates(arrTemp, nFirstIndex, nLastIndex)
Dim objDictionary, nIndex, strTemp
Set objDictionary = Server.CreateObject("Scrip
For i = nFirstIndex to nLastIndex
If (Not objDictionary.Exists(arrTe
Next
nIndex = 0
Redim Preserve arrTemp(objDictionary.Coun
For Each strTemp in objDictionary
arrTemp(nIndex) = strTemp
nIndex = nIndex + 1
Next
Set objDictionary = Nothing
End Function
Function DisplayArray(arrTemp, nFirstIndex, nLastIndex)
Dim i
For i = nFirstIndex to nLastIndex
Response.Write arrTemp(i) & "<br>"
Next
End Function
'Main Code
Dim arrNames()
Redim arrNames(10)
arrNames(0) = "zero"
arrNames(1) = "one"
arrNames(2) = "two"
arrNames(3) = "three"
arrNames(4) = "four"
arrNames(5) = "five"
arrNames(6) = "one"
arrNames(7) = "two"
arrNames(8) = "three"
arrNames(9) = "four"
Response.Write "<b>Unsorted & Duplicates Array</b><br>"
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1
Response.Write "<br><b>Unsorted & Unique Array</b><br>"
RemoveDuplicates arrNames, LBound(arrNames), UBound(arrNames) - 1
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1
Response.Write "<br><b>Sorted & Unique Array</b><br>"
Sort arrNames, LBound(arrNames), UBound(arrNames) - 1
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1
%>
musclejack,
did u try the code i provided? All u have to do is to copy paste the code and try it in your browser. the method provided is quick sort which is very fast for bigger data.
cheers,
srimanth.
did u try the code i provided? All u have to do is to copy paste the code and try it in your browser. the method provided is quick sort which is very fast for bigger data.
cheers,
srimanth.
' Create an instance of the recordset
Set RS = Server.CreateObjct("ADODB.
With RS
' prime for use in disconnected mode
Set .ActiveConnection = Nothing
.CursorLocation = adUseClient ' you need to import the ADODB ASP declarations for this to work
.LockType = adLockBatchOptimistic
' Create columns in your record
With .Fields
.Append "Team", adVarChar, 100
.Append "Priority", adSmallInt
End With
End With
' first open the recordset
RS.Open
' create some test data
RS.AddNew
RS("Team") = "Ford"
RS("Priority") = 2
RS.Update
' create some test data
RS.AddNew
RS("Team") = "BBC"
RS("Priority") = 1
RS.Update
RS.Sort "Team"
Do While Not RS.Eof
MsgBox RS("Team")
RS.MoveNext
Loop
etc....