[Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register]

Author Message
B Marcelly
Super User

Joined: 12 May 2004
Posts: 1453
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
Marinus

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.
SergeM
Super User

Joined: 09 Sep 2003
Posts: 3211
Location: Troyes France

 Posted: Mon Jun 06, 2005 9:34 am    Post subject: Thank you Bernard for this code._________________Linux & Windows OOo3.0 UNO & C++ : WIKI http://wiki.services.openoffice.org/wiki/Using_Cpp_with_the_OOo_SDK In French http://wiki.services.openoffice.org/wiki/Documentation/FR/Cpp_Guide
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

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
B Marcelly
Super User

Joined: 12 May 2004
Posts: 1453
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
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

(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
B Marcelly
Super User

Joined: 12 May 2004
Posts: 1453
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.

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.
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?
B Marcelly
Super User

Joined: 12 May 2004
Posts: 1453
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
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
 Display posts from previous: All Posts1 Day7 Days2 Weeks1 Month3 Months6 Months1 Year Oldest FirstNewest First
 All times are GMT - 8 Hours Page 1 of 1

 Jump to: Select a forum OpenOffice.org Forums----------------Setup and TroubleshootingOpenOffice.org WriterOpenOffice.org CalcOpenOffice.org ImpressOpenOffice.org DrawOpenOffice.org MathOpenOffice.org BaseOpenOffice.org Macros and APIOpenOffice.org Code Snippets Community Forums----------------General DiscussionSite Feedback
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