 links |
 rechts |
 zurück |
 vor |
 oben |
 unten |
DD-Software.Array
Add this page to your favorites
Save this document
|
|
|
DD380900.HTM DD-Software.Array Add this page to your favorites Save this document |
|
|
||||
|
||||
Array Sort Functions
;==========================================================================================================================================
; Collection of Array Sort algorithms including bonus tools.
; Adapted to WinBatch by Detlev Dalitz.20010720.20020718.20020823.20030222.20040325
;------------------------------------------------------------------------------------------------------------------------------------------
; udfArrPartSort (aArray) ; From slow
; udfArrBubbleSort (aArray) ; I
; udfArrInsertSort (aArray) ; I
; udfArrQuickSortNR (aArray) ; I ; QuickSort Non Recursive.
; udfArrShellSort (aArray) ; I
; udfArrShellMetznerSort (aArray) ; I
; udfArrHeapSort (aArray) ; I
; udfArrShellSortK (aArray) ; I
; udfArrQuickSortR (aArray) ; I ; QuickSort Recursive.
; udfArrItemSort (aArray, sDelimiter, iDirection) ; v
; udfArrBinSort (aArray, iDirection) ; to fast ?
; udfArrDistributionSort (aArray, iKeyCount) ; Special hash sort.
;------------------------------------------------------------------------------------------------------------------------------------------
; udfArrFileWrite (aArray, sFilename) ; Unload array to diskfile ; Returns filesize.
; udfArrFileRead (sFilename) ; Load aArray from diskfile ; Returns new array.
;------------------------------------------------------------------------------------------------------------------------------------------
; udfArrDump (aArray, sDelimiter) ; For testing dim-1 array ; Returns string.
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrpartsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrpartsort
#DefineFunction udfArrPartSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iHigh = iHigh-1
iLow = 0
iDone = 0
While !iDone
iDone = 1
For i=iLow To iHigh
If (aArray[i]>aArray[i+1])
aA = aArray[i]
aArray[i] = aArray[i+1]
aArray[i+1] = aA
iDone = 0
EndIf
Next
EndWhile
Return (aArray)
#EndFunction
:skip_udfarrpartsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrbubblesort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrbubblesort
#DefineFunction udfArrBubbleSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
ikHigh = Max(0,ArrInfo(aArray,1)-1)
iHigh = ikHigh-1
iLow = 0
For i=iLow To iHigh
ikLow = i+1
For k=ikLow To ikHigh
If (aArray[i]>aArray[k])
aA = aArray[i]
aArray[i] = aArray[k]
aArray[k] = aA
EndIf
Next
Next
Return (aArray)
#EndFunction
:skip_udfarrbubblesort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrinsertsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrinsertsort
#DefineFunction udfArrInsertSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
iiLow = 1+iLow
For i=iiLow To iHigh
aA = aArray[i]
ikHigh = i-1
For k=ikHigh To iLow By -1
If (aArray[k]<=aA) Then Break
aArray[k+1] = aArray[k]
Next
aArray[k+1] = aA
Next
Return (aArray)
;..........................................................................................................................................
; InsertSort algorithm adapted from:
; 'Sorting and Searching Algorithms, Thomas Niemann, ePaperPress, sortsearch.pdf, 12.05.2002 13:50:30'.
;..........................................................................................................................................
#EndFunction
:skip_udfarrinsertsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrshellsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrshellsort
#DefineFunction udfArrShellSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
iStart = Floor(Loge(Max(iHigh,2)-1)/Loge(2))
For i=iStart To 0 By -1
iStep = Exp(i*Loge(2))
For k=iStep To iHigh
aA = aArray[k]
iZ = k-iStep
iDone = (aA>=aArray[iZ])
While !iDone
aArray[iZ+iStep] = aArray[iZ]
iZ = iZ-iStep
iDone = 1
If (iZ>0) Then iDone = (aA>=aArray[iZ])
EndWhile
aArray[iZ+iStep] = aA
Next
Next
Return (aArray)
;..........................................................................................................................................
; Note:
; Using code fragment (B) instead of fragment (A) in the inner While loop
; tunes up the performance speed of this ShellSort implementation of about >=10 Pct.!
; (A)
; If (iZ>0)
; iDone = (aA>=aArray[iZ])
; Else
; iDone = 1
; EndIf
; (B)
; iDone = 1
; If (iZ>0) Then iDone = (aA>=aArray[iZ])
;..........................................................................................................................................
; ShellSort, developed by Donald L. Shell, is a non-stable in-place sort.
; ShellSort improves on the efficiency of insertion sort by quickly shifting values to their destination.
; For further reading, consult:
; Knuth, Donald. E. [1998]. The Art of Computer Programming, Volume 3,
; Sorting and Searching. Addison-Wesley, Reading, Massachusetts.
;..........................................................................................................................................
#EndFunction
:skip_udfarrshellsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrshellsortm",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrshellsortm
#DefineFunction udfArrShellSortM (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = ArrInfo(aArray,1)-1
iLow = 0
iMid = (iHigh-iLow+1)/2
While iMid
iTop = iHigh-iMid
For ii=iLow To iTop
ik = ii+iMid
If (aArray[ii]>aArray[ik])
aA = aArray[ii]
aArray[ii] = aArray[ik]
aArray[ik] = aA
EndIf
Next
For ii=iTop To iLow By -1
ik = ii+iMid
If (aArray[ii]>aArray[ik])
aA = aArray[ii]
aArray[ii] = aArray[ik]
aArray[ik] = aA
EndIf
Next
iMid = iMid/2
EndWhile
Return (aArray)
;..........................................................................................................................................
; This sorting algorithm is extremely efficient for sorting small and medium sized arrays.
;
; Adapted from a VBA routine in Woody's Office Watch, 1998, Vol. 3, No. 51,
; http://www.woodyswatch.com/office/
;
; "Diminishing increment sort" algorithm by Donald Lewis Shell resp. Marlene Metzner.
; First called Shell-Metzner in an article in Creative Computing in 1976, after Marlene Metzner.
; See also: Donald Lewis Shell, A High-Speed Sorting Procedure, CACM, 2(7):30-32, July 1959.
;
; This algorithm was improperly called the Shell-Metzner sort
; by John P. Grillo, A Comparison of Sorts, Creative Computing, 2:76-80, Nov/Dec 1976.
; On 3 April 2003 Marlene Metzner Norton wrote:
; "I had nothing to do with the sort, and my name should never have been attached to it."
;
;..........................................................................................................................................
#EndFunction
:skip_udfarrshellsortm
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrshellsortk",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrshellsortk
#DefineFunction udfArrShellSortK (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iElements = ArrInfo(aArray,1)
iArrayHigh = Max(0,iElements-1)
iArrayLow = 0
; Establish increment sequence (recommended by Knuth, due to Sedgewick).
aStep = ArrDimension(28) ; 28 elements in aStep fit for (2**31)-1 elements in aArray.
p1 = 1
p2 = 1
p3 = 1
s = -1
While 1
s = s+1
If (s mod 2)
aStep[s] = 1+(8*p1)-(6*p2)
Else
aStep[s] = 1+(9*p1)-(9*p3)
p2 = 2*p2
p3 = 2*p3
EndIf
p1 = 2*p1
If (3*aStep[s]>=iElements) Then Break
EndWhile
If (s>0) Then s = s-1
; ShellSort
While (s>=0)
iStep = aStep[s]
iiLow = iArrayLow + iStep
For i=iiLow To iArrayHigh
aA = aArray[i]
ikLow = i-iStep
For k=ikLow To iArrayLow By -iStep
If !(aArray[k]>aA) Then Break
aArray[k+iStep] = aArray[k]
Next
aArray[k+iStep] = aA
Next
s = s-1
EndWhile
Drop(aStep)
Return (aArray)
;..........................................................................................................................................
; ShellSort algorithm with Knuth's increment sequence adapted from the Visual Basic example in
; 'Sorting and Searching Algorithms, Thomas Niemann, ePaperPress, sortsearch.pdf, 12.05.2002 13:50:30'.
;..........................................................................................................................................
; ShellSort, developed by Donald L. Shell, is a non-stable in-place sort.
; ShellSort improves on the efficiency of insertion sort by quickly shifting values to their destination.
; For further reading, consult:
; Knuth, Donald. E. [1998]. The Art of Computer Programming, Volume 3,
; Sorting and Searching. Addison-Wesley, Reading, Massachusetts.
;..........................................................................................................................................
#EndFunction
:skip_udfarrshellsortk
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrheapsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrheapsort
#DefineFunction udfArrHeapSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iN = ArrInfo(aArray,1)
iR = iN
iM = (iN/2)-1
For i=iM To 0 By -1
iL = i
aA = aArray[iL]
While (iL<(iR/2))
iNext = iL+iL+1
If ((iNext+1)<iR) Then If (aArray[iNext]<aArray[iNext+1]) Then iNext = iNext+1
If (aA>=aArray[iNext]) Then Break
aArray[iL] = aArray[iNext]
iL = iNext
EndWhile
aArray[iL] = aA
Next
While (iN>1)
aA = aArray[0]
aArray[0] = aArray[iN-1]
aArray[iN-1] = aA
iN = iN-1
iR = iN
iL = 0
aA = aArray[iL]
While (iL<(iR/2))
iNext = iL+iL+1
If ((iNext+1)<iR) Then If (aArray[iNext]<aArray[iNext+1]) Then iNext = iNext+1
If (aA>=aArray[iNext]) Then Break
aArray[iL] = aArray[iNext]
iL = iNext
EndWhile
aArray[iL] = aA
EndWhile
Return (aArray)
;..........................................................................................................................................
; Heapsort Algorithm adapted from:
; 'Algorithmen und Datenstrukturen, Prof. Dr. Gerald Timmer, 1998-11-06, Fachhochschule Osnabrück'.
; Reference: 'http://gtsun.et.fh-osnabrueck.de/lehre/algorithmen/alds-skript/node20.html'.
;
; Detlev Dalitz.20020822
;..........................................................................................................................................
#EndFunction
:skip_udfarrheapsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrquicksortnr",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrquicksortnr
#DefineFunction udfArrQuickSortNR (aArray) ; Non recursive QuickSort.
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
aStackLeft = ArrDimension(100)
aStackRight = ArrDimension(100)
aStackLeft[1] = iLow
aStackRight[1] = iHigh
iStack = 1
While (iStack>0)
If (aStackLeft[iStack]>=aStackRight[iStack])
iStack = iStack-1
Else
iL = aStackLeft[iStack]
iR = aStackRight[iStack]
aPivot = aArray[iR]
iMid = (iL+iR)/2
If ((iR-iL)>5)
If ((aArray[iMid]<aPivot) && (aArray[iMid]>aArray[iL])) || ((aArray[iMid]>aPivot) && (aArray[iMid]<aArray[iL]))
aA = aArray[iMid]
aArray[iMid] = aArray[iR]
aArray[iR] = aA
EndIf
Else
If ((aArray[iL]<aArray[iMid]) && (aArray[iL]>aPivot)) || ((aArray[iL]>aArray[iMid]) && (aArray[iL]<aPivot))
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
EndIf
EndIf
aPivot = aArray[iR]
While (iL<iR)
While (aArray[iL]<aPivot)
iL = iL+1
EndWhile
iR = iR-1
While ((iL<iR) && (aPivot<aArray[iR]))
iR = iR-1
EndWhile
If (iL<iR)
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
EndIf
EndWhile
iR = aStackRight[iStack]
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
If ((iL-aStackLeft[iStack])>=(aStackRight[iStack]-iL))
aStackLeft[iStack+1] = aStackLeft[iStack]
aStackRight[iStack+1] = iL-1
aStackLeft[iStack] = iL+1
Else
aStackLeft[iStack+1] = iL+1
aStackRight[iStack+1] = aStackRight[iStack]
aStackRight[iStack] = iL-1
EndIf
iStack = iStack+1
EndIf
EndWhile
Drop(aStackLeft,aStackRight)
Return (aArray)
#EndFunction
:skip_udfarrquicksortnr
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrquicksortr",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrquicksortr
#DefineFunction udfArrQuickSortR (aArray) ; Recursive QuickSort.
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
udfArrQSortR(aArray,iLow,iHigh)
Return (aArray)
#EndFunction
#DefineFunction udfArrQSortR (aArray, iLow, iHigh)
; This function "udfArrQSortR" should be called first only from inner "udfArrQuickSortR" or by itself!
If (iLow<iHigh)
aPivot = aArray[(iLow+iHigh)/2]
iL = iLow
iR = iHigh
While (iL<=iR)
While (aArray[iL]<aPivot)
iL = iL+1
EndWhile
While (aPivot<aArray[iR])
iR = iR-1
EndWhile
If (iL<=iR)
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
iL = iL+1
iR = iR-1
EndIf
EndWhile
udfArrQSortR(aArray,iLow,iR)
udfArrQSortR(aArray,iL,iHigh)
EndIf
Return (aArray)
#EndFunction
:skip_udfarrquicksortr
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemsort
#DefineFunction udfArrItemSort (aArray, sDelimiter, iDirection)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
If (VarType(aArray[0])<>2) Then Return (aArray) ; Only strings wanted.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
sSort = ""
For i=iLow To iHigh
sSort = ItemInsert(aArray[i],-1,sSort,sDelimiter)
Next
sSort = ItemSort(sSort,sDelimiter)
Select iDirection
Case @ASCENDING
Drop(aArray)
aArray = Arrayize(sSort,sDelimiter)
Break
Case @DESCENDING
For i=iHigh To iLow By -1
aArray[iHigh-i] = ItemExtract(i+1,sSort,sDelimiter)
Next
Break
EndSelect
Return (aArray)
;..........................................................................................................................................
; Sort parameter:
; iDirection=@ASCENDING
; iDirection=@DESCENDING
;..........................................................................................................................................
;..........................................................................................................................................
; Note:
; Using code fragment (B) instead of fragment (A) for writing sorted items back to array
; tunes up the performance speed of the ascending sort implementation of about 30 Pct.!
; (A)
; For i=iLow To iHigh
; aArray[i] = ItemExtract(i+1,sSort,sDelimiter)
; Next
; (B)
; Drop(aArray)
; aArray = Arrayize(sSort,sDelimiter)
;..........................................................................................................................................
#EndFunction
:skip_udfarritemsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrbinsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrbinsort
#DefineFunction udfArrBinSort (aArray, iDirection)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
If (VarType(aArray[0])<>2) Then Return (aArray) ; Only strings wanted.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
iLengthMax = 0
For i=iLow To iHigh
iLengthMax = Max(iLengthMax,StrLen(aArray[i]))
Next
hBB = BinaryAlloc(iLengthMax*ArrInfo(aArray,1))
For i=iLow To iHigh
BinaryPokeStr(hBB,i*iLengthMax,aArray[i])
Next
BinarySort(hBB,iLengthMax,0,iLengthMax,@STRING|iDirection)
For i=iLow To iHigh
aArray[i] = BinaryPeekStr(hBB,i*iLengthMax,iLengthMax)
Next
BinaryFree(hBB)
Return (aArray)
;..........................................................................................................................................
; Sort parameter:
; iDirection=@ASCENDING
; iDirection=@DESCENDING
;..........................................................................................................................................
#EndFunction
:skip_udfarrbinsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrdistributionsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrdistributionsort
#DefineFunction udfArrDistributionSort (aArray, iKeyCount)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
; How many different keys exist?
; If fix number is known, then following computing is not necessary.
If !iKeyCount
sItemList = ""
For i=iLow To iHigh
If (ItemLocate(aArray[i],sItemList,@TAB)==0) Then sItemList = ItemInsert(aArray[i],-1,sItemList,@TAB)
Next
iKeyCount = ItemCount(sItemList,@TAB)
EndIf
aArrayBins = ArrDimension(iKeyCount)
aArrayStart = ArrDimension(iKeyCount)
aArraySave = ArrDimension(1+iHigh)
ArrInitialize(aArrayBins,0)
ArrInitialize(aArrayStart,0)
For i=iLow To iHigh
aArraySave[i] = aArray[i] ; Copy Array to ArraySave.
iIndexBins = (Max(0,Char2Num(aArray[i])-65)) ; Hier die entsprechende Abbildungsfunktion anwenden.
aArrayBins[iIndexBins] = 1+aArrayBins[iIndexBins] ; Count the number of each key value.
Next
; Compute the start position of each bin.
iPos = 0
iKeyHigh = iKeyCount-1
For i=1 To iKeyHigh
iPos = iPos + aArrayBins[i-1]
aArrayStart[i] = iPos
Next
; Deal the saved array back to the original.
For i=iLow To iHigh
iIndexSave = (Max(0,Char2Num(aArraySave[i])-65)) ; Hier die entsprechende Abbildungsfunktion anwenden.
StartIndex = aArrayStart[iIndexSave]
aArray[StartIndex] = (Num2Char(iIndexSave+65)) ; Hier die entsprechende _inverse_ Abbildungsfunktion anwenden.
aArrayStart[iIndexSave] = 1+aArrayStart[iIndexSave]
Next
Drop(aArrayBins,aArraySave,aArrayStart)
Return(aArray)
;..........................................................................................................................................
; Is this an example for ideal hashing?
;
; Adopted from Pascal source published by
; James L. Allison, 1703 Neptune Lane, Houston, Texas 77062, Dec 22, 1988.
; "This is a real screamer, but it takes a lot of space,
; and is hard to package for inclusion in a library.
; It requires prior knowledge of how the Array and keys are structured.
; It is only feasible where there are a small number of possible keys.
; In this example, there are only 256 different values.
; It works well, for example, where the key is sex, department or state.
; It would be a disaster if the keys were name or phone number."
;..........................................................................................................................................
#EndFunction
:skip_udfarrdistributionsort
;------------------------------------------------------------------------------------------------------------------------------------------
;====================================================================== |