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

ShakerSort - sorting without exchange of equal data

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

  • ShakerSort - sorting without exchange of equal data

    ' shakersort - sorting without exchange of equal data.

    ' many sorting methods - including powerbasic's array sort -
    ' exchange data even if they are equal. if you want to avoid
    ' this, you can apply the following method. it is a modified
    ' version of the old bubblesort. it is not very fast, but it
    ' does this specific job.
    '
    ' december 10th, 2003 ----- erik christensen ------ e.chr@email.dk
    '
    ' p.s. this was inspired by the following link in the pb windows forum:
    http://www.powerbasic.com/support/pb...ead.php?t=9486
    Code:
    #compile exe
    #register none
    #dim all
    '
    sub shakersort(byref stringarray() as string, byref numarray() as single, byval n as long)
       ' a bubblesort modified for passing through the data in alternate directions.
       local l&,r&,i&,sw&
       '
       l = 1
       r = n - 1
       '
       do
          sw = 0
          for i = l to r
             if numarray(i) > numarray(i + 1) then
                swap numarray(i), numarray(i + 1)
                swap stringarray(i), stringarray(i + 1)
                sw = i
             end if
          next i
          '
          r = sw
          for i = r to l step -1
             if numarray(i) > numarray(i + 1) then
                swap numarray(i), numarray(i + 1)
                swap stringarray(i), stringarray(i + 1)
                sw = i
             end if
          next i
          '
          l = sw
       loop until sw = 0 'loop until no exchanges occur
    end sub
    '
    function pbmain()
        local i&,j&,k&,t$
        local n as long
        n = 10
        dim dataarray1(1:n) as single
        dim dataarray2(1:n) as string
        dataarray1(1)= 100 : dataarray2(1) ="100 first"
        dataarray1(2)= 100 : dataarray2(2) ="100 second"
        dataarray1(3)= 100 : dataarray2(3) ="100 third"
        dataarray1(4)= 20  : dataarray2(4) ="20 first"
        dataarray1(5)= 20  : dataarray2(5) ="20 second"
        dataarray1(6)= 400 : dataarray2(6) ="400 first"
        dataarray1(7)= 400 : dataarray2(7) ="400 second"
        dataarray1(8)= 50  : dataarray2(8) ="50 first"
        dataarray1(9)= 50  : dataarray2(9) ="50 second"
        dataarray1(10)=50  : dataarray2(10)="50 third"
        t$ = "unsorted data:"+$crlf+$crlf
        for i=1 to n
            t$=t$+str$(dataarray1(i))+$tab+dataarray2(i)+$crlf
        next
        call shakersort(dataarray2(),dataarray1(),n)
        t$ = t$ +$crlf+$crlf + "sorted data:"+$crlf+$crlf
        for i=1 to n
            t$=t$+str$(dataarray1(i))+$tab+dataarray2(i)+$crlf
        next
        msgbox t$,,"sorting without exchanging equal sorting data"
    end function

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




    [this message has been edited by erik christensen (edited december 10, 2003).]

  • #2
    ' ShakerSortIndex - index sorting without exchange of equal data.
    '
    ' Naturally you can also use ShakerSort slightly modified for index
    ' sorting as shown in this example. Index sorting has the advantage
    ' that data themselves are not swapped. Only the index-values are
    ' being swapped. The original positions of the data are maintained.
    ' This is a great advantage if data are arranged in large two
    ' dimensional arrays, because the task of swapping full rows or
    ' columns may be considerable and take a lot of time.
    ' After sorting, the index, which holds the sequence, needs
    ' to be used when working with the sorted data and when displaying
    ' them.
    '
    ' December 14th, 2003 ----- Erik Christensen ----- e.chr@email.dk
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    '
    SUB ShakerSortIndex(BYREF NumArray() AS SINGLE, BYREF Index() AS LONG, BYVAL N AS LONG)
       ' A BubbleSort modified for passing through the data in alternate directions.
       ' Modified for index sorting.
       LOCAL L&,R&,i&,Sw&
       '
       L = 1
       R = N - 1
       '
       DO
          Sw = 0
          FOR i = L TO R
             IF NumArray(Index(i)) > NumArray(Index(i + 1)) THEN
                SWAP Index(i), Index(i + 1)
                Sw = i
             END IF
          NEXT i
          '
          R = Sw
          FOR i = R TO L STEP -1
             IF NumArray(Index(i)) > NumArray(Index(i + 1)) THEN
                SWAP Index(i), Index(i + 1)
                Sw = i
             END IF
          NEXT i
          '
          L = Sw
       LOOP UNTIL Sw = 0 'Loop until no exchanges occur
    END SUB
    '
    FUNCTION PBMAIN()
        LOCAL I&,J&,K&,t$
        LOCAL N AS LONG
        N = 10
        DIM Index(1:N) AS LONG
        DIM DataArray1(1:N) AS SINGLE
        DIM DataArray2(1:N) AS STRING
        DataArray1(1)= 100 : DataArray2(1) ="100 first"
        DataArray1(2)= 100 : DataArray2(2) ="100 second"
        DataArray1(3)= 100 : DataArray2(3) ="100 third"
        DataArray1(4)= 20  : DataArray2(4) ="20 first"
        DataArray1(5)= 20  : DataArray2(5) ="20 second"
        DataArray1(6)= 400 : DataArray2(6) ="400 first"
        DataArray1(7)= 400 : DataArray2(7) ="400 second"
        DataArray1(8)= 50  : DataArray2(8) ="50 first"
        DataArray1(9)= 50  : DataArray2(9) ="50 second"
        DataArray1(10)=50  : DataArray2(10)="50 third"
        FOR I = 1 TO N : Index(I) = I : NEXT
        t$ = "Unsorted data:"+$CRLF+$CRLF
        FOR I=1 TO N
            t$=t$+STR$(DataArray1(I))+$TAB+DataArray2(I)+$CRLF
        NEXT
        CALL ShakerSortIndex(DataArray1(),Index(),N)
        t$ = t$ +$CRLF+$CRLF + "Sorted data:"+$CRLF+$CRLF
        FOR I=1 TO N
            t$=t$+STR$(DataArray1(Index(I)))+$TAB+DataArray2(Index(I))+$CRLF
        NEXT
        MSGBOX t$,,"Sorting without exchanging equal sorting data"
    END FUNCTION

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

    Comment

    Working...
    X