| View previous topic :: View next topic |
| Author |
Message |
B Marcelly
Super User
Joined: 12 May 2004
Posts: 1414
Location: France
|
 Posted: Sat Jun 04, 2005 4:21 am Post subject: How to sort arrays in Basic |
 |
|
This thread shows how to sort an array of String. The routines presented can be easily adapted to sorting an array of numeric values. It can also be adapted to sorting several arrays having the same index, using one of the arrays as sorting criterion.
If you try yourself to find a sorting method you will generally obtain a variant of the Bubble sort method. Here is a slightly improved Bubble sort.
| Code: | Sub ImprovedBubbleSort(myList())
Dim k1 As Long, k2 As Long
Dim x1 As Long, x2 As Long
Dim swapping
k1 = LBound(myList())
k2 = UBound(myList())
for x2 = k2 -1 to k1 step -1
for x1 = k1 to x2
if StrComp(myList(x1), myList(x1 +1), 0) = 1 then
swapping = myList(x1)
myList(x1) = myList(x1 +1)
myList(x1 +1) = swapping
x1 = k1
end if
next
next
End Sub |
Notes
Variables myList and swapping are of Variant type, so that you only have to change the compare instruction if you need another kind of array.
The Basic function StrComp used in the routine compares two strings. The third argument is 0 to compare strings independently of upper/lower case. It is 1 to have a strict comparison.
The problem with this routine is that it is very inefficient. Here are approximate durations based on an AMD XP 1800+ using arrays filled with random values. Note that duration depends on the array contents. | Code: | Array size 50 100 200 500
Time (sec) 0.57 4.4 36 536 |
D. L. Shell described in 1959 the algorithm which bears its name. Here is a Basic implementation extracted from routines of Xray tool. | Code: | Sub ShellSort(myList())
Dim k1 As Long, k2 As Long, listSize As Long
Dim x1 As Long, isSorted As Boolean
Dim swapping
listSize = UBound(myList()) +1 -LBound(myList())
k1 = Fix(listSize /2)
do while k1 > 0
k2 = UBound(myList()) - k1
isSorted = true
for x1 = LBound(myList()) to k2
if StrComp(myList(x1), myList(x1 +k1), 0) = 1 then
swapping = myList(x1)
myList(x1) = myList(x1 +k1)
myList(x1 +k1) = swapping
isSorted = false
end if
next
if isSorted then
k1 = Fix(k1 /2)
end if
loop
End Sub |
As you can see it is not much bigger than Bubble sort. But it is far more smart. Using the same computer, approximate durations are now :
| Code: | Array size 50 100 200 500 1000 5000 30000
Time (sec) 0.045 0.11 0.31 1.04 2.6 23 240
Bubble/Shell 13 40 116 515 |
The last line is the ratio from Shell to Bubble durations. It shows that as the array size grows the Bubble sort is increasingly slow.
Computer scientists have found better algorithms, among them : Quick sort. Contrary to Shell, they are usually based on recursion. But with large arrays you will still be slowed by the interpreted nature of Basic language. If you have to routinely sort arrays of more than 1000 elements, you should use a compiled language (or use Python, which has optimized sort routines).
_______
Bernard |
|
| Back to top |
|
 |
