Link to home
Start Free TrialLog in
Avatar of musclejack
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
ASKER CERTIFIED SOLUTION
Avatar of inthedark
inthedark
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Here is a better way to sort in ASP as ASP is much slower than VB so your sort routine will be slooooow

' Create an instance of the recordset
Set RS = Server.CreateObjct("ADODB.Recordset")

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....
Avatar of srimanth
srimanth

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("Scripting.Dictionary")
      
      For i = nFirstIndex to nLastIndex
            If (Not objDictionary.Exists(arrTemp(i))) Then objDictionary.Add arrTemp(i), arrTemp(i)
      Next
      
      nIndex = 0
      Redim Preserve arrTemp(objDictionary.Count)
      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.