OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

How to sort arrays in Basic

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets
View previous topic :: View next topic  
Author Message
B Marcelly
Super User
Super User


Joined: 12 May 2004
Posts: 1453
Location: France

PostPosted: Sat Jun 04, 2005 4:21 am    Post subject: How to sort arrays in Basic Reply with quote

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
View user's profile Send private message Visit poster's website
Marinus
OOo Advocate
OOo Advocate


Joined: 07 Nov 2004
Posts: 261

PostPosted: Sat Jun 04, 2005 11:18 am    Post subject: Reply with quote

Wow, very impressive.

I will defenitely end up using this!

Marinus.
Back to top
View user's profile Send private message Visit poster's website
SergeM
Super User
Super User


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

PostPosted: Mon Jun 06, 2005 9:34 am    Post subject: Reply with quote

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
Back to top
View user's profile Send private message Visit poster's website
ms777
Super User
Super User


Joined: 07 Feb 2004
Posts: 1355

PostPosted: Thu Jul 07, 2005 6:51 am    Post subject: Reply with quote

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
View user's profile Send private message
B Marcelly
Super User
Super User


Joined: 12 May 2004
Posts: 1453
Location: France

PostPosted: Thu Jul 07, 2005 11:32 pm    Post subject: Reply with quote

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 Laughing
And also interesting to see how Javascript and Basic can cooperate.
______
Bernard
Back to top
View user's profile Send private message Visit poster's website
ms777
Super User
Super User


Joined: 07 Feb 2004
Posts: 1355

PostPosted: Fri Jul 08, 2005 1:27 am    Post subject: Reply with quote

Quote:
Very interesting solution

Thanks Embarassed

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
View user's profile Send private message
B Marcelly
Super User
Super User


Joined: 12 May 2004
Posts: 1453
Location: France

PostPosted: Fri Aug 12, 2005 4:39 am    Post subject: Quick Sort algorithm Reply with quote

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 Wink but this one works also on OOo 1.1. Cool

[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
View user's profile Send private message Visit poster's website
CesarAKG
Newbie
Newbie


Joined: 28 May 2009
Posts: 1

PostPosted: Thu May 28, 2009 6:00 pm    Post subject: Reply with quote

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
View user's profile Send private message
B Marcelly
Super User
Super User


Joined: 12 May 2004
Posts: 1453
Location: France

PostPosted: Sat May 30, 2009 11:30 pm    Post subject: Reply with quote

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
View user's profile Send private message Visit poster's website
Prizm1
Newbie
Newbie


Joined: 10 Feb 2011
Posts: 1

PostPosted: Sun Apr 10, 2011 11:04 am    Post subject: Re: How to sort arrays in Basic Reply with quote

[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
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
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