musclejack
asked on
Can someone convert this VB code to ASP version?
Store the values into an array and sort them and do not have the duplicate
-------------------------- ---------- ---------- ---------- ---------- ---------- --------.
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.
Or with the use of a dictionairy object instead of the collection:
<%@ Language=VBScript %>
<%
Option Explicit
'Sub Command1_Click()
Dim arrMeng
Dim i
Dim strMeng
arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")
QuickSort arrMeng,"",false
strMeng = ""
For i = 0 To UBound(arrMeng)
strMeng = strMeng & arrMeng(i) & vbTab
Next
Response.Write strMeng
'End Sub
Sub QuickSort(arr, numEls, descending)
Dim value, temp
Dim sp
Dim leftStk(32), rightStk(32)
Dim leftNdx, rightNdx
Dim i, j
Dim k
Dim strPrevious
Dim strCurrent
Dim colTemp, counter
' account for optional arguments
If not Isnumeric(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 = server.CreateObject("Scrip ting.Dicti onary")
strPrevious = ""
counter = 0
For k = 0 To UBound(arr)
strCurrent = arr(k)
If strCurrent = strPrevious Then
Else
colTemp.Add counter, strCurrent
counter = counter+1
End If
strPrevious = strCurrent
Next
ReDim arr(colTemp.Count)
For k = 0 To colTemp.Count
strCurrent = colTemp.Item(k)
arr(k) = strCurrent
Next
End Sub
%>
<%@ Language=VBScript %>
<%
Option Explicit
'Sub Command1_Click()
Dim arrMeng
Dim i
Dim strMeng
arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")
QuickSort arrMeng,"",false
strMeng = ""
For i = 0 To UBound(arrMeng)
strMeng = strMeng & arrMeng(i) & vbTab
Next
Response.Write strMeng
'End Sub
Sub QuickSort(arr, numEls, descending)
Dim value, temp
Dim sp
Dim leftStk(32), rightStk(32)
Dim leftNdx, rightNdx
Dim i, j
Dim k
Dim strPrevious
Dim strCurrent
Dim colTemp, counter
' account for optional arguments
If not Isnumeric(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 = server.CreateObject("Scrip
strPrevious = ""
counter = 0
For k = 0 To UBound(arr)
strCurrent = arr(k)
If strCurrent = strPrevious Then
Else
colTemp.Add counter, strCurrent
counter = counter+1
End If
strPrevious = strCurrent
Next
ReDim arr(colTemp.Count)
For k = 0 To colTemp.Count
strCurrent = colTemp.Item(k)
arr(k) = strCurrent
Next
End Sub
%>
1) removed variable types
2) removed Optional keywords and added default values in procedure call
3) redesigned Collection into dynamic array