' This short program illustrates INDEX SORTING which is being done

' without moving the original data. Hence the term in-place sorting.

' The index holds the correct sequence after sorting. This method

' may be preferable for two dimensional arrays when rows with many

' different column data are being sorted according to many different

' column criteria with a certain priority. The example in the program

' illustrates the principle. Even though the sorting routine seems

' bulky, it is very quick. You should test this yourself with

' larger amounts of data. The routine allows specification of a

' sorting priority, whether sorting should be ascending or descending

' (can vary between the variables), and whether sorting should be

' alphabetic (string sort) or numerical (can vary between the variables).

' I prefer a 2 dimensional string array to hold the data. This gives

' maximum flexibility, and both character and numerical data can be held

' in this array. For numerical sorting (and calculation) the VAL -

' function is being used. It is important to distinguish between

' string sorting and numerical sorting. In ascending string

' sorting "9" would come after "10", because the first character takes

' priority. In ascending numerical sorting 9 (=VAL("9")) would come before

' 10 (=VAL("10")).

' Erik Christensen, Copenhagen, Denmark. e.chr@email.dk

------------------

[This message has been edited by Erik Christensen (edited February 11, 2001).]

' without moving the original data. Hence the term in-place sorting.

' The index holds the correct sequence after sorting. This method

' may be preferable for two dimensional arrays when rows with many

' different column data are being sorted according to many different

' column criteria with a certain priority. The example in the program

' illustrates the principle. Even though the sorting routine seems

' bulky, it is very quick. You should test this yourself with

' larger amounts of data. The routine allows specification of a

' sorting priority, whether sorting should be ascending or descending

' (can vary between the variables), and whether sorting should be

' alphabetic (string sort) or numerical (can vary between the variables).

' I prefer a 2 dimensional string array to hold the data. This gives

' maximum flexibility, and both character and numerical data can be held

' in this array. For numerical sorting (and calculation) the VAL -

' function is being used. It is important to distinguish between

' string sorting and numerical sorting. In ascending string

' sorting "9" would come after "10", because the first character takes

' priority. In ascending numerical sorting 9 (=VAL("9")) would come before

' 10 (=VAL("10")).

' Erik Christensen, Copenhagen, Denmark. e.chr@email.dk

Code:

#COMPILE EXE #REGISTER NONE #DIM ALL DECLARE SUB POSISORT (BYREF Dat() AS STRING ,BYREF Indx() AS INTEGER, _ BYVAL C AS INTEGER,BYVAL R AS INTEGER,BYREF Prio() AS INTEGER) FUNCTION PBMAIN() LOCAL I%,J%,K%,B$ LOCAL t1 AS DOUBLE LOCAL t2 AS DOUBLE LOCAL R AS INTEGER LOCAL C AS INTEGER R=20 ' rows C=4 ' columns DIM Dat(1:R,1:C) AS LOCAL STRING DIM Indx(1:R) AS LOCAL INTEGER DIM Prio(0:2,1:C) AS LOCAL INTEGER FOR I%=1 TO R FOR J%=1 TO C K%=(I%-1)*C + J% Dat(I%,J%)=READ$(K%) B$=B$+Dat(I%,J%)+$TAB NEXT B$=B$+$CRLF NEXT MSGBOX B$,,"Original Unsorted Data:" DATA "Hans","Jensen","34","Copenhagen" DATA "Hans","Jensen","6","Paris" DATA "Erik","Jensen","47","London" DATA "Peter","Jensen","23","New York" DATA "John","Jensen","9","Los Angeles" DATA "John","Andersen","46","Stockholm" DATA "Hans","Andersen","21","Oslo" DATA "Jack","Andersen","36","Berlin" DATA "John","Andersen","7","Copenhagen" DATA "Hans","Carlsen","33","Paris" DATA "Peter","Carlsen","34","London" DATA "Niels","Carlsen","28","New York" DATA "Hans","Carlsen","33","New York" DATA "Hans","Carlsen","64","Los Angeles" DATA "Erik","Carlsen","26","Stockholm" DATA "John","Smith","45","Oslo" DATA "John","Smith","65","Berlin" DATA "Hans","Smith","35","Los Angeles" DATA "John","Smith","45","Stockholm" DATA "Carl","Smith","36","Oslo" 'Prio(0,n) holds the n-th sorting priority variable number 'Prio(1,n) holds information on whether the n'th sorting ' priority variable should be sorted as ' a STRING (value=0) or as ' a NUMERIC value (value=1) 'Prio(2,n) holds information on whether the n'th sorting ' priority variable should be sorted ' ASCENDING (value=1) or DESCENDING (value=-1) Prio(0,1)=2 ' 1st priority sorting variable is number 2 Prio(1,1)=0 ' STRING Prio(2,1)=1 ' ascending Prio(0,2)=1 ' 2nd priority sorting variable is number 1 Prio(1,2)=0 ' STRING Prio(2,2)=1 ' ascending Prio(0,3)=3 ' 3rd priority sorting variable is number 3 Prio(1,3)=1 ' NUMERIC Prio(2,3)=-1 ' descending Prio(0,4)=4 ' 4th priority sorting variable is number 4 Prio(1,4)=0 ' STRING Prio(2,4)=1 ' ascending t1 = TIMER ' START TIME OF SORTING CALL POSISORT (BYREF Dat(),BYREF Indx(), BYVAL C,BYVAL R, _ BYREF Prio()) t2 = TIMER ' END TIME OF SORTING B$="" FOR I%=1 TO R K%=Indx(I%) FOR J%=1 TO C B$=B$+Dat(K%,J%)+$TAB NEXT B$=B$+$CRLF NEXT MSGBOX B$,,"Sorted Data:" MSGBOX FORMAT$(1000 * (t2 - t1), "# ms"),,"Sorting time:" END FUNCTION SUB POSISORT (BYREF A() AS STRING ,BYREF Indx() AS INTEGER, BYVAL C AS INTEGER,BYVAL R AS INTEGER,BYREF Prio() AS INTEGER) ' This is a modification of a pointer sort routine ' published by Hewlett Packard in the HP BASIC Program Library ' Handbook many years ago. ' The pointer chain is being replaced by an index showing ' the place where the row should be when the ' data are being displayed after sorting. ' Code for ascending and descending sorting has been added. ' Code for string and numerical sorting has also been added. DIM Depth(18) AS LOCAL INTEGER DIM Chain(R) AS LOCAL INTEGER LOCAL Row%,B%,G%,D%,E%,F%,De%,J%,X%,fl%,I%,K% K%=0 DO INCR K% IF K%=C THEN EXIT DO IF Prio(0,K%+1)=0 THEN EXIT DO LOOP 'MSGBOX STR$(K%) fl%=0 FOR Row% = 1 TO R B% = Row% Chain(Row%) = Row% FOR De% = 1 TO 18 G% = Depth(De%) IF G% = 0 THEN IF Row% = R THEN GOTO HopToNext ' next w Depth(De%) = B% fl%=1 EXIT FOR END IF fl%=0 D% = B%: E% = B%: F% = B% DoAgain : FOR J%=1 TO K% IF Prio(2,J%)=1 THEN ' ascending IF Prio(1,J%)=0 THEN ' string IF A(D%,Prio(0,J%)) < A(G%,Prio(0,J%)) THEN GOTO GoingDown IF A(D%,Prio(0,J%)) > A(G%,Prio(0,J%)) THEN GOTO GoingUp ELSE ' numerical IF VAL(A(D%,Prio(0,J%))) < VAL(A(G%,Prio(0,J%))) THEN GOTO GoingDown IF VAL(A(D%,Prio(0,J%))) > VAL(A(G%,Prio(0,J%))) THEN GOTO GoingUp END IF ELSE ' descending IF Prio(1,J%)=0 THEN ' string IF A(D%,Prio(0,J%)) > A(G%,Prio(0,J%)) THEN GOTO GoingDown IF A(D%,Prio(0,J%)) < A(G%,Prio(0,J%)) THEN GOTO GoingUp ELSE ' numerical IF VAL(A(D%,Prio(0,J%))) > VAL(A(G%,Prio(0,J%))) THEN GOTO GoingDown IF VAL(A(D%,Prio(0,J%))) < VAL(A(G%,Prio(0,J%))) THEN GOTO GoingUp END IF END IF NEXT IF E% < 0 THEN GOTO GoingDown GoingUp: E% = -E% IF D% = F% THEN B% = G% ELSE Chain(F%) = G% F% = D% END IF D% = G% G% = F% GoingDown: F% = D% D% = Chain(D%) IF D% <> F% THEN GOTO DoAgain Chain(F%) = G% Depth(De%) = 0 HopToNext: NEXT IF fl%=0 THEN EXIT FOR ' finished fl%=0 NEXT ' The chain pointer is now being replaced by an index. J% = B% ' = the place of the first value in the chain ' which points to the next and so on. Indx(1) = B% FOR X% = 2 TO R J% = Chain(J%) Indx(X%) = J% NEXT ERASE Chain END SUB

[This message has been edited by Erik Christensen (edited February 11, 2001).]