Marinus
OOo Advocate
Joined: 07 Nov 2004
Posts: 261
|
| Posted: Sat Jun 04, 2005 11:18 am Post subject: |
|
|
Wow, very impressive.
I will defenitely end up using this!
Marinus. |
|
| Back to top |
|
|
SergeM
Super User
Joined: 09 Sep 2003
Posts: 3211
Location: Troyes France
|
|
| Back to top |
|
|
ms777
Super User
Joined: 07 Feb 2004
Posts: 1355
|
| Posted: Thu Jul 07, 2005 6:51 am Post subject: |
|
|
As B Marcelly mentions ... | Quote: | | Computer scientists have found better algorithms, among them : Quick sort. Contrary to Shell, they are usually based on recursion. But with large arrays you will still be slowed by the interpreted nature of Basic language. If you have to routinely sort arrays of more than 1000 elements, you should use a compiled language (or use Python, which has optimized sort routines). |
Since OO2.0, OO has JavaScript support. JavaScript has a very strong built in sort function, which seems to be quite optimized for speed. It is still somewhat complicated to acces JavaScript functions from BASIC (see e.g. http://www.oooforum.org/forum/viewtopic.phtml?t=21564 ), especially when passing back array parameters, but the results are very good: The time for sorting reduces drastically vs. ShellSort, the code gets shorter (but somewhat more complicated).
| Code: | 50 100 200 500 1000 5000
Time (sec) JavaScript 0,04 0,04 0,07 0,10 0,18 0,77
Time (sec) Shellsort 0,05 0,12 0,36 1,05 2,70 24,94
Shell/JavaScript 1 3 5 10 15 32
|
To test this it is necessary to install the following JavaScript code in My Macros in a Library named Tools, with the macro name sort.js
| Code: | importClass(Packages.com.sun.star.uno.UnoRuntime);
importClass(Packages.com.sun.star.text.XTextRange);
var xCallBack = ARGUMENTS[0];
var oCallBack = UnoRuntime.queryInterface(XTextRange, xCallBack);
var aSort = new Array()
for (var i=0; i<ARGUMENTS[1].length; i++) {
aSort[i] = ARGUMENTS[1][i]
}
aSort.sort()
for (var i=0; i<ARGUMENTS[1].length; i++) {
oCallBack.setString(aSort[i])
} |
The BASIC routines are here. The usage of a global variable to pass an array back from JavaScript to BASIC is certainly not elegant, but I did not find a better way. Thanks for any hint ...
| Code: | Global glob_asReturn() as String 'for the callback from JavaScript
Global glob_lIndex 'for the callback from JavaScript
const TicksPerSecond = 980.0
Sub DoTheSort
oMSPFac = createUnoService("com.sun.star.script.provider.MasterScriptProviderFactory")
oMSP = oMSPFac.createScriptProvider("")
oScriptSort = oMSP.getScript("vnd.sun.star.script:Tools.sort.js?language=JavaScript&location=user")
'prepare the callback function
'The javascript macro needs this to send arrays back to BASIC.
'
oCallBack = CreateUnoListener( "CallBack_", "com.sun.star.text.XTextRange")
oSheet = ThisComponent.sheets.getByname("Sheet2")
oSheet.getCellByPosition(0,1).String = "Time JavaScript"
oSheet.getCellByPosition(0,2).String = "Time Shellsort"
oSheet.getCellByPosition(0,3).String = "Ratio"
arkMax = Array(50,100,200,500 ,1000,5000 )
for j=0 to UBound(arkMax)
kMax = arkMax(j)
Redim arTestIn1(kMax) as String
Redim arTestIn2(kMax) as String
Redim glob_asReturn(kMax) as String
for k=0 to kMax
arTestIn1(k) = Rnd
arTestIn2(k) = arTestIn1(k)
next k
lTicksStart = GetSystemTicks
glob_lIndex = 0 ' the Index in glob_asReturn
oScriptSort.invoke(Array(oCallBack, arTestIn1()), Array(), Array())
lTicksJS = GetSystemTicks - lTicksStart
lTicksStart = GetSystemTicks
call ShellSort(arTestIn2())
lTicksShell = GetSystemTicks - lTicksStart
for k=0 to kMax
if StrComp(glob_asReturn(k), arTestIn2(k))<>0 then
msgbox k
endif
next k
oSheet.getCellByPosition(j+1,0).Value = kMax
oSheet.getCellByPosition(j+1,1).Value = lTicksJS/TicksPerSecond
oSheet.getCellByPosition(j+1,2).Value = lTicksShell/TicksPerSecond
oSheet.getCellByPosition(j+1,3).Value = ((lTicksShell*1.0)/lTicksJS)
next j
end sub
sub CallBack_setString( s as String )
glob_asReturn(glob_lIndex) = s
glob_lIndex = glob_lIndex+1
End Sub
Sub ShellSort(myList()) 'from B Marcelly's post
Dim k1 As Long, k2 As Long, listSize As Long
Dim x1 As Long, isSorted As Boolean
Dim swapping
listSize = UBound(myList()) +1 -LBound(myList())
k1 = Fix(listSize /2)
do while k1 > 0
k2 = UBound(myList()) - k1
isSorted = true
for x1 = LBound(myList()) to k2
if StrComp(myList(x1), myList(x1 +k1), 0) = 1 then
swapping = myList(x1)
myList(x1) = myList(x1 +k1)
myList(x1 +k1) = swapping
isSorted = false
end if
next
if isSorted then
k1 = Fix(k1 /2)
end if
loop
End Sub |
|
|
| Back to top |
|
|
B Marcelly
Super User
Joined: 12 May 2004
Posts: 1414
Location: France
|
| Posted: Thu Jul 07, 2005 11:32 pm Post subject: |
|
|
| Quote: | | Since OO2.0, OO has JavaScript support. JavaScript has a very strong built in sort function, which seems to be quite optimized for speed. |
Very interesting solution 
And also interesting to see how Javascript and Basic can cooperate.
______
Bernard |
|
| Back to top |
|
|
ms777
Super User
Joined: 07 Feb 2004
Posts: 1355
|
| Posted: Fri Jul 08, 2005 1:27 am Post subject: |
|
|
| Quote: | | Very interesting solution |
Thanks 
In the meantime, I have simplified the code a bit:
(i) The variable aSort in the JavaScript function was not necessary. The code (store in Tools/sort_pipe.js) is now | Code: | importClass(Packages.com.sun.star.uno.UnoRuntime);
importClass(Packages.com.sun.star.io.XDataOutputStream);
var oDataOut = UnoRuntime.queryInterface(XDataOutputStream, ARGUMENTS[0]);
ARGUMENTS[1].sort()
for (var i=0; i<ARGUMENTS[1].length; i++) {
oDataOut.writeUTF(ARGUMENTS[1][i])
} |
(ii) The callback function was not very elegant, especially due to the usage of global variables. I have replaced that by writing to a pipe in JavaScript and reading from it in BASIC
| Code: | const TicksPerSecond = 980.0
Sub DoTheSort_pipe
oMSPFac = createUnoService("com.sun.star.script.provider.MasterScriptProviderFactory")
oMSP = oMSPFac.createScriptProvider("")
oScriptSort = oMSP.getScript("vnd.sun.star.script:Tools.sort_pipe.js?language=JavaScript&location=user")
'prepare the pipe. The JavaScript function writes the result to the pipe.
oPipe = GeneratePipe()
oSheet = ThisComponent.sheets.getByname("Sheet2")
oSheet.getCellByPosition(0,1).String = "Time JavaScript (sec)"
arkMax = Array(50,100,200,500 ,1000,2000, 5000,10000,20000,50000,100000 )
'arkMax = Array(50)
for j=0 to UBound(arkMax)
kMax = arkMax(j)
Redim arTestIn1(kMax) as String
Redim arTestOut1(kMax) as String
for k=0 to kMax
arTestIn1(k) = Rnd
next k
lTicksStart = GetSystemTicks
oScriptSort.invoke(Array(oPipe.Predecessor, arTestIn1()), Array(), Array())
for k=0 to kMax
arTestOut1(k) = oPipe.Successor.readUTF()
next k
lTicksJS = GetSystemTicks - lTicksStart
oSheet.getCellByPosition(j+1,0).Value = kMax
oSheet.getCellByPosition(j+1,1).Value = lTicksJS/TicksPerSecond
next j
ClosePipe(oPipe)
end sub
function GeneratePipe() as Object
Dim oPipe, oDataInp, oDataOut
oPipe = createUNOService ("com.sun.star.io.Pipe")
oDataInp = createUNOService ("com.sun.star.io.DataInputStream")
oDataOut = createUNOService ("com.sun.star.io.DataOutputStream")
oDataInp.setInputStream(oPipe)
oDataOut.setOutputStream(oPipe)
GeneratePipe = oPipe
end function
sub ClosePipe(oPipe as Object)
oPipe.Successor.closeInput
oPipe.Predecessor.closeOutput
oPipe.closeInput
oPipe.closeOutput
end sub |
Results with this code are
| Code: | 50 100 200 500 1000 2000 5000 10000 20000 50000 100000
Time JavaScript (sec) 0,04 0,05 0,07 0,13 0,23 0,41 1,01 2,14 4,09 10,85 22,24
|
|
|
| Back to top |
|
|
B Marcelly
Super User
Joined: 12 May 2004
Posts: 1414
Location: France
|
| Posted: Fri Aug 12, 2005 4:39 am Post subject: Quick Sort algorithm |
|
|
Here is an implementation in OOoBasic of the Quick Sort algorithm, which makes use of recursivity. OOoBasic supports recursivity from version 1.1.
The main routine is the first one, QuickSort
| Code: | Sub QuickSort(myList())
qSort(myList(), LBound(myList()), UBound(myList()) )
End Sub
Function partition(myList(), xMin As Long, xMax As Long) As Long
Dim yMin As Long, yMax As Long
Dim currentKey, swapping
'currentKey = myList(xMin)
currentKey = myList((xMin +xMax) \ 2)
yMin = xMin -1
yMax = xMax +1
Do
Do
yMax = yMax-1
Loop Until StrComp(myList(yMax), currentKey, 0) <= 0
Do
yMin = yMin+1
Loop Until StrComp(myList(yMin), currentKey, 0) >= 0
if yMin < yMax then
swapping = myList(yMin)
myList(yMin) = myList(yMax)
myList(yMax) = swapping
else
partition = yMax
Exit Function
end if
Loop
End Function
Sub qSort(myList(), xMin As Long, xMax As Long)
Dim p As Long
if xMin < xMax then
p = partition(myList(), xMin, xMax)
qSort(myList(), xMin, p)
qSort(myList(), p+1, xMax)
end if
End Sub |
Now the duration results on my computer, compared to Bubble Sort and Shell Sort.
| Code: | Array size 50 100 200 500
Bubble sort 0.57 4.4 36 536
Shell sort 0.045 0.11 0.31 1.04
Quick sort 0.06 0.13 0.38
Array size 1000 5000 30000 50000
Bubble sort --- --- --- ---
Shell sort 2.6 23 240 516
Quick sort 0.83 4.7 33 59
|
The JavaScript method described by ms777 is still far quicker  but this one works also on OOo 1.1. 
[addition]
If you really need to sort big arrays in a blink of an eye you should write your main program with a compiled language and call OOo API from it. The same QuickSort algorithm written in Delphi sorts an array of 100 000 strings in less than 0.3 second. |
|
| Back to top |
|
|
CesarAKG
Newbie
Joined: 28 May 2009
Posts: 1
|
| Posted: Thu May 28, 2009 6:00 pm Post subject: |
|
|
Hello
How you do if you have "n" arrays to sort? e.g. a 400 rows x 15 columns, where every row is an array to be sorted? |
|
| Back to top |
|
|
B Marcelly
Super User
Joined: 12 May 2004
Posts: 1414
Location: France
|
| Posted: Sat May 30, 2009 11:30 pm Post subject: |
|
|
Hi,
| CesarAKG wrote: | | How you do if you have "n" arrays to sort? e.g. a 400 rows x 15 columns, where every row is an array to be sorted? |
You probably mean something like this :
I want to sort 400 rows, each row containing several values (called here : columns).
But if two rows have the same value for the first column, the order will depend on the value of the second column.
If the second column has same value for the two rows, the order will depend on the value of the third column. Etc.
You have to modify two parts of the sort routine:
- the swapping of two rows. You have to swap all the columns of the two rows
- the comparison of two rows. Instead of the instruction StrComp you have to create a Function which returns -1, 0, +1 depending on the comparison result. This function will do exactly what I have described : compare the first column, then if they are equal compare the second, etc.
______
Bernard |
|
| Back to top |
|
|
Prizm1
Newbie
Joined: 10 Feb 2011
Posts: 1
|
| Posted: Sun Apr 10, 2011 11:04 am Post subject: Re: How to sort arrays in Basic |
|
|
[quote=The problem with this routine is that it is very inefficient. Here are approximate durations based on an AMD XP 1800+ using arrays filled with random values. Note that duration depends on the array contents. | Code: | Array size 50 100 200 500
Time (sec) 0.57 4.4 36 536 |
D. L. Shell described in 1959 the algorithm which bears its name. Here is a Basic implementation extracted from routines of Xray tool. | Code: | Sub ShellSort(myList())
Dim k1 As Long, k2 As Long, listSize As Long
Dim x1 As Long, isSorted As Boolean
Dim swapping
listSize = UBound(myList()) +1 -LBound(myList())
k1 = Fix(listSize /2)
do while k1 > 0
k2 = UBound(myList()) - k1
isSorted = true
for x1 = LBound(myList()) to k2
if StrComp(myList(x1), myList(x1 +k1), 0) = 1 then
swapping = myList(x1)
myList(x1) = myList(x1 +k1)
myList(x1 +k1) = swapping
isSorted = false
end if
next
if isSorted then
k1 = Fix(k1 /2)
end if
loop
End Sub |
As you can see it is not much bigger than Bubble sort. But it is far more smart. Using the same computer, approximate durations are now :
| Code: | Array size 50 100 200 500 1000 5000 30000
Time (sec) 0.045 0.11 0.31 1.04 2.6 23 240
Bubble/Shell 13 40 116 515 |
_______
Bernard[/quote]
I know that this is an old post, and probably will not be answered, but,how much does the IsSorted boolean check add time to the sorting? The Do Loop is executed following each k2 array items swap to verify that the swapped items are correctly sorted. Is this necessary? I would think that the double check doubles the time it would take to sort the array. The array sorting seems to be twice as fast without the boolean variable checking.
| Code: | Sub ShellSort(myList())
Dim k1 As Long, k2 As Long, listSize As Long
Dim x1 As Long
Dim swapping
listSize = UBound(myList()) +1 -LBound(myList())
k1 = Fix(listSize /2)
do while k1 > 0
k2 = UBound(myList()) - k1
for x1 = LBound(myList()) to k2
if StrComp(myList(x1), myList(x1 +k1), 0) = 1 then
swapping = myList(x1)
myList(x1) = myList(x1 +k1)
myList(x1 +k1) = swapping
end if
next
k1 = Fix(k1 /2)
end if
loop
End Sub |
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
