Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Array Sort 3. Index sort or "in-place" sort

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Array Sort 3. Index sort or "in-place" sort

    ' 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
    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).]
Working...
X