Sorting data is easy
Doing it faster than with a regular bubble sort method is a little harder
Aa an example, we will use something not simple
6 columns to sort with numbers and letters
1a.2b.3c
This was originally for a BOM insertion (bill of material)
There is different categories of materials, (numbers) and different sub categories (letters)
We keep numbers + 1
We change letters to numbers + 1
We calculate a super total to sort them out in one bubble pass
On bubble pass is going from element 0 to elementmax - 1
Then another loop inside that will compare element now with element after and switch them if the element after's supertotal is smaller
This is a nested loop, that will loop a lot of time of there is a lot of elements
It would have done it 6 time is we had used a classic method to sort with 6 columns, like SQL do when you use ORDER BY field01, field02, field03, field04, field05, field06
By concatening the 6 field in one supertotal, we can bubble sort only once
This is a vb script
It will generate a log.txt
and a log.html with same start name as the script
Save it with notepad.exe
26/07/2015 19:48:14 Start of bubble sort example
TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting
| Index | item | quantity | description |
| 10b.2c.33b | bolt | 18 | this is a bolt |
| 11a.1c.3b | bolt | 1 | this is a bolt |
| 1a.2c.33b | bolt | 45 | this is a bolt |
| 1b.2c.33 | bolt | 12 | this is a bolt |
| 1c.2c | bolt | 5 | this is a bolt |
| 1z.10c.3b | bolt | 2 | this is a bolt |
TABLE 02 Split all the values to get only numbers and calculate a supertotal
| split01 | split02 | split03 | Number | Letter | Number | Letter | Number | Letter | Supertotal |
| 10b | 2c | 33b | 10 | 2 | 2 | 3 | 33 | 2 | 1,1003003004034E+19 |
| 11a | 1c | 3b | 11 | 1 | 1 | 3 | 3 | 2 | 1,2002002004004E+19 |
| 1a | 2c | 33b | 1 | 1 | 2 | 3 | 33 | 2 | 2,002003004034E+18 |
| 1b | 2c | 33 | 1 | 2 | 2 | 3 | 33 | 0 | 2,003003004034E+18 |
| 1c | 2c | 1 | 3 | 2 | 3 | 0 | 0 | 2,004003004001E+18 | |
| 1z | 10c | 3b | 1 | 26 | 10 | 3 | 3 | 2 | 2,027011004004E+18 |
TABLE 03 sorted after all was converted to number to make a supertotal
| Index | item | quantity | description | Supertotal verification (not in DS) |
| 1a.2c.33b | bolt | 45 | this is a bolt | 2,002003004034E+18 |
| 1b.2c.33 | bolt | 12 | this is a bolt | 2,003003004034E+18 |
| 1c.2c | bolt | 5 | this is a bolt | 2,004003004001E+18 |
| 1z.10c.3b | bolt | 2 | this is a bolt | 2,027011004004E+18 |
| 10b.2c.33b | bolt | 18 | this is a bolt | 1,1003003004034E+19 |
| 11a.1c.3b | bolt | 1 | this is a bolt | 1,2002002004004E+19 |
-------------------------------- bubblesort.vbs -------------------
'=== bubblesort_wildboy85.vbs
'=== requirement: wscript.exe
'=== very fast bubble sort
'=== by wildboy85 (sergefournier @ hotmail.com)
'=== objects needed
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objshe = CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
'=== register base constants
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
Const ForReading = 1
Const adVarChar = 200
Const MaxCharacters = 255
Const adDouble = 5
'=== actual drive, actual directory, and "\"
thepath = WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
filnam = right(thepath,len(thepath)-p)
'=== windows dir
WinDir = objfso.GetSpecialFolder(0)
'=== restart the script in 32 bits if we are on a 64 bits system
'=== some databases drivers are not yet available in 64 bits
a64 = windir & "\syswow64\wscript.exe"
if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
'=== 64 bits system
argchain01 = ""
set args01 = Wscript.Arguments
if args01.count<>0 then
'=== when recalling this script in 32 bits, pass all the parameters
For Each arg01 in args01
argchain01 = argchain01 & " " & arg01
Next
end if
a = """" & a64 & """ """ & basedir & filnam & """" & argchain01
objshe.Run a,0, false
wscript.quit
end if
'=== log what we do, in same directory as the script
logall = 1
htmlout = 1
if logall=1 then
'=== debug log, get this file name, remove end, change start for ZZZ
'=== remove .vbs
path01 = left(thepath,len(thepath)-(len(thepath)-instr(thepath,".")+1))
name01 = right(path01,len(path01)-instrrev(path01,"\"))
logname01 = "zzz_" & name01 & ".txt"
'=== always have a nice error trapping
err01 = 0 : err02 = ""
on error resume next
Set File02 = objFSo.OpenTextFile(logname01, 2, true)
err01 = err : err02 = err.description
on error goto 0
end if
if err01 = 0 then
logall = 1
else
'=== flag to tell our program to not write in log file if there is not log file open
logall = 0 '=== could not open logfile, no log
end if
'=== html output file, we want a nice table as output
if htmlout=1 then
path01 = left(thepath,len(thepath)-(len(thepath)-instr(thepath,".")+1))
name01 = right(path01,len(path01)-instrrev(path01,"\"))
logname01 = name01 & "_output.html"
'=== always have a nice error trapping
err01 = 0 : err02 = ""
on error resume next
Set File03 = objFSo.OpenTextFile(logname01, 2, true)
err01 = err : err02 = err.description
on error goto 0
end if
if err01 = 0 then
htmlout = 1
else
'=== flag to tell our program to not write in log file if there is not log file open
htmlout = 0 '=== could not open logfile, no log
end if
if logall = 1 then file02.WriteLine date & " " & time & " START Bubble sort wildboy85"
'=== the dataset could come from a database, but here we will add data ourseleves as an example
set dataset01 = CreateObject("ADODB.Recordset")
dataset01.Fields.Append "Index", adVarChar, MaxCharacters
if logall = 1 then file02.WriteLine date & " " & time & " First field appended"
dataset01.Fields.Append "item", adVarChar, MaxCharacters
dataset01.Fields.Append "quantity", adDouble
dataset01.Fields.Append "description", adVarChar, MaxCharacters
'dataset01.Fields.Append "supertotal DS", adVarChar, MaxCharacters
dataset01.Open
'=== accessing the column by name is slow, it would be faster by name if we have big loop
dataset01.AddNew
dataset01("Index") = "1a.1c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 1
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1z.10c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 2
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1a.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 45
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1b.2c.33"
dataset01("item") = "bolt"
dataset01("quantity") = 12
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1c.2c"
dataset01("item") = "bolt"
dataset01("quantity") =5
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "10b.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 18
dataset01("description") = "this is a bolt"
dataset01.Update
'=== how many field? (columns)
fieldscount01 = dataset01.fields.count
if logall = 1 then file02.WriteLine date & " " & time & " fieldcount: " & fieldscount01
if htmlout = 1 then file03.WriteLine date & " " & time & " Start of bubble sort example<br><br>"
'=== this datasort will order our items badly, as if number 10 was smaller than number 1
dataset01.Sort = "index"
'=== html table
if htmlout = 1 then file03.WriteLine " TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting<br>"
if htmlout = 1 then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
if htmlout = 1 then file03.WriteLine "<tr>"
for i = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & dataset01.fields(i).name & "</td>"
next
if htmlout = 1 then file03.WriteLine "</tr>"
dataset01.movefirst
linecount = 0
do while not (dataset01.eof) '=== magica loop, row
redim preserve ara02(fieldscount01-1, linecount)
if htmlout = 1 then file03.WriteLine "<tr>"
'=== put all values in an array, because a dataset this basic cannot switch a line of data
for i = 0 to fieldscount01-1
value01 = dataset01.fields(i).value
If IsNull(value01) then value01=""
value01 = Trim(value01)
if htmlout = 1 then file03.WriteLine "<td>" & value01 & "</td>"
ara02(i, linecount) = value01
next
if htmlout = 1 then file03.WriteLine "</tr>"
linecount = linecount + 1
dataset01.movenext
loop
if htmlout = 1 then file03.WriteLine "</table><br>"
'=== now we will split the line we will use to do the sort by number and letter (converted to numbers)
fieldtosort01 = 0 '=== field 0 contain what we want to sort, example: 1a.2b.3c
'=== we assume we will have only 3 data to sort, 1a 2b 3c
dataset01.movefirst
if htmlout = 1 then file03.WriteLine "<br>TABLE 02 Split all the values to get only numbers and calculate a supertotal"
if htmlout = 1 then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
if htmlout = 1 then file03.WriteLine "<tr><td>split01</td><td>split02</td><td>split03</td>"
if htmlout = 1 then file03.WriteLine "<td>Number</td><td>Letter</td><td>Number</td><td>Letter</td><td>Number</td><td>Letter</td>"
if htmlout = 1 then file03.WriteLine "<td>Supertotal</td></tr>"
'=== split the chain 1a.2b.3c by adding dots in case 2b.3c does not exist
dim split(2)
linecount = 0
do while not (dataset01.eof) '=== magica loop, row
redim preserve ara01(6,linecount) '=== the last dimension can be redimensionned so we reversed the dimensions
if htmlout = 1 then file03.WriteLine "<tr>" '=== html line change
value01 = dataset01.fields(fieldtosort01).value
'=== clean value in case of dbnull (dbnull cannot be processed)
If IsNull(value01) then value01=""
value01 = Trim(value01)
'=== add dots at the end of string to later split at the dots and get string inbetween
'=== so if the string have no dots, the split will still work and resturn empty string instead of trying to trap errors
value01 = value01 & "...."
split(0) = left(value01,len(value01)-(len(value01)-instr(value01,".")+1))
leftover = mid(value01,instr(value01,".")+1,len(value01))
split(1)= left(leftover,len(leftover)-(len(leftover)-instr(leftover,".")+1))
leftover = mid(leftover,instr(leftover,".")+1,len(leftover))
split(2) = left(leftover,len(leftover)-(len(leftover)-instr(leftover,".")+1))
if htmlout = 1 then file03.WriteLine "<td>" & split(0) & "</td><td>" & split(1) & "</td><td>" & split(2) & "</td>"
'=== we now do an array of 6 fields/columns
'=== field0 is 1, field1 is a, field2 is 2, field3 is b, field4 is 3, field5 is c (from 1a.2b.3c)
splitcount = 0
for x03 = 0 to 5 step 2 'order01, order01 letter, order02, order02 letter, order03, order03 letter (letter --> integer)
'=== split the split to get 2 value, 1 for number, 1 for alpha (split the chain "1a", "2b", "3c")
data01 = trim(split(splitcount))
len01 = len(data01)
if len01>1 then
alpha01 = 0
for i = 1 to len01
'=== is this digit alpha?
asc01 = ASC(mid(data01,i,1))
if (asc01>64 and ASC01<91) or (asc01 >96 and asc01 <123) then
alpha01 = 1
'=== this is a letter
if i>1 then
val01 = cint(left(data01,i-1))
else
end if
'=== code de classement final
'if logall=1 then file02.WriteLine "value before: " & data01 & " After: " & val01 & " + " & asc01 & chr(9) & val01+asc01
if asc01>96 then '=== uppercase A
asc01 = asc01 - 96
elseif asc01>64 then '=== lowercase a
asc01 = asc01 - 64
end if
ara01(x03,linecount) = val01 '=== new ordering integer for this column
'=== create a new column to class by letter after this one
ara01(x03+1,linecount) = asc01
end if
next
if alpha01 = 0 then
'=== remove the 0 before
ara01(x03,linecount) = cint(data01)
ara01(x03+1,linecount) = 0
end if
elseif len01>0 then
'=== only 1 digit, so we assume it's a number (just to be faster)
ara01(x03,linecount) = data01 '=== new ordering integer for this column
'=== column to class by letter after this one (1 digit = no letter = 0)
ara01(x03+1,linecount) = 0
else
'=== len is 0, we do nothing
ara01(x03,linecount) = 0
ara01(x03+1,linecount) = 0
end if
splitcount = splitcount + 1
'=== results, all numerics
if htmlout = 1 then file03.WriteLine "<td>" & ara01(x03,linecount) & "</td><td>" & ara01(x03+1,linecount) & "</td>"
next
'=== tricky part, doing a supertotal to sort only one number for all six fields/columns
supertotal = 0
mul01 = 5
super02 = ""
for x03 = 0 to 5
'=== do a super total for this line and the next for comparaison
super01 = (ara01(x03,linecount)+1)*(1000^(mul01+1))
supertotal = supertotal + super01
mul01 = mul01 - 1
'==== alphanumeric supertotal add 0 in front pf every digit, not working with dataset.sort either
'super02 = super02 & left("00000", 5-len((ara01(x03,linecount)+1))) & ara01(x03,linecount)+1
next
'dataset01.fields("supertotal DS").value = super02
ara01(6,linecount) = supertotal
'dataset01.fields("supertotal DS").value = supertotal
if htmlout = 1 then file03.WriteLine "<td>" & ara01(6,linecount) & "</td>"
linecount = linecount + 1
if htmlout = 1 then file03.WriteLine "</tr>"
dataset01.movenext
'=== all supertotal must be computed before we can sort
'=== so this loop was to split numbers, letters and compute a supertotal with multiplicated by 1000^positioninfieldvalue(0-5) values
loop
if htmlout = 1 then file03.WriteLine "</table>"
'=== sorting loop, using supertotal
'=== we move through dataset at the same time we move in the array that contain supertotal at position 6
if logall = 1 then file02.WriteLine date & " " & time & " START bubble sort with supertotal"
'=== using SORT command from dataset would have been easy now, but noooo, error argument, number to weird
'=== even if this a string, it cannot sort with dateset.sort command
'dataset01.Sort = "supertotal DS"
dataset01.movefirst
'set row = CreateObject("ADODB.Recordsetrow")
'=== exchange lines in dataset, is that possible?
'dataset01.rows(1) = dataset01.rows(0)
'http://www.w3schools.com/asp/ado_ref_recordset.asp
''''''''''''''''''''''''''''''''''''''''''
' bubble sort
''''''''''''''''''''''''''''''''''''''''''
dim supertotal01(1)
redim ara01tempo(linecount-1)
if logall=1 then file02.WriteLine date & " " & time & " Bubble order START"
'=== classement bulle, ligne par ligne, 6 fois
for bubble01 = linecount-2 to 0 step -1
for y03 = 0 to bubble01 '=== magica loop, row
'=== if supertotal after is smaller, we exchange them
if ara01(6,y03+1) < ara01(6,y03) then
for x04 = 0 to fieldscount01-1
'=== save actual matrix x elements
ara01tempo(x04) = ara02(x04,y03)
ara02(x04,y03) = ara02(x04,y03+1) '=== go up one row in matrix
ara02(x04,y03+1) = ara01tempo(x04)
next
'=== exchange supertotal also
supertotaltemp = ara01(6,y03)
ara01(6,y03) = ara01(6,y03+1)
ara01(6,y03+1) = supertotaltemp
end if
next
next
if logall = 1 then file02.WriteLine date & " " & time & " END bubble sort"
'=== final result
if htmlout = 1 then file03.WriteLine "<br>TABLE 03 sorted after all was converted to number to make a supertotal"
if htmlout = 1 then file03.WriteLine "<br><table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
if htmlout = 1 then file03.WriteLine "<tr>"
for i = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & dataset01.fields(i).name & "</td>"
next
if htmlout = 1 then file03.WriteLine "<td>Supertotal verification (not in DS)</td>"
if htmlout = 1 then file03.WriteLine "</tr>"
for y = 0 to linecount-1 '=== display results after bubble sort
if htmlout = 1 then file03.WriteLine "<tr>"
for x = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & ara02(x,y) & "</td>"
next
if htmlout = 1 then file03.WriteLine "<td>" & ara01(6,y) & "</td>"
if htmlout = 1 then file03.WriteLine "</tr>"
next
if htmlout = 1 then file03.WriteLine "</table>"
if logall = 1 then file02.WriteLine ""
if logall = 1 then file02.WriteLine date & " " & time & " END"
if logall = 1 then file02.close
if htmlout = 1 then file03.close
