Forum Moderators: open

Message Too Old, No Replies

Sorting a dict

Need efficient soert functions

         

aspdaddy

11:06 am on Aug 16, 2003 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



Does anyone have code to do a sort on a vbScript dictionary, or know where I can find it.

I want to be able to sort by either column, ascending and descending, with decent performance - would rather not re-invent the wheel.

Thanks.

ziggystardust

11:47 pm on Aug 16, 2003 (gmt 0)

10+ Year Member



Hello aspdaddy,

There are no real "easy" (as in a sort() method ;-)) ways to do that, you've got to extract the keys, sort them in a normal array and use that as an index.
4GuysFromRolla have an article about this [4guysfromrolla.com...]

M$ take it even a step further in their article where they extract both the keys and the values to an array, they sort it and then recreate the dictionary totally from scratch. [support.microsoft.com...]

I hope this helps
//ZS

TheDave

2:05 am on Aug 17, 2003 (gmt 0)

10+ Year Member



Quick way I've found to sort things is to create a recordset, fill it will the values then apply a sort to it. But then you could just about work with a recordset from scratch, and forget the dictionary.

dim rs

set rs = Server.CreateObject("ADODB.Recordset")

rs.Fields.Append "I", 202 'or whatever the format is I just made 202 up
rs.Fields.Append "N", 202 'or whatever the format is I just made 202 up

rs.Open

.
.
.
.

rs.Sort = "N [ASC]"

I have a feeling I'm telling you stuff you already know :P

RossWal

4:26 pm on Aug 19, 2003 (gmt 0)

10+ Year Member



If you go with the MS code as posted by ziggystardust, I enhanced it to automatically do date or numeric sorts based on the data it finds in the sort keys. I can post here or sticky if you need it.

Ross

aspdaddy

5:11 pm on Aug 19, 2003 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



I used the recordset in the end, more features.

It would be good to see the code here though, just in case, would be good to have all the options here in one place :)

RossWal

9:22 pm on Aug 21, 2003 (gmt 0)

10+ Year Member



Here it is... offered as is, might work, no waranties, yadayadayada


Const dictKey = 0
Const dictItem = 1
Const dictAsc = 1
Const dictDesc = -1

Function SortDictionary(objDict,intSortKey, intSortOrder)
Dim strDict()
Dim objKey
Dim strKey,strItem
Dim X,Y,Z
Dim dblA, dblB
Dim AllDt, AllNum, AllStr
AllDt = True
AllNum = True
AllStr = True

Z = objDict.Count

'place data into strDict array
If Z > 1 Then
ReDim strDict(Z,1)
X = 0
For Each objKey In objDict
strDict(X,dictKey) = CStr(objKey)
strDict(X,dictItem) = CStr(objDict(objKey))
X = X + 1
Next

For X = 0 To (Z - 1)
If Not IsDate(strDict(X,intSortKey)) then
AllDt = False
End If
If Not IsNumeric(strDict(X,intSortKey)) then
AllNum = False
End If
Next

If (AllDt) Then
AllStr = False
Else If (AllNum) Then
AllStr = False
End If
End If

'Sort
For X = 0 to (Z - 2)
For Y = X to (Z - 1)
If (AllDT) Then
If DateDiff("d",cDate(strDict(X,intSortKey)),cDate(strDict(Y,intSortKey))) * intSortOrder < 0 Then
strKey = strDict(X,dictKey)
strItem = strDict(X,dictItem)
strDict(X,dictKey) = strDict(Y,dictKey)
strDict(X,dictItem) = strDict(Y,dictItem)
strDict(Y,dictKey) = strKey
strDict(Y,dictItem) = strItem
End If
Else If (AllStr) Then
If StrComp(strDict(X,intSortKey),strDict(Y,intSortKey),vbTextCompare) * intSortOrder > 0 Then
strKey = strDict(X,dictKey)
strItem = strDict(X,dictItem)
strDict(X,dictKey) = strDict(Y,dictKey)
strDict(X,dictItem) = strDict(Y,dictItem)
strDict(Y,dictKey) = strKey
strDict(Y,dictItem) = strItem
End If
Else
dblA = CDbl(strDict(X,intSortKey))
dblB = CDbl(strDict(Y,intSortKey))
If (dblA - dblB) < 0 Then
strKey = strDict(X,dictKey)
strItem = strDict(X,dictItem)
strDict(X,dictKey) = strDict(Y,dictKey)
strDict(X,dictItem) = strDict(Y,dictItem)
strDict(Y,dictKey) = strKey
strDict(Y,dictItem) = strItem
End If
End If
End IF
Next
Next


'Place contents of sorted array strDict into Dictionary object

objDict.RemoveAll
For X = 0 to (Z - 1)
objDict.Add strDict(X,dictKey), strDict(X,dictItem)
Next
End If
End Function