Wayne, I believe the RippleSort proc. is also called BubbleSort, B
------------------
mailto:[email protected][email protected]</A>
------------------
mailto:[email protected][email protected]</A>
' a() is a random array, index() is an array of ' subscripts into a(). This code sorts index() ' so that a(index()) is in order; it leaves a() ' itself alone. It compares only elements of a() ' and swaps the index array instead. ' Tested on PBDOS and PBCC. I don't have PBDLL ' but changing print to messagebox should fix it. function pbmain %N = 20 'a(0 to %N-1) %M = %N - 1 dim a(%N) as long 'given array dim v as long 'same type as a() dim index(%N) as long 'an array of subscripts 1,2,3,... dim i as long, j as long, k as long 'CREATE INITIAL INDEX() for i = 0 to %N - 1 index(i) = i 'could be in any order just so next 'numbers are unique, 0 to %N - 1 'CREATE A RANDOM ARRAY a() AND PRINT IT randomize timer for i = 0 to %N - 1 a(i) = rnd*%N print a(i); next print 'SHELL SORT K = 1 'initialize K do K = 2*K + 1 'contrary to some literature, loop until K > %N '2* is better than 3* do K = K\2 for i = K to %M v = a(index(i)) j = i do while a(index(j - K)) > v swap index(j), index(j - K) j = j - K loop until j < K next i loop until K <= 1 'PRINT SORTED ARRAY for i = 0 to %N - 1 print a(index(i)); next waitkey$ end function
' Comparison of PB ARRAY SORT ' with ASSEMBLER INDEXED SHELL SORT. ' For PBDOS (16 bit word). defint a-z %N = 16000 'number of elements in a (0 to %N - 1) 'it must be less than half of 32767 dim a(%N) 'a given array of random numbers dim savea(%N) 'to save between sorts dim index(%N) 'an array of subscripts 1,2,3,... N = %N segIndex% = varseg(index(0)) 'varptr is 0 segA% = varseg(a(0)) 'varptr is 0 cls 'CREATE ARRAY randomize timer 'make a random array a(), print it for i = 0 to N - 1 a(i) = rnd*N savea(i) = a(i) ' print a(i); 'optional printout next print 'PB ARRAY SORT mtimer 'start microsecond timer array sort a(0) for N x& = mtimer print "PB array sort: ";x&;" microseconds 'for i=0 to N-1 'optional printout ' print a(i); 'next 'RESTORE ARRAY for i=0 to N - 1 a(i)=savea(i) next 'SHELL SORT mtimer 'start microsecond timer ! push ds ;save registers for BASIC ! push es ; These, and the pops at the end, ! push si ; are the only push-pops used. ! push di ! push bp ! mov dx,N ;get N ! mov ax,segIndex% ;get segments ! mov bx,segA% ! mov ds,bx ;es is segment of index() ! mov es,ax ;ds is segment of a() ! xor ax,ax ;initialize index() ! xor di,di ; Note: this needs to be done only once ! mov cx,dx ; for repeated sorts, if N does not change. indexloop: ' between sorts. All that is needed are ! stosw ; unique integers 0 to N - 1 in any order. ! inc ax ! loopnz indexloop ;could switch es and ds for rest of code ! mov cx,1 ;compute initial compare gap initK: ! add cx,cx ! inc cx ! cmp cx,dx ! jle initK ! dec dx ;dx = N - 1, never changes ! add dx,dx ;since we double every pointer into integer ' arrays and dx will be compared with pointers doloop: !shr cx,1 ;new cx = old cx\2 !add cx,cx ;double it !mov di,cx ;di points into index forloop: 'for di = cx to N - 1 !mov bx,es:[di] ;index(i) !add bx,bx ;double it !mov bp,ds:[bx] ;bp = a(index(di)) !mov bx,di ;bx = di, bx points into index innerloop: !mov si,bx !sub si,cx ;bx-cx, si points into index !mov si,es:[si] ;index(bx-cx) !add si,si ;double it !cmp ds:[si],bp ;if a(index(bx-cx))<=bp then endloop !jle endinnerloop !mov si,bx ;swap index(bx),index(bx-cx) !sub si,cx ;bx-cx !mov bx,es:[bx] ;will need to restore bx later, !mov ax,es:[si] ; use bx to avoid push pop of another reg !mov es:[si],bx ; !mov bx,si ;restore bx !add bx,cx ; !mov es:[bx],ax ; !mov bx,si ;decr bx,cx !cmp bx,cx !jge innerloop ;loop if bx >= cx endinnerloop: !add di,2 ;next di, double increment !cmp di,dx !jle forloop ;loop if di<=N-1 !shr cx,1 ;undouble cx !cmp cx,1 !jg doloop ;loop until cx<=1 ! pop bp ;restore registers for PowerBASIC ! pop di ! pop si ! pop es ! pop ds x& = mtimer 'print microsecond timer print "Assember sort: ";x&;" microseconds 'CHECK THAT A() IS REALLY SORTED b = a(index(0)) 'print a() using sorted index() 'print b; 'first -- optional printout for i = 1 to N - 1 'second to end bb = a(index(i)) if bb < b then print "It's not sorted." ' print bb; 'optional printout b = bb next
FUNCTION SortArrayData(OPTIONAL BYVAL lRow AS LONG) EXPORT AS LONG DIM lCount AS LONG DIM lTop AS LONG DIM lBot AS LONG DIM lMin AS LONG DIM lMid AS LONG DIM lMax AS LONG DIM lValue AS LONG lBot = UBOUND(ArrayData) ASM mov edx,lBot ASM and edx,edx ASM jz DoneSorting ;check for zero element ASM js DoneSorting ;check for sign ASM mov eax,1 ASM push eax ASM push edx ASM inc lCount WHILE lCount ASM pop eax ASM mov lBot,eax ASM mov lMax,eax ASM pop edx ASM mov lTop,edx ASM mov lMin,edx ASM add eax,edx ASM shr eax,1 ASM mov lMid,eax ASM dec lCount lValue = ArrayData(lMid) WHILE (lMin <= lMax) REM scan for minimum value WHILE (ArrayData(lMin) < lValue) AND (lMin < lBot) ASM inc lMin WEND REM scan for maximum value WHILE (ArrayData(lMax) > lValue) AND (lMax > lTop) ASM dec lMax WEND REM swap array data IF (lMin <= lMax) THEN IF ISFALSE(ArrayData(lMin).lValue = ArrayData(lMax).lValue) THEN SWAP ArrayData(lMin),ArrayData(lMax) REM track row number IF (lRow = lMin) THEN lRow = lMax:EXIT IF IF (lRow = lMax) THEN lRow = lMin:EXIT IF END IF ASM inc lMin ASM dec lMax END IF WEND REM add bottom range IF (lMin < lBot) THEN ASM mov eax,lMin ASM push eax ASM mov eax,lBot ASM push eax ASM inc lCount END IF REM add top range IF (lMax > lTop) THEN ASM mov eax,lTop ASM push eax ASM mov eax,lMax ASM push eax ASM inc lCount END IF WEND DoneSorting: FUNCTION = lRow END FUNCTION
Declare sub sortarraydata() %N = 16000 Dim arraydata(%N) As integer 'non-negative integers shared arraydata() randomize timer For i = 1 To %N arraydata(i) = Rnd*%N ' print arraydata(i); 'optional printout Next Print mtimer sortarraydata ' For i = 1 To %N 'optional printout ' Print arraydata(i); ' Next Print x& = mTimer Print x& stop sub SortArrayData Dim lCount As word Dim lTop As word Dim lBot As word Dim lMin As word Dim lMid As word Dim lMax As word Dim lValue As word Dim lrow As word lBot = UBound(ArrayData) 'assume > 0 ! mov dx,lBot ! and dx,dx ! mov ax,1 ! push ax ! push dx ! inc lCount While lCount ! pop ax ! mov lBot,ax ! mov lMax,ax ! pop dx ! mov lTop,dx ! mov lMin,dx ! add ax,dx ! shr ax,1 ! mov lMid,ax ! dec lCount lValue = ArrayData(lMid) While lMin <= lMax ' scan for minimum value While ArrayData(lMin) < lValue And lMin < lBot ! inc lMin Wend ' scan for maximum value While ArrayData(lMax) > lValue And lMax > lTop ! dec lMax Wend ' swap array data If lMin <= lMax Then If ArrayData(lMin) <> ArrayData(lMax) Then Swap ArrayData(lMin),ArrayData(lMax) ' track row number If lRow = lMin Then lRow = lMax :Exit If If lRow = lMax Then lRow = lMin :Exit If End If ! inc lMin ! dec lMax End If Wend ' add bottom range If lMin < lBot Then ! mov ax,lMin ! push ax ! mov ax,lBot ! push ax ! inc lCount End If ' add top range If lMax > lTop Then ! mov ax,lTop ! push ax ! mov ax,lMax ! push ax ! inc lCount End If Wend End sub
We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.
By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.
Comment