Bubble sort vbs wsh script program by wildboy85

Hello,

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