;========================================================================================================================================== ; This is a performance test for sorting algorithms. ; ; Detlev Dalitz.20090519.20100122. ;========================================================================================================================================== ; ; udfArrayPartSortV1 (arrArray) ; udfArrayPartSortV2 (arrArray) ; ; udfArrayBubbleSortV1 (arrArray) ; udfArrayBubbleSortV2 (arrArray) ; ; udfArrayGnomeSort (arrArray) ; ; udfArrayMergeSortRB (arrArray, intLow, intHigh) ; RB=Recursive Bitonic. ; ; udfArrayMergeSortR (arrArray, intLow, intHigh) ; R=Recursive. ; ; udfArrayInsertSort (arrArray) ; ; udfArrayShellSort (arrArray) ; ; udfArrayShellSortMV1 (arrArray) ; M=Metzner. ; udfArrayShellSortMV2 (arrArray) ; M=Metzner. ; ; udfArrayQuickSortNRV1 (arrArray) ; NR=Non Recursive. ; udfArrayQuickSortNRV2 (arrArray) ; NR=Non Recursive. ; ; udfArrayHeapSort (arrArray) ; ; udfArrayShellSortL (arrArray) ; L=Lang. ; ; udfArrayShellSortK (arrArray) ; K=Knuth. ; ; udfArrayQuickSortRV1 (arrArray, intLow, intHigh) ; R=Recursive. ; udfArrayQuickSortRV2 (arrArray, intLow, intHigh) ; R=Recursive. ; ; udfArrayItemSort (arrArray, @ASCENDING) ; udfArrayItemSort (arrArray, @DESCENDING) ; ; udfArrayBinSort (arrArray, @ASCENDING) ; udfArrayBinSort (arrArray, @DESCENDING) ; ; udfArrayDistributionSort (arrArray, intKeyCount) ; Special hash sort. Bucketsort. ; ; udfItemListSortOrdinalV1 (strItemList, strDelimiter) ; udfItemListSortOrdinalV2 (strItemList, strDelimiter) ; udfItemListSortOrdinalV3 (strItemList, strDelimiter) ; udfItemListSortOrdinalV4 (strItemList, strDelimiter) ; ; udfItemListSortOrdinalV5 (strItemList, strDelimiter, @ASCENDING) ; udfItemListSortOrdinalV5 (strItemList, strDelimiter, @DESCENDING) ; ; udfItemListSortOrdinalV6 (strItemList, strDelimiter, @ASCENDING) ; udfItemListSortOrdinalV6 (strItemList, strDelimiter, @DESCENDING) ; ; udfItemListSortOrdinalV7 (strItemList, strDelimiter, @ASCENDING) ; udfItemListSortOrdinalV7 (strItemList, strDelimiter, @DESCENDING) ; ;========================================================================================================================================== ;========================================================================================================================================== ; Including some helper UDFs ;========================================================================================================================================== ; udfArrayUnloadToFile (arrArray, strFilename) ; Unload array to diskfile ; Returns filesize. ; udfArrayLoadFromFile (strFilename) ; Load arrArray from diskfile ; Returns new array. ;------------------------------------------------------------------------------------------------------------------------------------------ ; udfArrayDumptToItemList (arrArray, strDelimiter) ; For testing dim-1 array ; Returns string. ;------------------------------------------------------------------------------------------------------------------------------------------ ; udfItemListToFile (strFilename, strItemList, strDelimiter) ; The FilePut version. ;------------------------------------------------------------------------------------------------------------------------------------------ ; udfArrayAskRow (strTitle, arrArray, intSortMode, intSelectMode, intAskMode) ;========================================================================================================================================== ;========================================================================================================================================== ; Array sorting UDFs ;========================================================================================================================================== ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayPartSortV1 (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 2 intLow = 0 intDone = 0 While !intDone intDone = 1 For intI = intLow To intHigh If arrArray [intI] > arrArray [intI + 1] anyValue = arrArray [intI] arrArray [intI] = arrArray [intI + 1] arrArray [intI + 1] = anyValue intDone = 0 EndIf Next EndWhile Return arrArray #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayPartSortV2 (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 2 intLow = 0 intDone = 0 While !intDone intDone = 1 For intI = intLow To intHigh If arrArray [intI] > arrArray [intI + 1] ArraySwapElements (arrArray, intI, 0, 0, 0, 0, intI + 1, 0, 0, 0, 0) intDone = 0 EndIf Next EndWhile Return arrArray ;.......................................................................................................................................... ; This UDF "udfArrayPartSort2" needs minimal WinBatch version DLL 5.13bem, first showing up in WB 2007B. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayGnomeSort (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intI = 1 While intI < intElements If arrArray [intI - 1] <= arrArray [intI] intI = intI + 1 Else ArraySwapElements (arrArray, intI, 0, 0, 0, 0, intI - 1, 0, 0, 0, 0) intI = Max (1, intI - 1) EndIf EndWhile Return arrArray ;.......................................................................................................................................... ; Gnome Sort - The Simplest Sort Algorithm ; The simplest sort algorithm is not Bubble Sort..., it is not Insertion Sort..., it's Gnome Sort! ; Gnome Sort is based on the technique used by the standard Dutch Garden Gnome (Du.: tuinkabouter). ; Here is how a garden gnome sorts a line of flower pots. ; Basically, he looks at the flower pot next to him and the previous one; ; if they are in the right order he steps one pot forward, otherwise he swaps them and steps one pot backwards. ; Boundary conditions: if there is no previous pot, he steps forwards; if there is no pot next to him, he is done. ; Dick Grune / dick@cs.vu.nl / http://www.cs.vu.nl/~dick/gnomesort.html ; ; Ported and tuned to WinBatch by Detlev Dalitz.20090518. ;.......................................................................................................................................... ; This UDF "udfArrayGnomeSort" needs minimal WinBatch version DLL 5.13bem, first showing up in WB 2007B. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayBubbleSortV1 (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intKHigh = intElements - 1 intIHigh = intKHigh - 1 intILow = 0 For intI = intILow To intIHigh intKLow = intI + 1 For intK = intKLow To intKHigh If arrArray [intI] > arrArray [intK] anyValue = arrArray [intI] arrArray [intI] = arrArray [intK] arrArray [intK] = anyValue EndIf Next Next Return arrArray #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayBubbleSortV2 (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intKHigh = intElements - 1 intIHigh = intKHigh - 1 intILow = 0 For intI = intILow To intIHigh intKLow = intI + 1 For intK = intKLow To intKHigh If arrArray [intI] > arrArray [intK] Then ArraySwapElements (arrArray, intI, 0, 0, 0, 0, intK, 0, 0, 0, 0) Next Next Return arrArray ;.......................................................................................................................................... ; This UDF "udfArrayBubbleSort2" needs minimal WinBatch version DLL 5.13bem, first showing up in WB 2007B. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayMergeSortRB (arrArray, intLow, intHigh) If intLow < 0 || intHigh < 0 ; Initial array check at first call. If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 EndIf If intLow >= intHigh Then Return arrArray intMid = (intLow + intHigh) / 2 udfArrayMergeSortRB (arrArray, intLow, intMid) udfArrayMergeSortRB (arrArray, intMid + 1, intHigh) ; Bitonic Merge. arrTemp = ArrDimension (intHigh + 1) intI = intLow intK = intLow intJ = intHigh ; Copy first half of work array to temp array. While intI <= intMid arrTemp [intK] = arrArray [intI] intI = intI + 1 intK = intK + 1 EndWhile ; Copy second half of work array reverse to temp array. While intJ > intMid arrTemp [intK] = arrArray [intJ] intJ = intJ - 1 intK = intK + 1 EndWhile intI = intLow intK = intLow intJ = intHigh ; Copy back next greater element from temp array to work array until intI and intJ cross themselves. While intI <= intJ If arrTemp [intI] <= arrTemp [intJ] arrArray [intK] = arrTemp [intI] intI = intI + 1 intK = intK + 1 Else arrArray [intK] = arrTemp [intJ] intJ = intJ - 1 intK = intK + 1 EndIf EndWhile Drop (arrTemp) Return arrArray ;.......................................................................................................................................... ; Mergesort algorithm adopted from: ; 'H.W. Lang: Algorithmen in Java. Oldenbourg (2003)' ; http://www.iti.fh-flensburg.de/lang/algorithmen/algo.htm ; This is a unstable bitonic mergesort. Order = O(n log(n)). ; Always 1.5*n*log(n) steps, even if data is sorted, reversed or random distributed. ; Note: This algorithm needs additional memory for temp array (as complete first array). ;.......................................................................................................................................... ; Start sorting with: "udfArrayMergeSortRB (aArray, -1, -1)" ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayMergeSortR (arrArray, intLow, intHigh) If intLow < 0 || intHigh < 0 ; Initial array check at first call. If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 EndIf If intLow >= intHigh Then Return arrArray intMid = (intLow + intHigh) / 2 udfArrayMergeSortR (arrArray, intLow, intMid) udfArrayMergeSortR (arrArray, intMid + 1, intHigh) ; Merge. arrTemp = ArrDimension (intMid + 1) intI = 0 intJ = intLow ; Copy first half of work array to temp array. While intJ <= intMid arrTemp [intI] = arrArray [intJ] intI = intI + 1 intJ = intJ + 1 EndWhile intI = 0 intK = intLow ; Copy back next greater element from temp array to work array. While (intK < intJ) && (intJ <= intHigh) If arrTemp [intI] <= arrArray [intJ] arrArray [intK] = arrTemp [intI] intK = intK + 1 intI = intI + 1 Else arrArray [intK] = arrArray [intJ] intK = intK + 1 intJ = intJ + 1 EndIf EndWhile ; Copy back remaining elements from temp array to work array. While intK < intJ arrArray [intK] = arrTemp [intI] intK = intK + 1 intI = intI + 1 EndWhile Drop (arrTemp) Return arrArray ;.......................................................................................................................................... ; Mergesort algorithm adopted from: ; 'H.W. Lang: Algorithmen in Java. Oldenbourg (2003)' ; http://www.iti.fh-flensburg.de/lang/algorithmen/algo.htm ; Stable sort. Order = O(n log(n)). Maximum 1.5*n*log(n) steps. ; Note: This algorithm needs additional memory for temp array (half of first array). ;.......................................................................................................................................... ; Start sorting with: "udfArrayMergeSortR (arrArray, -1, -1)" ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayInsertSort (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intIHigh = intElements - 1 intILow = 1 intKLow = 0 For intI = intILow To intIHigh anyValue = arrArray [intI] intKHigh = intI - 1 For intK = intKHigh To intKLow By -1 If arrArray [intK] <= anyValue Then Break arrArray [intK + 1] = arrArray [intK] Next arrArray [intK + 1] = anyValue Next Return arrArray ;.......................................................................................................................................... ; InsertSort algorithm adapted from: ; 'Sorting and Searching Algorithms, Thomas Niemann, ePaperPress, sortsearch.pdf, 12.05.2002 13:50:30'. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayShellSort (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 intStart = Int (Floor (LogE (Max (intHigh, 2) - 1) / LogE (2))) For intI = intStart To intLow By -1 intStep = Int (Exp (intI * LogE (2))) For intK = intStep To intHigh anyValue = arrArray [intK] intZ = intK - intStep intDone = (anyValue >= arrArray [intZ]) While !intDone arrArray [intZ + intStep] = arrArray [intZ] intZ = intZ - intStep intDone = 1 If intZ > 0 Then intDone = (anyValue >= arrArray [intZ]) EndWhile arrArray [intZ + intStep] = anyValue Next Next Return arrArray ;.......................................................................................................................................... ; 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) ; intDone = (aA>=arrArray [iZ]) ; Else ; intDone = 1 ; EndIf ; (B) ; intDone = 1 ; If (iZ>0) Then intDone = (aA>=arrArray [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 ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayShellSortMV1 (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 intMid = (intHigh - intLow + 1) / 2 While intMid intTop = intHigh - intMid For intI = intLow To intTop intK = intI + intMid If arrArray [intI] > arrArray [intK] anyValue = arrArray [intI] arrArray [intI] = arrArray [intK] arrArray [intK] = anyValue EndIf Next For intI = intTop To intLow By -1 intK = intI + intMid If arrArray [intI] > arrArray [intK] anyValue = arrArray [intI] arrArray [intI] = arrArray [intK] arrArray [intK] = anyValue EndIf Next intMid = intMid / 2 EndWhile Return arrArray ;.......................................................................................................................................... ; 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 ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayShellSortMV2 (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 intMid = (intHigh - intLow + 1) / 2 While intMid intTop = intHigh - intMid For intI = intLow To intTop intK = intI + intMid If arrArray [intI] > arrArray [intK] Then ArraySwapElements (arrArray, intI, 0, 0, 0, 0, intK, 0, 0, 0, 0) Next For intI = intTop To intLow By -1 intK = intI + intMid If arrArray [intI] > arrArray [intK] Then ArraySwapElements (arrArray, intI, 0, 0, 0, 0, intK, 0, 0, 0, 0) Next intMid = intMid / 2 EndWhile Return arrArray ;.......................................................................................................................................... ; 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." ;.......................................................................................................................................... ; This UDF "udfArrayShellSortM2" needs minimal WinBatch version DLL 5.13bem, first showing up in WB 2007B. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayShellSortL (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 intC = 0 intH = 0 intI = 0 intJ = 0 intT = 0 arrCols = Arrayize ("1391376,463792,198768,86961,33936,13776,4592,1968,861,336,112,48,21,7,3,1", ",") For intC = 0 To 15 intH = arrCols [intC] For intI = intH To intHigh intJ = intI anyValue = arrArray [intJ] While @TRUE intT = intJ - intH If arrArray [intT] <= anyValue Then Break arrArray [intJ] = arrArray [intT] intJ = intT If intJ < intH Then Break EndWhile arrArray [intJ] = anyValue Next Next Drop (aCols) Return arrArray ;.......................................................................................................................................... ; Shellsort algorithm adopted from: ; 'H.W. Lang: Algorithmen in Java. Oldenbourg (2003)' ; http://www.iti.fh-flensburg.de/lang/algorithmen/algo.htm ;.......................................................................................................................................... ; h-sequence "1391376,463792,198768,86961,33936,13776,4592,1968,861,336,112,48,21,7,3,1" due to Sedgewick. ; R. Sedgewick: Analysis of Shellsort and Related Algorithms. ; In: Josep Díaz, Maria Serna (Eds.): ; Algorithms - ESA '96, Fourth Annual European Symposium, Barcelona, Lecture Notes in Computer Science, Vol. 1136, Springer, 1-1V1 (1996) ;.......................................................................................................................................... ; Start sorting with: "udfArrayshellSortL (arrArray)" ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayShellSortK (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. ; Establish increment sequence (recommended by Knuth, due to Sedgewick). arrStep = ArrDimension (28) ; 28 elements in arrStep fit for (2**31)-1 elements in arrArray. intP1 = 1 intP2 = 1 intP3 = 1 intS = -1 While @TRUE intS = intS + 1 If intS mod 2 arrStep [intS] = 1 + (8 * intP1) - (6 * intP2) Else arrStep [intS] = 1 + (9 * intP1) - (9 * intP3) intP2 = 2 * intP2 intP3 = 2 * intP3 EndIf intP1 = 2 * intP1 If 3 * arrStep [intS] >= intElements Then Break EndWhile If intS > 0 Then intS = intS - 1 ; ShellSort intArrHigh = intElements - 1 intArrLow = 0 While intS >= 0 intStep = arrStep [intS] intILow = intArrLow + intStep For intI = intILow To intArrHigh anyValue = arrArray [intI] intKLow = intI - intStep For intK = intKLow To intArrLow By -intStep If !(arrArray [intK] > anyValue) Then Break arrArray [intK + intStep] = arrArray [intK] Next arrArray [intK + intStep] = anyValue Next intS = intS - 1 EndWhile Drop (arrStep) Return arrArray ;.......................................................................................................................................... ; 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 ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayHeapSort (arrArray) If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intR = intElements intM = (intElements / 2) - 1 For intI = intM To 0 By -1 intL = intI anyValue = arrArray [intL] While (intL < (intR / 2)) intNext = intL + intL + 1 If (intNext + 1) < intR Then If arrArray [intNext] < arrArray [intNext + 1] Then intNext = intNext + 1 If anyValue >= arrArray [intNext] Then Break arrArray [intL] = arrArray [intNext] intL = intNext EndWhile arrArray [intL] = anyValue Next While intElements > 1 anyValue = arrArray [0] arrArray [0] = arrArray [intElements - 1] arrArray [intElements - 1] = anyValue intElements = intElements - 1 intR = intElements intL = 0 anyValue = arrArray [intL] While intL < (intR / 2) intNext = intL + intL + 1 If (intNext + 1) < intR Then If arrArray [intNext] < arrArray [intNext + 1] Then intNext = intNext + 1 If anyValue >= arrArray [intNext] Then Break arrArray [intL] = arrArray [intNext] intL = intNext EndWhile arrArray [intL] = anyValue EndWhile Return arrArray ;.......................................................................................................................................... ; 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 ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayQuickSortNRV1 (arrArray) ; Non recursive QuickSort. If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 arrStackLeft = ArrDimension (100) arrStackRight = ArrDimension (100) arrStackLeft [1] = intLow arrStackRight [1] = intHigh intStack = 1 While intStack If arrStackLeft [intStack] >= arrStackRight [intStack] intStack = intStack - 1 Else intL = arrStackLeft [intStack] intR = arrStackRight [intStack] anyPivot = arrArray [intR] intMid = (intL + intR) / 2 If (intR - intL) > 5 If ((arrArray [intMid] < anyPivot) && (arrArray [intMid] > arrArray [intL])) || ((arrArray [intMid] > anyPivot) && (arrArray [intMid] < arrArray [intL])) anyValue = arrArray [intMid] arrArray [intMid] = arrArray [intR] arrArray [intR] = anyValue EndIf Else If ((arrArray [intL] < arrArray [intMid]) && (arrArray [intL] > anyPivot)) || ((arrArray [intL] > arrArray [intMid]) && (arrArray [intL] < anyPivot)) anyValue = arrArray [intL] arrArray [intL] = arrArray [intR] arrArray [intR] = anyValue EndIf EndIf anyPivot = arrArray [intR] While intL < intR While arrArray [intL] < anyPivot intL = intL + 1 EndWhile intR = intR - 1 While (intL < intR) && (anyPivot < arrArray [intR]) intR = intR - 1 EndWhile If intL < intR anyValue = arrArray [intL] arrArray [intL] = arrArray [intR] arrArray [intR] = anyValue EndIf EndWhile intR = arrStackRight [intStack] anyValue = arrArray [intL] arrArray [intL] = arrArray [intR] arrArray [intR] = anyValue If (intL - arrStackLeft [intStack]) >= (arrStackRight [intStack] - intL) arrStackLeft [intStack + 1] = arrStackLeft [intStack] arrStackRight [intStack + 1] = intL - 1 arrStackLeft [intStack] = intL + 1 Else arrStackLeft [intStack + 1] = intL + 1 arrStackRight [intStack + 1] = arrStackRight [intStack] arrStackRight [intStack] = intL - 1 EndIf intStack = intStack + 1 EndIf EndWhile Drop (arrStackLeft, arrStackRight) Return arrArray #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayQuickSortNRV2 (arrArray) ; Non recursive QuickSort. If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 arrStackLeft = ArrDimension (100) arrStackRight = ArrDimension (100) arrStackLeft [1] = intLow arrStackRight [1] = intHigh intStack = 1 While intStack If arrStackLeft [intStack] >= arrStackRight [intStack] intStack = intStack - 1 Else intL = arrStackLeft [intStack] intR = arrStackRight [intStack] anyPivot = arrArray [intR] intMid = (intL + intR) / 2 If (intR - intL) > 5 If ((arrArray [intMid] < anyPivot) && (arrArray [intMid] > arrArray [intL])) || ((arrArray [intMid] > anyPivot) && (arrArray [intMid] < arrArray [intL])) Then ArraySwapElements (arrArray, intMid, 0, 0, 0, 0, intR, 0, 0, 0, 0) Else If ((arrArray [intL] < arrArray [intMid]) && (arrArray [intL] > anyPivot)) || ((arrArray [intL] > arrArray [intMid]) && (arrArray [intL] < anyPivot)) Then ArraySwapElements (arrArray, intL, 0, 0, 0, 0, intR, 0, 0, 0, 0) EndIf anyPivot = arrArray [intR] While intL < intR While arrArray [intL] < anyPivot intL = intL + 1 EndWhile intR = intR - 1 While (intL < intR) && (anyPivot < arrArray [intR]) intR = intR - 1 EndWhile If intL < intR Then ArraySwapElements (arrArray, intL, 0, 0, 0, 0, intR, 0, 0, 0, 0) EndWhile intR = arrStackRight [intStack] ArraySwapElements (arrArray, intL, 0, 0, 0, 0, intR, 0, 0, 0, 0) If (intL - arrStackLeft [intStack]) >= (arrStackRight [intStack] - intL) arrStackLeft [intStack + 1] = arrStackLeft [intStack] arrStackLeft [intStack] = intL + 1 arrStackRight [intStack + 1] = intL - 1 Else arrStackRight [intStack + 1] = arrStackRight [intStack] arrStackRight [intStack] = intL - 1 arrStackLeft [intStack + 1] = intL + 1 EndIf intStack = intStack + 1 EndIf EndWhile Drop (arrStackLeft, arrStackRight) Return arrArray ;.......................................................................................................................................... ; This UDF "udfArrayQuickSortNR2" needs minimal WinBatch version DLL 5.13bem, first showing up in WB 2007B. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayQuickSortRV1 (arrArray, intLow, intHigh) ; Recursive QuickSort. If intLow < 0 || intHigh < 0 ; Initial array check at first call. If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 EndIf If intLow >= intHigh Then Return arrArray anyPivot = arrArray [ (1 + intLow + intHigh) / 2] intL = intLow intR = intHigh While intL <= intR While arrArray [intL] < anyPivot intL = intL + 1 EndWhile While anyPivot < arrArray [intR] intR = intR - 1 EndWhile If intL <= intR anyValue = arrArray [intL] arrArray [intL] = arrArray [intR] arrArray [intR] = anyValue intL = intL + 1 intR = intR - 1 EndIf EndWhile udfArrayQuickSortRV1 (arrArray, intLow, intR) udfArrayQuickSortRV1 (arrArray, intL, intHigh) Return arrArray #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayQuickSortRV2 (arrArray, intLow, intHigh) ; Recursive QuickSort. If intLow < 0 || intHigh < 0 ; Initial array check at first call. If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 EndIf If intLow >= intHigh Then Return arrArray anyPivot = arrArray [ (1 + intLow + intHigh) / 2] intL = intLow intR = intHigh While intL <= intR While arrArray [intL] < anyPivot intL = intL + 1 EndWhile While anyPivot < arrArray [intR] intR = intR - 1 EndWhile If intL <= intR ArraySwapElements (arrArray, intL, 0, 0, 0, 0, intR, 0, 0, 0, 0) intL = intL + 1 intR = intR - 1 EndIf EndWhile udfArrayQuickSortRV2 (arrArray, intLow, intR) udfArrayQuickSortRV2 (arrArray, intL, intHigh) Return arrArray #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayItemSort (arrArray, intDirection) If intDirection != @ASCENDING Then If intDirection != @DESCENDING Then intDirection = @ASCENDING If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 strDelimiter = Num2Char (7) ; Assuming ASCII-7 bell character does not exist in data! strList = "" For intI = intLow To intHigh strList = strList : strDelimiter : arrArray [intI] Next strList = ItemSort (StrSub (strList, 2, -1), strDelimiter) Switch intDirection Case @ASCENDING arrArray = Arrayize (strList, strDelimiter) Break Case @DESCENDING For intI = intLow To intHigh arrArray [intI] = ItemExtract (intElements - intI, strList, strDelimiter) Next Break EndSwitch Return arrArray ;.......................................................................................................................................... ; Sort parameter: ; intDirection=@ASCENDING ; intDirection=@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=intLow To intHigh ; arrArray [i] = ItemExtract(i+1,sSort,strDelimiter) ; Next ; (B) ; Drop(arrArray) ; arrArray = Arrayize(sSort,strDelimiter) ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayBinSort (arrArray, intDirection) If intDirection != @ASCENDING Then If intDirection != @DESCENDING Then intDirection = @ASCENDING If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 intLenMax = 0 For intI = intLow To intHigh intLenMax = Max (intLenMax, StrLen (arrArray [intI])) Next hdlBB = BinaryAlloc (intLenMax * intElements) For intI = intLow To intHigh BinaryPokeStr (hdlBB, intI * intLenMax, arrArray [intI]) Next BinarySort (hdlBB, intLenMax, 0, intLenMax, @STRING | intDirection) For intI = intLow To intHigh arrArray [intI] = BinaryPeekStr (hdlBB, intI * intLenMax, intLenMax) Next hdlBB = BinaryFree (hdlBB) Return arrArray ;.......................................................................................................................................... ; Sort parameter: ; intDirection=@ASCENDING ; intDirection=@DESCENDING ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;========================================================================================================================================== ;========================================================================================================================================== ; Itemlist sorting UDFs ;========================================================================================================================================== ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListSortOrdinalV1 (strList, strDelimiter) If strList == "" Then Return "" intItemCount = ItemCount (strList, strDelimiter) strNumDelim = "|" strListNew = "" intEmpty = 0 For intI = 1 To intItemCount strItem = ItemExtract (intI, strList, strDelimiter) If strItem != "" intChrCount = StrLen (strItem) strChars = "" For intChr = 1 To intChrCount strChars = strChars : StrFixLeft (Char2Num (StrSub (strItem, intChr, 1)), "0", 3) : strNumDelim Next strListNew = strListNew : strChars : strDelimiter Else intEmpty = intEmpty + 1 EndIf Next strListNew = ItemSort (strListNew, strDelimiter) ; Trailing delimiter now leading. intItemCount = ItemCount (strListNew, strDelimiter) ; Just one item too much. strList = "" For intI = 2 To intItemCount ; Skip leading delimiter. strItem = ItemExtract (intI, strListNew, strDelimiter) intChrCount = ItemCount (strItem, strNumDelim) - 1 strChars = "" For intChr = 1 To intChrCount strChars = strChars : Num2Char (ItemExtract (intChr, strItem, strNumDelim)) Next strList = strList : strChars : strDelimiter Next If intEmpty Then strList = StrFill (strDelimiter, intEmpty) : strList ; Insert empty items as skipped above. strList = ItemRemove (-1, strList, strDelimiter) Return strList ;.......................................................................................................................................... ; This UDF "ItemListSortOrdinal" sorts a list of alphanumerical values in ascending or descending direction ; and respects the ordinal character series. ; ; Ordinal means, that each byte of each string is compared without linguistic interpretation. ; Uppercase characters are placed before lowercase characters. ; ; Detlev Dalitz.20090512. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListSortOrdinalV2 (strItemList, strDelimiter) If strItemList == "" Then Return "" intCount = ItemCount (strItemList, strDelimiter) If StrLen (strItemList) == intCount - 1 Then Return strItemList intBBSizeMax = 0 hdlBB = 0 For intI = 1 To intCount strItem = ItemExtract (intI, strItemList, strDelimiter) If strItem != "" intBBSize = StrLen (strItem) If intBBSize > intBBSizeMax intBBSizeMax = intBBSize If hdlBB Then hdlBB = BinaryFree (hdlBB) EndIf If !hdlBB Then hdlBB = BinaryAlloc (intBBSizeMax) strItemList = ItemReplace (BinaryPeekHex (hdlBB, 0, BinaryPokeStr (hdlBB, 0, strItem)), intI, strItemList, strDelimiter) EndIf Next strItemList = ItemSort (strItemList, strDelimiter) For intI = 1 To intCount strItem = ItemExtract (intI, strItemList, strDelimiter) If strItem != "" Then strItemList = ItemReplace (BinaryPeekStr (hdlBB, 0, BinaryPokeHex (hdlBB, 0, strItem)), intI, strItemList, strDelimiter) Next If hdlBB Then hdlBB = BinaryFree (hdlBB) Return strItemList ;.......................................................................................................................................... ; This UDF "ItemListSortOrdinal" sorts a list of alphanumerical values in ascending direction ; and respects the ordinal character series. ; ; Ordinal means, that each byte of each string is compared without linguistic interpretation. ; Uppercase characters are placed before lowercase characters. ; ; Detlev Dalitz.20090512. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListSortOrdinalV3 (strItemList, strDelimiter) If strItemList == "" Then Return "" intCount = ItemCount (strItemList, strDelimiter) If StrLen (strItemList) == intCount - 1 Then Return strItemList ; Get max item length, my sophisticated invention. strTempList = @LF : StrReplace (StrClean (strItemList, strDelimiter, " ", @TRUE, 2), strDelimiter, @CRLF) : @CR intItemLenMax = 0 strSearch = @LF : @CR While @TRUE strTempList = StrReplace (strTempList, strSearch, "") If strTempList == "" Then Break intItemLenMax = intItemLenMax + 1 strSearch = @LF : StrFill (" ", intItemLenMax) : @CR EndWhile ; Ordinal sort. hdlBB = BinaryAlloc (intItemLenMax) For intI = 1 To intCount strItem = ItemExtract (intI, strItemList, strDelimiter) If strItem != "" Then strItemList = ItemReplace (BinaryPeekHex (hdlBB, 0, BinaryPokeStr (hdlBB, 0, strItem)), intI, strItemList, strDelimiter) Next strItemList = ItemSort (strItemList, strDelimiter) For intI = 1 To intCount strItem = ItemExtract (intI, strItemList, strDelimiter) If strItem != "" Then strItemList = ItemReplace (BinaryPeekStr (hdlBB, 0, BinaryPokeHex (hdlBB, 0, strItem)), intI, strItemList, strDelimiter) Next hdlBB = BinaryFree (hdlBB) Return strItemList ;.......................................................................................................................................... ; This UDF "ItemListSortOrdinal" sorts a list of alphanumerical values in ascending direction ; and respects the ordinal character series. ; ; Ordinal means, that each byte of each string is compared without linguistic interpretation. ; Uppercase characters are placed before lowercase characters. ; ; Detlev Dalitz.20090512. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListSortOrdinalV4 (strItemList, strDelimiter) If strItemList == "" Then Return "" intCount = ItemCount (strItemList, strDelimiter) If StrLen (strItemList) == intCount - 1 Then Return strItemList ; Get max item length, my sophisticated invention. intItemLenMax = 0 strTempList = @LF : StrReplace (StrClean (strItemList, strDelimiter, " ", @TRUE, 2), strDelimiter, @CRLF) : @CR intStrLen = StrLen (strTempList) hdlBB = BinaryAlloc (intStrLen) BinaryPokeStr (hdlBB, 0, strTempList) strSearch = @LF : @CR While @TRUE If !BinaryReplace (hdlBB, strSearch, "", @TRUE) Then If BinaryEodGet (hdlBB) <= intItemLenMax Then Break intItemLenMax = intItemLenMax + 1 strSearch = @LF : StrFill (" ", intItemLenMax) : @CR EndWhile hdlBB = BinaryFree (hdlBB) Drop (strTempList) ; Ordinal sort. hdlBB = BinaryAlloc (intItemLenMax) For intI = 1 To intCount strItem = ItemExtract (intI, strItemList, strDelimiter) If strItem != "" Then strItemList = ItemReplace (BinaryPeekHex (hdlBB, 0, BinaryPokeStr (hdlBB, 0, strItem)), intI, strItemList, strDelimiter) Next strItemList = ItemSort (strItemList, strDelimiter) For intI = 1 To intCount strItem = ItemExtract (intI, strItemList, strDelimiter) If strItem != "" Then strItemList = ItemReplace (BinaryPeekStr (hdlBB, 0, BinaryPokeHex (hdlBB, 0, strItem)), intI, strItemList, strDelimiter) Next hdlBB = BinaryFree (hdlBB) Return strItemList ;.......................................................................................................................................... ; This UDF "ItemListSortOrdinal" sorts a list of alphanumerical values in ascending direction ; and respects the ordinal character series. ; ; Ordinal means, that each byte of each string is compared without linguistic interpretation. ; Uppercase characters are placed before lowercase characters. ; ; Detlev Dalitz.20090512. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListSortOrdinalV5 (strItemList, strDelimiter, intDirection) If intDirection != @ASCENDING Then If intDirection != @DESCENDING Then intDirection = @ASCENDING If strItemList == "" Then Return "" intCount = ItemCount (strItemList, strDelimiter) If StrLen (strItemList) == intCount - 1 Then Return strItemList ; Get max item length, my sophisticated invention. strTempList = @LF : StrReplace (StrClean (strItemList, strDelimiter, " ", @TRUE, 2), strDelimiter, @CRLF) : @CR intItemLenMax = 0 strSearch = @LF : @CR While @TRUE strTempList = StrReplace (strTempList, strSearch, "") If strTempList == "" Then Break intItemLenMax = intItemLenMax + 1 strSearch = @LF : StrFill (" ", intItemLenMax) : @CR EndWhile ; Ordinal sort, using BinarySort string sort with hex strings. intRecSize = intItemLenMax * 2 hdlBB = BinaryAlloc (intItemLenMax) hdlBBSort = BinaryAlloc (intCount * intRecSize) For intI = 1 To intCount strItem = ItemExtract (intI, strItemList, strDelimiter) If strItem != "" Then BinaryPokeStr (hdlBBSort, (intI - 1) * intRecSize, BinaryPeekHex (hdlBB, 0, BinaryPokeStr (hdlBB, 0, strItem))) Next BinarySort (hdlBBSort, intRecSize, 0, intRecSize, @STRING | intDirection) strItemList = "" For intI = 1 To intCount strItem = BinaryPeekStr (hdlBBSort, (intI - 1) * intRecSize, intRecSize) If strItem != "" Then strItemList = strItemList : strDelimiter : BinaryPeekStr (hdlBB, 0, BinaryPokeHex (hdlBB, 0, strItem)) Else strItemList = strItemList : strDelimiter Next hdlBBSort = BinaryFree (hdlBBSort) hdlBB = BinaryFree (hdlBB) Return StrSub (strItemList, 2, -1) ;.......................................................................................................................................... ; This UDF "ItemListSortOrdinal" sorts a list of alphanumerical values in ascending or descending direction ; and respects the ordinal character series. ; ; Ordinal means, that each byte of each string is compared without linguistic interpretation. ; Uppercase characters are placed before lowercase characters. ; ; Detlev Dalitz.20090512. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListSortOrdinalV6 (strItemList, strDelimiter, intDirection) If intDirection != @ASCENDING Then If intDirection != @DESCENDING Then intDirection = @ASCENDING If strItemList == "" Then Return "" intCount = ItemCount (strItemList, strDelimiter) If StrLen (strItemList) == intCount - 1 Then Return strItemList ; Get max item length, my sophisticated invention. intItemLenMax = 0 intBBSize = 1 + intCount + StrLen (strItemList) hdlBB = BinaryAlloc (intBBSize) BinaryPokeStr (hdlBB, 1, StrClean (strItemList, strDelimiter, " ", @TRUE, 2)) BinaryReplace (hdlBB, strDelimiter, @CRLF, @TRUE) BinaryPokeStr (hdlBB, intBBSize - 1, @CR) BinaryPokeStr (hdlBB, 0, @LF) strSearch = @LF : @CR While @TRUE If !BinaryReplace (hdlBB, strSearch, "", @TRUE) Then If BinaryEodGet (hdlBB) <= intItemLenMax Then Break intItemLenMax = intItemLenMax + 1 strSearch = @LF : StrFill (" ", intItemLenMax) : @CR EndWhile hdlBB = BinaryFree (hdlBB) ; Ordinal sort, using BinarySort string sort with hex strings. intHigh = intCount - 1 intRecSize = intItemLenMax * 2 hdlBB = BinaryAlloc (intItemLenMax) hdlBBSort = BinaryAlloc (intCount * intRecSize) For intI = 0 To intHigh strItem = ItemExtract (intI + 1, strItemList, strDelimiter) If strItem != "" Then BinaryPokeStr (hdlBBSort, intI * intRecSize, BinaryPeekHex (hdlBB, 0, BinaryPokeStr (hdlBB, 0, strItem))) Next BinarySort (hdlBBSort, intRecSize, 0, intRecSize, @STRING | intDirection) strItemList = "" For intI = 0 To intHigh strItem = BinaryPeekStr (hdlBBSort, intI * intRecSize, intRecSize) If strItem != "" Then strItemList = strItemList : strDelimiter : BinaryPeekStr (hdlBB, 0, BinaryPokeHex (hdlBB, 0, strItem)) Else strItemList = strItemList : strDelimiter Next hdlBBSort = BinaryFree (hdlBBSort) hdlBB = BinaryFree (hdlBB) Return StrSub (strItemList, 2, -1) ;.......................................................................................................................................... ; This UDF "udfItemListSortOrdinal" sorts a list of alphanumerical values in ascending or descending direction ; and respects the ordinal character series. ; ; Ordinal means, that each byte of each string is binary compared "as is". ; Uppercase characters are placed before lowercase characters in standard ASCII order. ; ; Detlev Dalitz.20090513. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------;;; ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListSortOrdinalV7 (strItemList, strDelimiter, intDirection) If intDirection != @ASCENDING Then If intDirection != @DESCENDING Then intDirection = @ASCENDING If strItemList == "" Then Return "" intCount = ItemCount (strItemList, strDelimiter) If StrLen (strItemList) == intCount - 1 Then Return strItemList ; Get max item length, my sophisticated invention. intItemLenMax = 0 intBBSize = 1 + intCount + StrLen (strItemList) hdlBB = BinaryAlloc (intBBSize) BinaryPokeStr (hdlBB, 1, StrClean (strItemList, strDelimiter, " ", @TRUE, 2)) BinaryReplace (hdlBB, strDelimiter, @CRLF, @TRUE) BinaryPokeStr (hdlBB, intBBSize - 1, @CR) BinaryPokeStr (hdlBB, 0, @LF) strSearch = @LF : @CR While @TRUE If !BinaryReplace (hdlBB, strSearch, "", @TRUE) Then If BinaryEodGet (hdlBB) <= intItemLenMax Then Break intItemLenMax = intItemLenMax + 1 strSearch = @LF : StrFill (" ", intItemLenMax) : @CR EndWhile hdlBB = BinaryFree (hdlBB) ; Ordinal sort, using BinarySort string sort with hex strings. intHigh = intCount - 1 intRecSize = intItemLenMax * 2 hdlBBSort = BinaryAlloc (intCount * intRecSize) For intI = 0 To intHigh strItem = ItemExtract (intI + 1, strItemList, strDelimiter) If strItem != "" Then BinaryPokeStr (hdlBBSort, intI * intRecSize, ChrStringToHex (strItem)) Next BinarySort (hdlBBSort, intRecSize, 0, intRecSize, @STRING | intDirection) strItemList = "" For intI = 0 To intHigh strItem = BinaryPeekStr (hdlBBSort, intI * intRecSize, intRecSize) If strItem != "" Then strItemList = strItemList : strDelimiter : ChrHexToString (strItem) Else strItemList = strItemList : strDelimiter Next hdlBBSort = BinaryFree (hdlBBSort) Return StrSub (strItemList, 2, -1) ;.......................................................................................................................................... ; This UDF "udfItemListSortOrdinal2" sorts a list of alphanumerical values in ascending or descending direction ; and respects the ordinal character series. ; ; Ordinal means, that each byte of each string is binary compared "as is". ; Uppercase characters are placed before lowercase characters in standard ASCII order. ; ; Detlev Dalitz.20090513.20090515 ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;========================================================================================================================================== ;========================================================================================================================================== ; Special sorting algorithm UDF ;========================================================================================================================================== ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayDistributionSort (arrArray, intKeyCount) ; Special hash sort. Bucketsort. If !ArrInfo (arrArray, -1) Then Return ArrDimension (0) ; Invalid input array, return empty valid dim-0 array. If ArrInfo (arrArray, 0) != 1 Then Return ArrDimension (0) ; Only dim-1 array allowed, return empty valid dim-0 array. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return ArrDimension (0) ; Input array has no elements, return empty valid dim-0 array. If intElements == 1 Then Return arrArray ; Input array has only one element, return the input array. intHigh = intElements - 1 intLow = 0 ; How many different keys exist? ; If fix number is known, then following computing is not necessary. If !intKeyCount strItemList = "" For intI = intLow To intHigh arrArray [intI] = StrUpper (arrArray [intI]) ; Just all uppercase for this case. If !ItemLocate (arrArray [intI], strItemList, @TAB) Then strItemList = ItemInsert (arrArray [intI], -1, strItemList, @TAB) Next intKeyCount = ItemCount (strItemList, @TAB) EndIf arrBins = ArrDimension (intKeyCount) arrArrayStart = ArrDimension (intKeyCount) arrArraySave = ArrDimension (intElements) ArrInitialize (arrBins, 0) ArrInitialize (arrArrayStart, 0) For intI = intLow To intHigh arrArraySave [intI] = arrArray [intI] ; Copy Array to ArraySave. intIndexBins = Max (0, Char2Num (arrArray [intI]) - 65) ; Hier die entsprechende Abbildungsfunktion anwenden. arrBins [intIndexBins] = 1 + arrBins [intIndexBins] ; Count occurrences of each key value. Next ; Compute the start position of each bin. intPos = 0 intKeyHigh = intKeyCount - 1 For intI = 1 To intKeyHigh intPos = intPos + arrBins [intI - 1] arrArrayStart [intI] = intPos Next ; Deal the saved array back to the original. For intI = intLow To intHigh intIndexSave = Max (0, Char2Num (arrArraySave [intI]) - 65) ; Hier die entsprechende Abbildungsfunktion anwenden. intStartIndex = arrArrayStart [intIndexSave] arrArray [intStartIndex] = Num2Char (intIndexSave + 65) ; Hier die entsprechende _inverse_ Abbildungsfunktion anwenden. arrArrayStart [intIndexSave] = 1 + arrArrayStart [intIndexSave] Next Drop (arrBins, arrArraySave, arrArrayStart) Return arrArray ;.......................................................................................................................................... ; 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 ;------------------------------------------------------------------------------------------------------------------------------------------ ;========================================================================================================================================== ;========================================================================================================================================== ; Helper UDFs ;========================================================================================================================================== ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayUnloadToFile (arrArray, strFilename) If !ArrInfo (arrArray, -1) Then Return 0 ; No array. If !ArrInfo (arrArray, 6) Then Return 0 ; No elements. strArrInfo0 = "ArrInfo;0;{0};Number of dimensions in the array." strArrInfo1 = "ArrInfo;1;{1};Number of elements in dimension 1." strArrInfo2 = "ArrInfo;2;{2};Number of elements in dimension 2." strArrInfo3 = "ArrInfo;3;{3};Number of elements in dimension 3." strArrInfo4 = "ArrInfo;4;{4};Number of elements in dimension 4." strArrInfo5 = "ArrInfo;5;{5};Number of elements in dimension 5." strArrInfo6 = "ArrInfo;6;{6};Number of elements in the entire array." intDims = ArrInfo (arrArray, 0) strIndexFill = StrFill (",0", 2 * (5 - intDims)) For intD = 1 To 5 intE%intD% = Max (ArrInfo (arrArray, intD) - 1, 0) Next hdlFW = FileOpen (strFilename, "WRITE") strBOM = "" ; BOM (EF BB BF) for Unicode UTF-8. FileWrite (hdlFW, strBOM : '<?xml version="1.0" encoding="utf-8" standalone="yes"?>') ; XML declaration line with leading BOM (EF BB BF). FileWrite (hdlFW, "<ARRAY>") ; Open node "ARRAY". FileWrite (hdlFW, "<ARRINFO><![CDATA[") ; Open node "ARRINFO". ; Write data. For intI = 0 To 6 FileWrite (hdlFW, StrReplace (strArrInfo%intI%, "{%intI%}", ArrInfo (arrArray, intI))) Next FileWrite (hdlFW, "]]></ARRINFO>") ; Close node "ARRINFO". FileWrite (hdlFW, "<ARRDATA><![CDATA[") ; Open node "ARRDATA". ; Write data. For intD1 = 0 To intE1 For intD2 = 0 To intE2 For intD3 = 0 To intE3 For intD4 = 0 To intE4 For intD5 = 0 To intE5 strIdx = "" For intD = 1 To intDims strIdx = ItemInsert (intD%intD%, -1, strIdx, ",") Next intVarType = VarType (arrArray [%strIdx%]) intArrIndex = strIdx : strIndexFill If intVarType strOut = ChrStringToUnicode ("" : arrArray [%strIdx%]) intPrevCodePage = ChrSetCodepage (65001) FileWrite (hdlFW, intArrIndex : ";" : intVarType : ";" : strOut) ChrSetCodepage (intPrevCodePage) Else FileWrite (hdlFW, intArrIndex : ";" : intVarType : ";") EndIf Next Next Next Next Next FileWrite (hdlFW, "]]></ARRDATA>") ; Close node "ARRDATA". FileWrite (hdlFW, "</ARRAY>") ; Close node "ARRAY". hdlFW = FileClose (hdlFW) Return FileSizeEx (strFilename) ;.......................................................................................................................................... ; This function "udfArrayUnloadToFile" creates a specific array definition textfile (xml) from array, ; which can be used to load data back into an array by function "udfArrayLoadFromFile". ; ; Detlev Dalitz.20010731.20020828.20030222.20090528.20100122.20100125. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayLoadFromFile (strFilename) intResult = 0 If !FileSizeEx (strFilename) Then Goto CANCEL IntControl (65, 4096 * 256, 0, 0, 0) ; Enlarge fileread buffer for speedy access. intCodepagePrev = ChrSetCodepage (65001) ; Translate using UTF-8. hdlFR = FileOpen (strFilename, "READ") If !hdlFR Then Goto CANCEL While @TRUE strLine = FileRead (hdlFR) strLine = StrTrim (strLine) If strLine == "*EOF*" Then Goto CANCEL If strLine == "<ARRINFO><![CDATA[" Then Break EndWhile ; Read header, must be 7 lines on top of the file. While @TRUE strLine = FileRead (hdlFR) strLine = StrTrim (strLine) If strLine == "*EOF*" Then Goto CANCEL If strLine == "]]></ARRINFO>" Then Break If strLine == "" Then Continue If "ArrInfo" != ItemExtract (1, strLine, ";") Then Break intIndex = ItemExtract (2, strLine, ";") If StrSub ("0123456", intIndex + 1, 1) != intIndex Then Break strArrInfo%intIndex% = ItemExtract (3, strLine, ";") EndWhile While @TRUE strLine = FileRead (hdlFR) strLine = StrTrim (strLine) If strLine == "*EOF*" Then Goto CANCEL If strLine == "<ARRDATA><![CDATA[" Then Break EndWhile ; Declare Array. arrArray = ArrDimension (strArrInfo1, strArrInfo2, strArrInfo3, strArrInfo4, strArrInfo5) intDimNext = ArrInfo (arrArray, 0) + 1 ; Read data. While @TRUE strLine = FileRead (hdlFR) strLine = StrTrim (strLine) If strLine == "*EOF*" Then Goto CANCEL If strLine == "]]></ARRDATA>" Then Break If strLine == "" Then Continue intArrIndex = ItemExtract (1, strLine, ";") intLen1 = StrLen (intArrIndex) intArrVarType = Int (ItemExtract (2, strLine, ";")) intLen2 = StrLen (intArrVarType) strArrData = StrSub (strLine, intLen1 + intLen2 + 3, -1) For intD = 5 To intDimNext By -1 intArrIndex = ItemRemove (intD, intArrIndex, ",") Next Switch intArrVarType Case 2 ; VARTYPE_STRING intPrevCodePage = ChrSetCodepage (65001) strUnicode = ChrStringToUnicode (strArrData) ChrSetCodepage (intPrevCodePage) arrArray [%intArrIndex%] = ChrUnicodeToString (strUnicode) Break Case 32 ; VARTYPE_FLOATNUM arrArray [%intArrIndex%] = 1.0 * strArrData Break ; Case 64 ; VARTYPE_BINARY ; Case 128 ; VARTYPE_LPWSTR or "Unicode" ; Case 256 ; VARTYPE_ARRAY ; Case 512 ; VARTYPE_VARIANT ; Case 1024 ; VARTYPE_COMOBJECT ; Case 0 ; VARTYPE_UNDEFINED ; Case -1 ; VARTYPE_RESWORD ; Break Case intArrVarType If intArrVarType & 1 Then arrArray [%intArrIndex%] = 1 * strArrData ; 1=VARTYPE_INT; 65=VARTYPE_INT|VARTYPE_BINARY, 17=VARTYPE_INT|VARTYPE_OLEOBJECT, 5=VARTYPE_INT|VARTYPE_FILE, 1537=VARTYPE_INT|VARTYPE_VARIANT|VARTYPE_COMOBJECT Break EndSwitch EndWhile intResult = 1 :CANCEL If IsDefined (hdlFR) Then hdlFR = FileClose (hdlFR) ChrSetCodepage (intCodepagePrev) ; Translate using prev codepage. If !intResult Then Return ArrDimension (0) Return arrArray ;.......................................................................................................................................... ; This function ""udfArrayLoadFromFile" creates an array from a specific array definition textfile (xml), ; which has been created previously by function "udfArrayUnloadToFile" resp. by other method. ; ; Detlev Dalitz.20010731.20020828.20030222.20090528.20100122.20100125. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayDumpToItemList (arrArray, strDelimiter) If !ArrInfo (arrArray, -1) Then Return "*ARR_INVALID*" ; No Array, return info string. If ArrInfo (arrArray, 0) != 1 Then Return "*ARR_DIM_ERROR*" ; Array is not a dim-1 array, return info string. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return "" intHigh = intElements - 1 intLow = 0 strItemList = "" For intI = intLow To intHigh strItem = "*ARR_ELEM_UNDEF*" If !!VarType (arrArray [intI]) If arrArray [intI] != "" Then strItem = "[" : arrArray [intI] : "]" Else strItem = "*ARR_ELEM_EMPTY*" EndIf strItemList = strItemList : strDelimiter : strItem Next Return StrSub (strItemList, 2, -1) ;.......................................................................................................................................... ; This UDF "udfArrayDumpToItemList" reads a dim-1 array and returns an itemlist of all array cell items. ; ; Return values: ; "*ARR_INVALID*" ... Invalid array resp. this is no array. ; "*ARR_DIM_ERROR*" ... Array is not a dim-1 array. ; "*ARR_ELEM_EMPTY*" ... Array element has defined vartype but is empty. ; "*ARR_ELEM_UNDEF*" ... Array element has undefined VarType. ; ; Example: strItemList = udfArrayDumpToItemList (arrArray, @TAB) ; ; Detlev Dalitz.20090517. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfItemListToFile (strFilename, strItemList, strDelimiter) ; The FilePut version. If strItemList == "" Then Return 0 Return FilePut (strFilename, StrReplace (strItemList, strDelimiter, @CRLF)) ;.......................................................................................................................................... ; This UDF udfItemListToFile writes an itemlist to a textfile with EOL=CRLF and returns the number of bytes written. ; Example: intResult = udfItemListToFile (strMyFile, @TAB, strMyList) ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayAskRow (strTitle, arrArray, intSortMode, intSelectMode, intAskMode) intSortMode = Max (@UNSORTED, Min (@SORTED, intSortMode)) intSelectMode = Max (@SINGLE, Min (@EXTENDED, intSelectMode)) intAskMode = Max (0, Min (1, intAskMode)) chrDelimItem = @TAB chrDelimRow = @LF intDimMin = 1 intDimMax = 2 intDim = ArrInfo (arrArray, 0) If intDim > intDimMax Then Return "" If intDim < intDimMin Then Return "" For intElem = 1 To intDimMax intE%intElem% = Max (0, ArrInfo (arrArray, intElem) - 1) Next strAskList = "" For intD1 = 0 To intE1 strRow = "" For intD2 = 0 To intE2 strIndexList = "" For intElem = 1 To intDim strIndexList = ItemInsert (intD%intElem%, -1, strIndexList, ",") Next If !!VarType (arrArray [%strIndexList%]) strRow = strRow : chrDelimItem : arrArray [%strIndexList%] Else strRow = strRow : chrDelimItem EndIf Next strRow = strRow : chrDelimItem : intD1 ; Add Row number at end of strRow. strAskList = ItemInsert (StrSub (strRow, 2, -1), -1, strAskList, chrDelimRow) Next strResultList = "" strRowList = AskItemlist (strTitle, strAskList, chrDelimRow, intSortMode, intSelectMode) Select intAskMode Case 0 intCount = ItemCount (strRowList, chrDelimRow) For intElem = 1 To intCount strRowItem = ItemExtract (intElem, strRowList, chrDelimRow) strRowNum = ItemExtract (-1, strRowItem, chrDelimItem) strResultList = ItemInsert (strRowNum, -1, strResultList, chrDelimRow) Next Break Case 1 strResultList = strRowList Break EndSelect :CANCEL Return strResultList ;------------------------------------------------------------------------------------------------------------------------------------------ ; Parameters: ; strTitle = Title of the AskItemList box. ; arrArray = A dim-1 resp. dim-2 array variable. ; intSortMode = @sorted for an alphabetic list. ; intSortMode = @unsorted to display the list of items as is. ; intSelectMode = @single to limit selection to one item. ; intSelectMode = @multiple to allow selection of more than one item. ; intSelectMode = @extended to allow selection of multiple items by extending the selection with the mouse or shift key. ; intAskMode = 0 to return a list of selected array strRow index/es delimited by @LF character. ; intAskMode = 1 to return a list of selected array strRow/s delimited by @LF character. ; If array dimension is not in the allowed range (1..2) then this UDF returns an empty string "". ; The function IntControl (63, p1, p2, p3, p4) can be used to set the display coordinates for AskItemList. ; (IntControl 63 can be useful to cut resp. hide the rightmost array column item while displaying the AskItemList box.) ; ; Detlev Dalitz.20020521.20090508. ;------------------------------------------------------------------------------------------------------------------------------------------ #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;========================================================================================================================================== ;------------------------------------------------------------------------------------------------------------------------------------------ ;Test_Sort strMsgTitle = "Demo: Array Sort Algorithms" strFunction1 = "udfArrayPartSortV1 (arrArray)" strFunction2 = "udfArrayPartSortV2 (arrArray)" strFunction3 = "udfArrayBubbleSortV1 (arrArray)" strFunction4 = "udfArrayBubbleSortV2 (arrArray)" strFunction5 = "udfArrayGnomeSort (arrArray)" strFunction6 = "udfArrayMergeSortRB (arrArray, -1, -1)" strFunction7 = "udfArrayMergeSortR (arrArray, -1, -1)" strFunction8 = "udfArrayInsertSort (arrArray)" strFunction9 = "udfArrayShellSort (arrArray)" strFunction10 = "udfArrayShellSortMV1 (arrArray)" strFunction11 = "udfArrayShellSortMV2 (arrArray)" strFunction12 = "udfArrayQuickSortNRV1 (arrArray)" strFunction13 = "udfArrayQuickSortNRV2 (arrArray)" strFunction14 = "udfArrayHeapSort (arrArray)" strFunction15 = "udfArrayShellSortL (arrArray)" strFunction16 = "udfArrayShellSortK (arrArray)" strFunction17 = "udfArrayQuickSortRV1 (arrArray, -1, -1)" strFunction18 = "udfArrayQuickSortRV2 (arrArray, -1, -1)" strFunction19 = "udfArrayItemSort (arrArray, @ASCENDING)" strFunction20 = "udfArrayItemSort (arrArray, @DESCENDING)" strFunction21 = "udfArrayBinSort (arrArray, @ASCENDING)" strFunction22 = "udfArrayBinSort (arrArray, @DESCENDING)" ;strFunction23 = "udfArrayDistributionSort (arrArray, intKeyCount)" strFunction24 = "udfItemListSortOrdinalV1 (strItemList, strDelimiter)" strFunction25 = "udfItemListSortOrdinalV2 (strItemList, strDelimiter)" strFunction26 = "udfItemListSortOrdinalV3 (strItemList, strDelimiter)" strFunction27 = "udfItemListSortOrdinalV4 (strItemList, strDelimiter)" strFunction28 = "udfItemListSortOrdinalV5 (strItemList, strDelimiter, @ASCENDING)" strFunction29 = "udfItemListSortOrdinalV5 (strItemList, strDelimiter, @DESCENDING)" strFunction30 = "udfItemListSortOrdinalV6 (strItemList, strDelimiter, @ASCENDING)" strFunction31 = "udfItemListSortOrdinalV6 (strItemList, strDelimiter, @DESCENDING)" strFunction32 = "udfItemListSortOrdinalV7 (strItemList, strDelimiter, @ASCENDING)" strFunction33 = "udfItemListSortOrdinalV7 (strItemList, strDelimiter, @DESCENDING)" strFunctionList = "" For intI = 1 To 33 If IsDefined (strFunction%intI%) Then strFunctionList = ItemInsert (strFunction%intI%, -1, strFunctionList, @TAB) Next strAskList = "" While strAskList == "" strAskList = strFunctionList IntControl (63, 300, 100, 700, 900) ; Sets coordinates for AskFileText, AskItemList and AskTextBox windows. strAskList = AskItemlist (strMsgTitle : ": Select one or more functions to test", strAskList, @TAB, @UNSORTED, @EXTENDED) EndWhile strFunctionList = strAskList Drop (strAskList) intTestItemCountDefault = 30 intTestItemCount = AskLine (strMsgTitle, "How many items in array?", intTestItemCountDefault) intTestItemCount = Max (intTestItemCount, 10) intTestItemLengthDefault = 40 intTestItemLength = AskLine (strMsgTitle, "How max length of each item?", intTestItemLengthDefault) intTestItemLength = Max (intTestItemLength, 1) BoxOpen (strMsgTitle : ": Processing", "Be patient") BoxText ("Creating test items ...") ; Create test items. strList = "" intTestByteSum = 0 strMsgText = "Creating test item ..." : @LF : intTestItemCount : "/" For intI = 1 To intTestItemCount strItem = "" intChars = Random (intTestItemLength) intTestByteSum = intTestByteSum + intChars For intK = 1 To intChars ; Allow empty items, intChars = 0. ; For intK = 0 To intChars If Random (1) Then strItem = strItem : " " Else If Random (1) Then strItem = strItem : Num2Char (65 + Random (25)) Else strItem = strItem : Num2Char (97 + Random (25)) Next If !(intI mod (intTestItemCount / 10)) Then BoxText (strMsgText : intI : @LF : strItem) strList = ItemInsert (strItem, -1, strList, "|") Next Drop (intI, intTestItemCountDefault, intTestItemLengthDefault, intK, strMsgText, strItem) ; Short test. Goto Skip_Short_Test strList = "+|-|\|C|B|A|c|b|a|5|4|3|2|1|0|3.14|-196|-1.0|+1.0|" ; 20 items. intTestItemLength = 0 intTestItemCount = ItemCount (strList, "|") For intI = 1 To intTestItemCount intTestItemLength = Max (intTestItemLength, StrLen (ItemExtract (intI, strList, "|"))) Next intTestByteSum = StrLen (strList) - intTestItemCount + 1 :Skip_Short_Test ; The test loop. ; Prepare parameters for some functions. intKeyCount = 26 ; Parameter for "udfArrayDistributionSort (arrArray, intKeyCount)". intKeyCount = 0 ; Parameter for "udfArrayDistributionSort (arrArray, intKeyCount)". strDelimiter = "," strItemList = StrReplace (strList, "|", strDelimiter) intMsgLinesMax = 50 intTicksMax = 0 intCount = ItemCount (strFunctionList, @TAB) For intI = 1 To intCount strTestFunction = ItemExtract (intI, strFunctionList, @TAB) BoxText (strTestFunction : @LF : "sorting ...") arrArray = Arrayize (strList, "|") Exclusive (@ON) intTicksStart = GetTickCount () For intK = 1 To 2 ; Loop to collect even some small TickCounts. Loop1=unsorted, Loop2=sorted. anyResult = %strTestFunction% Next intTicksStop = GetTickCount () Exclusive (@OFF) intTicks%intI% = intTicksStop - intTicksStart intTicksMax = Max (intTicks%intI%, intTicksMax) strMsgText = strTestFunction : @LF If ArrInfo (anyResult, -1) Then If ArrInfo (anyResult, 1) <= intMsgLinesMax Then strMsgText = strMsgText : "Elements=" : ArrInfo (anyResult, 1) : @LF : udfArrayDumpToItemList (anyResult, @LF) : @LF strMsgText = strMsgText : "intTicks=" : intTicks%intI% Display (10, strTestFunction, strMsgText) If ArrInfo (anyResult, -1) Then intResult = udfArrayUnloadToFile (anyResult, FileCreateTemp ("ARR") : ".txt") Else udfItemListToFile (FileCreateTemp ("LST") : ".txt", anyResult, strDelimiter) Drop (arrArray, anyResult) Next BoxShut () Decimals (1) intTicksSum = 0 fltLenAvg = 1.0 * intTestByteSum / intTestItemCount strMsgText = "ItemCount: " : intTestItemCount : @LF : "ItemLength max.: " : intTestItemLength : @LF : "ItemLength avg.: " : fltLenAvg : @LF : @LF strMsgText = strMsgText : "Percent" : @TAB : "Ticks" : @TAB : "Function" : @LF For intI = 1 To intCount strTestFunction = ItemExtract (intI, strFunctionList, @TAB) intTicksSum = intTicksSum + intTicks%intI% strMsgText = strMsgText : 100 * intTicks%intI% / intTicksMax : "%%" : @TAB : intTicks%intI% : @TAB : strTestFunction : @LF Next strMsgText = strMsgText : "Ticks Sum: " : intTicksSum : @LF strMsgText = TimeYmdHms () : @LF : "WIL interpreter " : VersionDLL () : @LF : strMsgText ClipPut (strMsgTitle : @LF : strMsgText) Pause (strMsgTitle : ": Summary", strMsgText) ;------------------------------------------------------------------------------------------------------------------------------------------ ;Test_Unload_Load_1 strMsgTitle = "Demo: Array dim-1 UnLoad Load Functions" BoxOpen (strMsgTitle : ": Processing", "Be patient") BoxText ("Creating test items ...") intDim1 = 20 intDim1High = intDim1 - 1 intDim1Low = 0 arrArray = ArrDimension (intDim1) ArrInitialize (arrArray, 0) For intD1 = intDim1Low To intDim1High strItem = "" For intRandom = 1 To Random (25) strItem = strItem : Num2Char (65 + Random (25)) Next arrArray [intD1] = strItem Next BoxShut () strTempFile = Environment ("TEMP") : "\" : StrInsert (StrReplace (TimeYmdHms (), ":", ""), ".", "", 9, 1) : ".ArrTest1.txt" ; "2009:05:16:12:34:56" ==> "20090516.123456" intNum = udfArrayUnloadToFile (arrArray, strTempFile) strMsgTitle = "Array A " : intNum : " byte written to diskfile " : strTempFile strMsgText = "Elements=" : ArrInfo (arrArray, 1) : @LF : udfArrayDumpToItemList (arrArray, @LF) Pause (strMsgTitle, strMsgText) arrB = udfArrayLoadFromFile (strTempFile) strMsgTitle = "Array B created, read from diskfile " : strTempFile strMsgText = "Elements=" : ArrInfo (arrB, 1) : @LF : udfArrayDumpToItemList (arrB, @LF) Pause (strMsgTitle, strMsgText) RunZoom ("notepad.exe", strTempFile) ;------------------------------------------------------------------------------------------------------------------------------------------ ;Test_Unload_Load_2 strMsgTitle = "Demo: Array dim-2 UnLoad Load Functions" BoxOpen (strMsgTitle : ": Processing", "Be patient") BoxText ("Creating test items ...") intDim1 = 20 intDim2 = 3 intDim1High = intDim1 - 1 intDim2High = intDim2 - 1 intDim1Low = 0 intDim2Low = 0 arrArray = ArrDimension (intDim1, intDim2) ArrInitialize (arrArray, 0) For intD2 = intDim2Low To intDim2High For intD1 = intDim1Low To intDim1High strItem = "" For intRandom = 1 To Random (25) strItem = strItem : Num2Char (65 + Random (25)) Next arrArray [intD1, intD2] = strItem Next Next BoxShut () strTempFile = Environment ("TEMP") : "\" : StrInsert (StrReplace (TimeYmdHms (), ":", ""), ".", "", 9, 1) : ".ArrTest2.txt" ; "2009:05:16:12:34:56" ==> "20090516.123456" intNum = udfArrayUnloadToFile (arrArray, strTempFile) strMsgTitle = "Array A " : intNum : " byte written to diskfile " : strTempFile strMsgText = "Elements: " : ArrInfo (arrArray, 6) : @LF : "Dims: " : ArrInfo (arrArray, 1) : ", " : ArrInfo (arrArray, 2) Pause (strMsgTitle, strMsgText) IntControl (63, 200, 200, 800, 800) udfArrayAskRow (strMsgTitle, arrArray, @UNSORTED, @SINGLE, 0) arrB = udfArrayLoadFromFile (strTempFile) strMsgTitle = "Array B created, read from diskfile " : strTempFile strMsgText = "Elements: " : ArrInfo (arrArray, 6) : @LF : "Dims: " : ArrInfo (arrArray, 1) : ", " : ArrInfo (arrArray, 2) Pause (strMsgTitle, strMsgText) IntControl (63, 200, 200, 800, 800) udfArrayAskRow (strMsgTitle, arrArray, @UNSORTED, @SINGLE, 0) RunZoom ("notepad.exe", strTempFile) :CANCEL Exit ;========================================================================================================================================== ;------------------------------------------------------------------------------------------------------------------------------------------ ; ; Demo: Array Sort Algorithms ; 2010:01:22:11:14:54 ; WIL interpreter 6.09did ; ItemCount: 1000 ; ItemLength max.: 100 ; ItemLength avg.: 48.9 ; ; Percent Ticks Function ; 81% 9640 udfArrayShellSortMV2 (arrArray) ; 100% 11812 udfArrayQuickSortNRV2 (arrArray) ; 83% 9922 udfArrayShellSortK (arrArray) ; 33% 3937 udfArrayItemSort (arrArray, @ASCENDING) ; 49% 5875 udfArrayItemSort (arrArray, @DESCENDING) ; 11% 1329 udfArrayBinSort (arrArray, @ASCENDING) ; 11% 1328 udfArrayBinSort (arrArray, @DESCENDING) ; 38% 4500 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @ASCENDING) ; 38% 4547 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @DESCENDING) ; Ticks Sum: 52890 ; ;------------------------------------------------------------------------------------------------------------------------------------------ ; ; Demo: Array Sort Algorithms ; 2009:05:20:11:56:43 ; WIL interpreter 6.09bib ; ItemCount: 2000 ; ItemLength max.: 200 ; ItemLength avg.: 100.1 ; ; Percent Ticks Function ; 100% 1360718 udfArrayPartSortV1 (arrArray) ; 73% 1000906 udfArrayPartSortV2 (arrArray) ; 92% 1253468 udfArrayBubbleSortV1 (arrArray) ; 61% 840860 udfArrayBubbleSortV2 (arrArray) ; 58% 795953 udfArrayGnomeSort (arrArray) ; 3% 49625 udfArrayMergeSortRB (arrArray, -1, -1) ; 2% 37844 udfArrayMergeSortR (arrArray, -1, -1) ; 21% 293516 udfArrayInsertSort (arrArray) ; 4% 55453 udfArrayShellSort (arrArray) ; 2% 31250 udfArrayShellSortMV1 (arrArray) ; 1% 22079 udfArrayShellSortMV2 (arrArray) ; 2% 28031 udfArrayQuickSortNRV1 (arrArray) ; 1% 24281 udfArrayQuickSortNRV2 (arrArray) ; 2% 31125 udfArrayHeapSort (arrArray) ; 2% 29016 udfArrayShellSortL (arrArray) ; 1% 23078 udfArrayShellSortK (arrArray) ; 1% 18781 udfArrayQuickSortRV1 (arrArray, -1, -1) ; 1% 17422 udfArrayQuickSortRV2 (arrArray, -1, -1) ; 2% 29078 udfArrayItemSort (arrArray, @ASCENDING) ; 3% 42282 udfArrayItemSort (arrArray, @DESCENDING) ; 0% 2688 udfArrayBinSort (arrArray, @ASCENDING) ; 0% 2704 udfArrayBinSort (arrArray, @DESCENDING) ; 31% 424579 udfItemListSortOrdinalV1 (strItemList, strDelimiter) ; 13% 187813 udfItemListSortOrdinalV2 (strItemList, strDelimiter) ; 14% 192813 udfItemListSortOrdinalV3 (strItemList, strDelimiter) ; 13% 187625 udfItemListSortOrdinalV4 (strItemList, strDelimiter) ; 2% 30156 udfItemListSortOrdinalV5 (strItemList, strDelimiter, @ASCENDING) ; 2% 29782 udfItemListSortOrdinalV5 (strItemList, strDelimiter, @DESCENDING) ; 1% 24094 udfItemListSortOrdinalV6 (strItemList, strDelimiter, @ASCENDING) ; 1% 24172 udfItemListSortOrdinalV6 (strItemList, strDelimiter, @DESCENDING) ; 1% 23281 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @ASCENDING) ; 1% 23265 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @DESCENDING) ; ;------------------------------------------------------------------------------------------------------------------------------------------ ; ; Demo: Array Sort Algorithms ; 2010:01:22:10:59:15 ; WIL interpreter 6.09did ; ItemCount: 30 ; ItemLength max.: 40 ; ItemLength avg.: 18.3 ; ; Percent Ticks Function ; 43% 313 udfArrayPartSortV1 (arrArray) ; 34% 250 udfArrayPartSortV2 (arrArray) ; 39% 281 udfArrayBubbleSortV1 (arrArray) ; 28% 203 udfArrayBubbleSortV2 (arrArray) ; 23% 172 udfArrayGnomeSort (arrArray) ; 65% 469 udfArrayMergeSortRB (arrArray, -1, -1) ; 52% 375 udfArrayMergeSortR (arrArray, -1, -1) ; 10% 78 udfArrayInsertSort (arrArray) ; 26% 188 udfArrayShellSort (arrArray) ; 21% 156 udfArrayShellSortMV1 (arrArray) ; 17% 125 udfArrayShellSortMV2 (arrArray) ; 45% 328 udfArrayQuickSortNRV1 (arrArray) ; 36% 266 udfArrayQuickSortNRV2 (arrArray) ; 28% 203 udfArrayHeapSort (arrArray) ; 21% 156 udfArrayShellSortL (arrArray) ; 15% 110 udfArrayShellSortK (arrArray) ; 23% 172 udfArrayQuickSortRV1 (arrArray, -1, -1) ; 21% 156 udfArrayQuickSortRV2 (arrArray, -1, -1) ; 2% 16 udfArrayItemSort (arrArray, @ASCENDING) ; 4% 31 udfArrayItemSort (arrArray, @DESCENDING) ; 4% 31 udfArrayBinSort (arrArray, @ASCENDING) ; 4% 31 udfArrayBinSort (arrArray, @DESCENDING) ; 100% 719 udfItemListSortOrdinalV1 (strItemList, strDelimiter) ; 15% 109 udfItemListSortOrdinalV2 (strItemList, strDelimiter) ; 17% 125 udfItemListSortOrdinalV3 (strItemList, strDelimiter) ; 17% 125 udfItemListSortOrdinalV4 (strItemList, strDelimiter) ; 17% 125 udfItemListSortOrdinalV5 (strItemList, strDelimiter, @ASCENDING) ; 15% 109 udfItemListSortOrdinalV5 (strItemList, strDelimiter, @DESCENDING) ; 17% 125 udfItemListSortOrdinalV6 (strItemList, strDelimiter, @ASCENDING) ; 15% 110 udfItemListSortOrdinalV6 (strItemList, strDelimiter, @DESCENDING) ; 15% 109 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @ASCENDING) ; 15% 109 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @DESCENDING) ; Ticks Sum: 5875 ;------------------------------------------------------------------------------------------------------------------------------------------ ; ; Demo: Array Sort Algorithms ; 2010:01:22:11:05:51 ; WIL interpreter 6.09did ; ItemCount: 100 ; ItemLength max.: 40 ; ItemLength avg.: 21.1 ; ; Percent Ticks Function ; 100% 3453 udfArrayPartSortV1 (arrArray) ; 73% 2547 udfArrayPartSortV2 (arrArray) ; 94% 3250 udfArrayBubbleSortV1 (arrArray) ; 62% 2141 udfArrayBubbleSortV2 (arrArray) ; 56% 1968 udfArrayGnomeSort (arrArray) ; 53% 1860 udfArrayMergeSortRB (arrArray, -1, -1) ; 41% 1422 udfArrayMergeSortR (arrArray, -1, -1) ; 23% 813 udfArrayInsertSort (arrArray) ; 26% 922 udfArrayShellSort (arrArray) ; 23% 828 udfArrayShellSortMV1 (arrArray) ; 18% 625 udfArrayShellSortMV2 (arrArray) ; 34% 1203 udfArrayQuickSortNRV1 (arrArray) ; 31% 1078 udfArrayQuickSortNRV2 (arrArray) ; 28% 1000 udfArrayHeapSort (arrArray) ; 22% 781 udfArrayShellSortL (arrArray) ; 15% 547 udfArrayShellSortK (arrArray) ; 21% 750 udfArrayQuickSortRV1 (arrArray, -1, -1) ; 20% 719 udfArrayQuickSortRV2 (arrArray, -1, -1) ; 1% 62 udfArrayItemSort (arrArray, @ASCENDING) ; 3% 125 udfArrayItemSort (arrArray, @DESCENDING) ; 3% 125 udfArrayBinSort (arrArray, @ASCENDING) ; 4% 141 udfArrayBinSort (arrArray, @DESCENDING) ; 81% 2812 udfItemListSortOrdinalV1 (strItemList, strDelimiter) ; 11% 406 udfItemListSortOrdinalV2 (strItemList, strDelimiter) ; 11% 407 udfItemListSortOrdinalV3 (strItemList, strDelimiter) ; 11% 391 udfItemListSortOrdinalV4 (strItemList, strDelimiter) ; 9% 312 udfItemListSortOrdinalV5 (strItemList, strDelimiter, @ASCENDING) ; 9% 312 udfItemListSortOrdinalV5 (strItemList, strDelimiter, @DESCENDING) ; 8% 297 udfItemListSortOrdinalV6 (strItemList, strDelimiter, @ASCENDING) ; 8% 297 udfItemListSortOrdinalV6 (strItemList, strDelimiter, @DESCENDING) ; 7% 266 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @ASCENDING) ; 7% 250 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @DESCENDING) ; Ticks Sum: 32110 ;------------------------------------------------------------------------------------------------------------------------------------------ ; ; Demo: Array Sort Algorithms ; 2010:01:22:11:10:03 ; WIL interpreter 6.09did ; ItemCount: 1000 ; ItemLength max.: 40 ; ItemLength avg.: 19.8 ; ; Percent Ticks Function ; 76% 9797 udfArrayShellSortMV2 (arrArray) ; 100% 12797 udfArrayQuickSortNRV2 (arrArray) ; 78% 10078 udfArrayShellSortK (arrArray) ; 16% 2172 udfArrayItemSort (arrArray, @ASCENDING) ; 26% 3391 udfArrayItemSort (arrArray, @DESCENDING) ; 10% 1343 udfArrayBinSort (arrArray, @ASCENDING) ; 10% 1328 udfArrayBinSort (arrArray, @DESCENDING) ; 23% 2985 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @ASCENDING) ; 23% 3000 udfItemListSortOrdinalV7 (strItemList, strDelimiter, @DESCENDING) ; Ticks Sum: 46891 ; ;------------------------------------------------------------------------------------------------------------------------------------------