2004-05-18
DD-Software
 Main Index |
 Backward |
 Forward |
 Top |
 Bottom |
| Page Date 2004-05-18 DD-Software |
|
|
|
MyWbtHelp current version |
|
||||
Array Sort Functions
;==========================================================================================================================================
; Collection of Array Sort algorithms including bonus tools.
; Adapted to WinBatch by Detlev Dalitz.20010720.20020718.20020823.20030222.20040325
;------------------------------------------------------------------------------------------------------------------------------------------
; udfArrPartSort (aArray) ; From slow
; udfArrBubbleSort (aArray) ; I
; udfArrInsertSort (aArray) ; I
; udfArrQuickSortNR (aArray) ; I ; QuickSort Non Recursive.
; udfArrShellSort (aArray) ; I
; udfArrShellMetznerSort (aArray) ; I
; udfArrHeapSort (aArray) ; I
; udfArrShellSortK (aArray) ; I
; udfArrQuickSortR (aArray) ; I ; QuickSort Recursive.
; udfArrItemSort (aArray, sDelimiter, iDirection) ; v
; udfArrBinSort (aArray, iDirection) ; to fast ?
; udfArrDistributionSort (aArray, iKeyCount) ; Special hash sort.
;------------------------------------------------------------------------------------------------------------------------------------------
; udfArrFileWrite (aArray, sFilename) ; Unload array to diskfile ; Returns filesize.
; udfArrFileRead (sFilename) ; Load aArray from diskfile ; Returns new array.
;------------------------------------------------------------------------------------------------------------------------------------------
; udfArrDump (aArray, sDelimiter) ; For testing dim-1 array ; Returns string.
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrpartsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrpartsort
#DefineFunction udfArrPartSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iHigh = iHigh-1
iLow = 0
iDone = 0
While !iDone
iDone = 1
For i=iLow To iHigh
If (aArray[i]>aArray[i+1])
aA = aArray[i]
aArray[i] = aArray[i+1]
aArray[i+1] = aA
iDone = 0
EndIf
Next
EndWhile
Return (aArray)
#EndFunction
:skip_udfarrpartsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrbubblesort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrbubblesort
#DefineFunction udfArrBubbleSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
ikHigh = Max(0,ArrInfo(aArray,1)-1)
iHigh = ikHigh-1
iLow = 0
For i=iLow To iHigh
ikLow = i+1
For k=ikLow To ikHigh
If (aArray[i]>aArray[k])
aA = aArray[i]
aArray[i] = aArray[k]
aArray[k] = aA
EndIf
Next
Next
Return (aArray)
#EndFunction
:skip_udfarrbubblesort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrinsertsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrinsertsort
#DefineFunction udfArrInsertSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
iiLow = 1+iLow
For i=iiLow To iHigh
aA = aArray[i]
ikHigh = i-1
For k=ikHigh To iLow By -1
If (aArray[k]<=aA) Then Break
aArray[k+1] = aArray[k]
Next
aArray[k+1] = aA
Next
Return (aArray)
;..........................................................................................................................................
; InsertSort algorithm adapted from:
; 'Sorting and Searching Algorithms, Thomas Niemann, ePaperPress, sortsearch.pdf, 12.05.2002 13:50:30'.
;..........................................................................................................................................
#EndFunction
:skip_udfarrinsertsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrshellsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrshellsort
#DefineFunction udfArrShellSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
iStart = Floor(Loge(Max(iHigh,2)-1)/Loge(2))
For i=iStart To 0 By -1
iStep = Exp(i*Loge(2))
For k=iStep To iHigh
aA = aArray[k]
iZ = k-iStep
iDone = (aA>=aArray[iZ])
While !iDone
aArray[iZ+iStep] = aArray[iZ]
iZ = iZ-iStep
iDone = 1
If (iZ>0) Then iDone = (aA>=aArray[iZ])
EndWhile
aArray[iZ+iStep] = aA
Next
Next
Return (aArray)
;..........................................................................................................................................
; Note:
; Using code fragment (B) instead of fragment (A) in the inner While loop
; tunes up the performance speed of this ShellSort implementation of about >=10 Pct.!
; (A)
; If (iZ>0)
; iDone = (aA>=aArray[iZ])
; Else
; iDone = 1
; EndIf
; (B)
; iDone = 1
; If (iZ>0) Then iDone = (aA>=aArray[iZ])
;..........................................................................................................................................
; ShellSort, developed by Donald L. Shell, is a non-stable in-place sort.
; ShellSort improves on the efficiency of insertion sort by quickly shifting values to their destination.
; For further reading, consult:
; Knuth, Donald. E. [1998]. The Art of Computer Programming, Volume 3,
; Sorting and Searching. Addison-Wesley, Reading, Massachusetts.
;..........................................................................................................................................
#EndFunction
:skip_udfarrshellsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrshellsortm",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrshellsortm
#DefineFunction udfArrShellSortM (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = ArrInfo(aArray,1)-1
iLow = 0
iMid = (iHigh-iLow+1)/2
While iMid
iTop = iHigh-iMid
For ii=iLow To iTop
ik = ii+iMid
If (aArray[ii]>aArray[ik])
aA = aArray[ii]
aArray[ii] = aArray[ik]
aArray[ik] = aA
EndIf
Next
For ii=iTop To iLow By -1
ik = ii+iMid
If (aArray[ii]>aArray[ik])
aA = aArray[ii]
aArray[ii] = aArray[ik]
aArray[ik] = aA
EndIf
Next
iMid = iMid/2
EndWhile
Return (aArray)
;..........................................................................................................................................
; This sorting algorithm is extremely efficient for sorting small and medium sized arrays.
;
; Adapted from a VBA routine in Woody's Office Watch, 1998, Vol. 3, No. 51,
; http://www.woodyswatch.com/office/
;
; "Diminishing increment sort" algorithm by Donald Lewis Shell resp. Marlene Metzner.
; First called Shell-Metzner in an article in Creative Computing in 1976, after Marlene Metzner.
; See also: Donald Lewis Shell, A High-Speed Sorting Procedure, CACM, 2(7):30-32, July 1959.
;
; This algorithm was improperly called the Shell-Metzner sort
; by John P. Grillo, A Comparison of Sorts, Creative Computing, 2:76-80, Nov/Dec 1976.
; On 3 April 2003 Marlene Metzner Norton wrote:
; "I had nothing to do with the sort, and my name should never have been attached to it."
;
;..........................................................................................................................................
#EndFunction
:skip_udfarrshellsortm
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrshellsortk",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrshellsortk
#DefineFunction udfArrShellSortK (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iElements = ArrInfo(aArray,1)
iArrayHigh = Max(0,iElements-1)
iArrayLow = 0
; Establish increment sequence (recommended by Knuth, due to Sedgewick).
aStep = ArrDimension(28) ; 28 elements in aStep fit for (2**31)-1 elements in aArray.
p1 = 1
p2 = 1
p3 = 1
s = -1
While 1
s = s+1
If (s mod 2)
aStep[s] = 1+(8*p1)-(6*p2)
Else
aStep[s] = 1+(9*p1)-(9*p3)
p2 = 2*p2
p3 = 2*p3
EndIf
p1 = 2*p1
If (3*aStep[s]>=iElements) Then Break
EndWhile
If (s>0) Then s = s-1
; ShellSort
While (s>=0)
iStep = aStep[s]
iiLow = iArrayLow + iStep
For i=iiLow To iArrayHigh
aA = aArray[i]
ikLow = i-iStep
For k=ikLow To iArrayLow By -iStep
If !(aArray[k]>aA) Then Break
aArray[k+iStep] = aArray[k]
Next
aArray[k+iStep] = aA
Next
s = s-1
EndWhile
Drop(aStep)
Return (aArray)
;..........................................................................................................................................
; ShellSort algorithm with Knuth's increment sequence adapted from the Visual Basic example in
; 'Sorting and Searching Algorithms, Thomas Niemann, ePaperPress, sortsearch.pdf, 12.05.2002 13:50:30'.
;..........................................................................................................................................
; ShellSort, developed by Donald L. Shell, is a non-stable in-place sort.
; ShellSort improves on the efficiency of insertion sort by quickly shifting values to their destination.
; For further reading, consult:
; Knuth, Donald. E. [1998]. The Art of Computer Programming, Volume 3,
; Sorting and Searching. Addison-Wesley, Reading, Massachusetts.
;..........................................................................................................................................
#EndFunction
:skip_udfarrshellsortk
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrheapsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrheapsort
#DefineFunction udfArrHeapSort (aArray)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iN = ArrInfo(aArray,1)
iR = iN
iM = (iN/2)-1
For i=iM To 0 By -1
iL = i
aA = aArray[iL]
While (iL<(iR/2))
iNext = iL+iL+1
If ((iNext+1)<iR) Then If (aArray[iNext]<aArray[iNext+1]) Then iNext = iNext+1
If (aA>=aArray[iNext]) Then Break
aArray[iL] = aArray[iNext]
iL = iNext
EndWhile
aArray[iL] = aA
Next
While (iN>1)
aA = aArray[0]
aArray[0] = aArray[iN-1]
aArray[iN-1] = aA
iN = iN-1
iR = iN
iL = 0
aA = aArray[iL]
While (iL<(iR/2))
iNext = iL+iL+1
If ((iNext+1)<iR) Then If (aArray[iNext]<aArray[iNext+1]) Then iNext = iNext+1
If (aA>=aArray[iNext]) Then Break
aArray[iL] = aArray[iNext]
iL = iNext
EndWhile
aArray[iL] = aA
EndWhile
Return (aArray)
;..........................................................................................................................................
; Heapsort Algorithm adapted from:
; 'Algorithmen und Datenstrukturen, Prof. Dr. Gerald Timmer, 1998-11-06, Fachhochschule Osnabrück'.
; Reference: 'http://gtsun.et.fh-osnabrueck.de/lehre/algorithmen/alds-skript/node20.html'.
;
; Detlev Dalitz.20020822
;..........................................................................................................................................
#EndFunction
:skip_udfarrheapsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrquicksortnr",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrquicksortnr
#DefineFunction udfArrQuickSortNR (aArray) ; Non recursive QuickSort.
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
aStackLeft = ArrDimension(100)
aStackRight = ArrDimension(100)
aStackLeft[1] = iLow
aStackRight[1] = iHigh
iStack = 1
While (iStack>0)
If (aStackLeft[iStack]>=aStackRight[iStack])
iStack = iStack-1
Else
iL = aStackLeft[iStack]
iR = aStackRight[iStack]
aPivot = aArray[iR]
iMid = (iL+iR)/2
If ((iR-iL)>5)
If ((aArray[iMid]<aPivot) && (aArray[iMid]>aArray[iL])) || ((aArray[iMid]>aPivot) && (aArray[iMid]<aArray[iL]))
aA = aArray[iMid]
aArray[iMid] = aArray[iR]
aArray[iR] = aA
EndIf
Else
If ((aArray[iL]<aArray[iMid]) && (aArray[iL]>aPivot)) || ((aArray[iL]>aArray[iMid]) && (aArray[iL]<aPivot))
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
EndIf
EndIf
aPivot = aArray[iR]
While (iL<iR)
While (aArray[iL]<aPivot)
iL = iL+1
EndWhile
iR = iR-1
While ((iL<iR) && (aPivot<aArray[iR]))
iR = iR-1
EndWhile
If (iL<iR)
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
EndIf
EndWhile
iR = aStackRight[iStack]
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
If ((iL-aStackLeft[iStack])>=(aStackRight[iStack]-iL))
aStackLeft[iStack+1] = aStackLeft[iStack]
aStackRight[iStack+1] = iL-1
aStackLeft[iStack] = iL+1
Else
aStackLeft[iStack+1] = iL+1
aStackRight[iStack+1] = aStackRight[iStack]
aStackRight[iStack] = iL-1
EndIf
iStack = iStack+1
EndIf
EndWhile
Drop(aStackLeft,aStackRight)
Return (aArray)
#EndFunction
:skip_udfarrquicksortnr
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrquicksortr",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrquicksortr
#DefineFunction udfArrQuickSortR (aArray) ; Recursive QuickSort.
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
udfArrQSortR(aArray,iLow,iHigh)
Return (aArray)
#EndFunction
#DefineFunction udfArrQSortR (aArray, iLow, iHigh)
; This function "udfArrQSortR" should be called first only from inner "udfArrQuickSortR" or by itself!
If (iLow<iHigh)
aPivot = aArray[(iLow+iHigh)/2]
iL = iLow
iR = iHigh
While (iL<=iR)
While (aArray[iL]<aPivot)
iL = iL+1
EndWhile
While (aPivot<aArray[iR])
iR = iR-1
EndWhile
If (iL<=iR)
aA = aArray[iL]
aArray[iL] = aArray[iR]
aArray[iR] = aA
iL = iL+1
iR = iR-1
EndIf
EndWhile
udfArrQSortR(aArray,iLow,iR)
udfArrQSortR(aArray,iL,iHigh)
EndIf
Return (aArray)
#EndFunction
:skip_udfarrquicksortr
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemsort
#DefineFunction udfArrItemSort (aArray, sDelimiter, iDirection)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
If (VarType(aArray[0])<>2) Then Return (aArray) ; Only strings wanted.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
sSort = ""
For i=iLow To iHigh
sSort = ItemInsert(aArray[i],-1,sSort,sDelimiter)
Next
sSort = ItemSort(sSort,sDelimiter)
Select iDirection
Case @ASCENDING
Drop(aArray)
aArray = Arrayize(sSort,sDelimiter)
Break
Case @DESCENDING
For i=iHigh To iLow By -1
aArray[iHigh-i] = ItemExtract(i+1,sSort,sDelimiter)
Next
Break
EndSelect
Return (aArray)
;..........................................................................................................................................
; Sort parameter:
; iDirection=@ASCENDING
; iDirection=@DESCENDING
;..........................................................................................................................................
;..........................................................................................................................................
; Note:
; Using code fragment (B) instead of fragment (A) for writing sorted items back to array
; tunes up the performance speed of the ascending sort implementation of about 30 Pct.!
; (A)
; For i=iLow To iHigh
; aArray[i] = ItemExtract(i+1,sSort,sDelimiter)
; Next
; (B)
; Drop(aArray)
; aArray = Arrayize(sSort,sDelimiter)
;..........................................................................................................................................
#EndFunction
:skip_udfarritemsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrbinsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrbinsort
#DefineFunction udfArrBinSort (aArray, iDirection)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
If (VarType(aArray[0])<>2) Then Return (aArray) ; Only strings wanted.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
iLengthMax = 0
For i=iLow To iHigh
iLengthMax = Max(iLengthMax,StrLen(aArray[i]))
Next
hBB = BinaryAlloc(iLengthMax*ArrInfo(aArray,1))
For i=iLow To iHigh
BinaryPokeStr(hBB,i*iLengthMax,aArray[i])
Next
BinarySort(hBB,iLengthMax,0,iLengthMax,@STRING|iDirection)
For i=iLow To iHigh
aArray[i] = BinaryPeekStr(hBB,i*iLengthMax,iLengthMax)
Next
BinaryFree(hBB)
Return (aArray)
;..........................................................................................................................................
; Sort parameter:
; iDirection=@ASCENDING
; iDirection=@DESCENDING
;..........................................................................................................................................
#EndFunction
:skip_udfarrbinsort
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrdistributionsort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrdistributionsort
#DefineFunction udfArrDistributionSort (aArray, iKeyCount)
If (VarType(aArray)!=256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
If (ArrInfo(aArray,1)==0) Then Return (aArray) ; No elements.
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
; How many different keys exist?
; If fix number is known, then following computing is not necessary.
If !iKeyCount
sItemList = ""
For i=iLow To iHigh
If (ItemLocate(aArray[i],sItemList,@TAB)==0) Then sItemList = ItemInsert(aArray[i],-1,sItemList,@TAB)
Next
iKeyCount = ItemCount(sItemList,@TAB)
EndIf
aArrayBins = ArrDimension(iKeyCount)
aArrayStart = ArrDimension(iKeyCount)
aArraySave = ArrDimension(1+iHigh)
ArrInitialize(aArrayBins,0)
ArrInitialize(aArrayStart,0)
For i=iLow To iHigh
aArraySave[i] = aArray[i] ; Copy Array to ArraySave.
iIndexBins = (Max(0,Char2Num(aArray[i])-65)) ; Hier die entsprechende Abbildungsfunktion anwenden.
aArrayBins[iIndexBins] = 1+aArrayBins[iIndexBins] ; Count the number of each key value.
Next
; Compute the start position of each bin.
iPos = 0
iKeyHigh = iKeyCount-1
For i=1 To iKeyHigh
iPos = iPos + aArrayBins[i-1]
aArrayStart[i] = iPos
Next
; Deal the saved array back to the original.
For i=iLow To iHigh
iIndexSave = (Max(0,Char2Num(aArraySave[i])-65)) ; Hier die entsprechende Abbildungsfunktion anwenden.
StartIndex = aArrayStart[iIndexSave]
aArray[StartIndex] = (Num2Char(iIndexSave+65)) ; Hier die entsprechende _inverse_ Abbildungsfunktion anwenden.
aArrayStart[iIndexSave] = 1+aArrayStart[iIndexSave]
Next
Drop(aArrayBins,aArraySave,aArrayStart)
Return(aArray)
;..........................................................................................................................................
; Is this an example for ideal hashing?
;
; Adopted from Pascal source published by
; James L. Allison, 1703 Neptune Lane, Houston, Texas 77062, Dec 22, 1988.
; "This is a real screamer, but it takes a lot of space,
; and is hard to package for inclusion in a library.
; It requires prior knowledge of how the Array and keys are structured.
; It is only feasible where there are a small number of possible keys.
; In this example, there are only 256 different values.
; It works well, for example, where the key is sex, department or state.
; It would be a disaster if the keys were name or phone number."
;..........................................................................................................................................
#EndFunction
:skip_udfarrdistributionsort
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfArrFileWrite",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfArrFileWrite
#DefineFunction udfArrFileWrite (aArray, sFilename)
If (VarType(aArray)<>256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,6)==0) Then Return (aArray) ; No elements.
sArrInfo0 = "ArrInfo;0;{{0}};number of dimensions in the array"
sArrInfo1 = "ArrInfo;1;{{1}};number of elements in dimension 1"
sArrInfo2 = "ArrInfo;2;{{2}};number of elements in dimension 2"
sArrInfo3 = "ArrInfo;3;{{3}};number of elements in dimension 3"
sArrInfo4 = "ArrInfo;4;{{4}};number of elements in dimension 4"
sArrInfo5 = "ArrInfo;5;{{5}};number of elements in dimension 5"
sArrInfo6 = "ArrInfo;6;{{6}};number of elements in the entire array"
iDims = ArrInfo(aArray,0)
indexfill = ""
If (iDims<5)
iDimnext = iDims + 1
indexfill = ",0"
For i=iDimnext To 4
indexfill = ItemInsert("0",-1,indexfill,",")
Next
EndIf
For i=1 To 5
e%i% = Max(ArrInfo(aArray,i)-1,0)
Next
hFW = FileOpen(sFilename,"WRITE")
; Write header
FileWrite(hFW,"<ARRINFO>")
For i=0 To 6
FileWrite(hFW,StrReplace(sArrInfo%i%,"{{%i%}}",ArrInfo(aArray,i)))
Next
FileWrite(hFW,"</ARRINFO>")
FileWrite(hFW,"<ARRDATA>")
; Write data.
For d1=0 To e1
For d2=0 To e2
For d3=0 To e3
For d4=0 To e4
For d5=0 To e5
index = ""
For i=1 To iDims
index = ItemInsert(d%i%,-1,index,",")
Next
iVarType = VarType(aArray[%index%])
index5 = StrCat(index,indexfill)
If iVarType
FileWrite(hFW,StrCat(index5,";",iVarType,";",aArray[%index%]))
Else
FileWrite(hFW,StrCat(index5,";",iVarType,";"))
EndIf
Next
Next
Next
Next
Next
FileWrite(hFW,"</ARRDATA>")
FileClose(hFW)
Return (FileSizeEx(sFilename))
;..........................................................................................................................................
; This function "ArrFileWrite" creates a specific array definition textfile from array,
; which can be used to load data back into an array by function "udfArrFileRead".
;
; Detlev Dalitz.20010731.20020828.20030222
;..........................................................................................................................................
#EndFunction
:skip_udfArrFileWrite
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfArrFileRead",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfArrFileRead
#DefineFunction udfArrFileRead (sFilename)
If !FileSizeEx(sFilename) Then Goto CANCEL
IntControl(65,4096*256,0,0,0) ; Enlarge fileread buffer for speedy access.
hFR = FileOpen(sFilename,"READ")
If !hFR Then Goto CANCEL
iResult = 0
While 1
sLine = FileRead(hFR)
If (sLine == "*EOF*") Then Goto CANCEL
If (sLine == "<ARRINFO>") Then Break
EndWhile
; Read header, must be 7 lines on top of the file.
While 1
sLine = FileRead(hFR)
If (sLine == "*EOF*") Then Goto CANCEL
If (sLine == "</ARRINFO>") Then Break
If (sLine == "") Then Continue
If ("ArrInfo" <> ItemExtract(1,sLine,";")) Then Break
iIndex = ItemExtract(2,sLine,";")
If (StrSub("0123456",iIndex+1,1) <> iIndex) Then Break
sArrInfo%iIndex% = ItemExtract(3,sLine,";")
EndWhile
While 1
sLine = FileRead(hFR)
If (sLine == "*EOF*") Then Goto CANCEL
If (sLine == "<ARRDATA>") Then Break
EndWhile
; Declare Array.
aArray = ArrDimension(sArrInfo1,sArrInfo2,sArrInfo3,sArrInfo4,sArrInfo5)
iDimnext = ArrInfo(aArray,0) + 1
; Read data.
While 1
sLine = FileRead(hFR)
If (sLine == "*EOF*") Then Goto CANCEL
If (sLine == "</ARRDATA>") Then Break
If (sLine == "") Then Continue
ArrIndex = ItemExtract(1,sLine,";")
ArrType = ItemExtract(2,sLine,";")
ArrData = ItemExtract(3,sLine,";")
For i=5 To iDimnext By -1
ArrIndex = ItemRemove(i,ArrIndex,",")
Next
Switch (ArrType)
Case 2 ; VARTYPE_STRING
aArray[%ArrIndex%] = ArrData
Break
Case 1 ; VARTYPE_INT
Case 65 ; VARTYPE_BINARY
Case 17 ; VARTYPE_OLEOBJECT
Case 5 ; VARTYPE_FILE
aArray[%ArrIndex%] = 0+ArrData
Break
Case 32 ; VARTYPE_FLOATNUM
aArray[%ArrIndex%] = 1.*ArrData
Break
EndSwitch
EndWhile
iResult = 1
:CANCEL
If IsDefined(hFR) Then FileClose(hFR)
If !iResult Then Return (ArrDimension(1))
Return (aArray)
;..........................................................................................................................................
; This function ""ArrFileRead" creates an array from a specific array definition textfile,
; which has been created previously by function "udfArrFileWrite".
;
; Detlev Dalitz.20010731.20020828.20030222
;..........................................................................................................................................
#EndFunction
:skip_udfArrFileRead
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrdump",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrdump
#DefineFunction udfArrDump (aArray, sDelimiter)
If (VarType(aArray)<>256) Then Return ("Dump not available. No Array.")
If (ArrInfo(aArray,6)==0) Then Return ("Dump not available. No Elements.")
If (ArrInfo(aArray,0)>1) Then Return ("Dump not available. Array has more than 1 Dimension.")
iHigh = Max(0,ArrInfo(aArray,1)-1)
iLow = 0
sItemList = ""
For i=iLow To iHigh
If VarType(aArray[i])
If (aArray[i]=="")
sItemList = ItemInsert("*NULL*",-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert(aArray[i],-1,sItemList,sDelimiter)
EndIf
Else
sItemList = ItemInsert("*N/A*",-1,sItemList,sDelimiter)
EndIf
Next
sItemList = StrCat("Elements=",1+iHigh,@CRLF,sItemList)
Return (sItemList)
#EndFunction
:skip_udfarrdump
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
; --- test ----
;==========================================================================================================================================
:testsort
;==========================================================================================================================================
logo = "Demo Array Sort Algorithms"
test1 = "udfArrPartSort (aArray)"
test2 = "udfArrBubbleSort (aArray)"
test3 = "udfArrInsertSort (aArray)"
test4 = "udfArrShellSort (aArray)"
test5 = "udfArrShellSortM (aArray)"
test6 = "udfArrQuickSortNR (aArray)"
test7 = "udfArrHeapSort (aArray)"
test8 = "udfArrShellSortK (aArray)"
test9 = "udfArrQuickSortR (aArray)"
test10 = "udfArrItemSort (aArray, sDelimiter, @ASCENDING)"
test11 = "udfArrItemSort (aArray, sDelimiter, @DESCENDING)"
test12 = "udfArrBinSort (aArray, @ASCENDING)"
test13 = "udfArrBinSort (aArray, @DESCENDING)"
test14 = "udfArrDistributionSort (aArray, iKeyCount)"
sTestFunctionList = ""
For i=1 To 14
If IsDefined(test%i%) Then sTestFunctionList=StrCat(sTestFunctionList,test%i%,@TAB)
Next
iCount = ItemCount(sTestFunctionList,@TAB)
sAskList = ""
While (sAskList=="")
sAskList = sTestFunctionList
sAskList = AskItemlist(StrCat(logo,": Select one or more functions to test"),sAskList,@TAB,@UNSORTED,@EXTENDED)
EndWhile
sTestFunctionList = sAskList
Drop(sAskList)
iTestItemCountDefault = 30
iTestItemCount = AskLine(logo,"How many items in Array?",iTestItemCountDefault)
iTestItemCount = Max(iTestItemCount,10)
iTestItemLengthDefault = 40
iTestItemLength = AskLine(logo,"How max length of each item?",iTestItemLengthDefault)
iTestItemLength = Max(iTestItemLength,1)
BoxOpen(StrCat(logo,": Processing"), "Be patient")
BoxText("Creating test items ...")
; Create TestItems.
sSort = ""
sBoxText = StrCat("Creating test item ...",@LF,iTestItemCount,"/")
For i=1 To iTestItemCount
sItem = ""
For k=1 To Random(1+iTestItemLength)
sItem = StrCat(sItem,Num2Char(65 + Random(25)))
Next
If !(i mod (iTestItemCount/10)) Then BoxText(StrCat(sBoxText,i,@LF,sItem))
sSort = ItemInsert(sItem,-1,sSort,"|")
Next
Drop(i,iTestItemCount,iTestItemCountDefault,iTestItemLength,iTestItemLengthDefault,k,sBoxText,sItem)
; The test loop.
iKeyCount = 26
sDelimiter = @TAB
iTicksMax = 0
iCount = ItemCount(sTestFunctionList,@TAB)
For i=1 To iCount
TestFunction = ItemExtract(i,sTestFunctionList,@TAB)
BoxText(StrCat(TestFunction,@LF,"sorting ..."))
aArray = Arrayize(sSort,"|")
Exclusive(@ON)
iStart = GetTickCount()
aArray = %TestFunction%
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%i% = iStop-iStart
iTicksMax = Max(iTicks%i%,iTicksMax)
sMsg = StrCat(TestFunction,@LF)
If (ArrInfo(aArray,1)<50) Then sMsg = StrCat(sMsg,udfArrDump(aArray,@LF),@LF)
sMsg = StrCat(sMsg,"iTicks=",iTicks%i%)
Display(10,TestFunction,sMsg)
Drop(aArray)
Next
BoxShut()
sMsg = ""
For i=1 To iCount
TestFunction = ItemExtract(i,sTestFunctionList,@TAB)
sMsg = StrCat(sMsg,100*iTicks%i%/iTicksMax,"%%",@TAB,iTicks%i%,@TAB,TestFunction,@LF)
Next
Pause(StrCat(logo,": Summary"),sMsg)
;==========================================================================================================================================
:testload_1
;==========================================================================================================================================
logo = "Demo Array UnLoad Load Functions"
BoxOpen(StrCat(logo,": Processing"), "Be patient")
BoxText("Creating test items ...")
iDim1 = 20
iDim1High = iDim1-1
iDim1Low = 0
aArray = ArrDimension(iDim1)
ArrInitialize(aArray,0)
For iD1=iDim1Low To iDim1High
sItem = ""
For iRandom=1 To Random(25)
sItem = StrCat(sItem,Num2Char(65 + Random(25)))
Next
aArray[iD1] = sItem
Next
BoxShut()
TempFile = StrCat(Environment("temp"),"\arrtest1.txt")
num = udfArrFileWrite(aArray,TempFile)
Pause(StrCat("Array A ",num," byte written to diskfile ",TempFile),udfArrDump(aArray,@LF))
aArrayB = udfArrFileRead(TempFile)
Pause(StrCat("Array B created, read from diskfile ",TempFile),udfArrDump(aArrayB,@LF))
RunZoom("notepad",TempFile)
;==========================================================================================================================================
:testload_2
;==========================================================================================================================================
logo = "Demo Array UnLoad Load Functions"
BoxOpen(StrCat(logo,": Processing"), "Be patient")
BoxText("Creating test items ...")
iDim1 = 20
iDim2 = 3
iDim1High = iDim1-1
iDim2High = iDim2-1
iDim1Low = 0
iDim2Low = 0
aArray = ArrDimension(iDim1,iDim2)
ArrInitialize(aArray,0)
For iD2=iDim2Low To iDim2High
For iD1=iDim1Low To iDim1High
sItem = ""
For iRandom=1 To Random(25)
sItem = StrCat(sItem,Num2Char(65 + Random(25)))
Next
aArray[iD1,iD2] = sItem
Next
Next
BoxShut()
TempFile = StrCat(Environment("temp"),"\arrtest2.txt")
num = udfArrFileWrite(aArray,TempFile)
Pause(StrCat("Array A ",num," byte written to diskfile ",TempFile),udfArrDump(aArray,@LF))
aB = udfArrFileRead(TempFile)
Pause(StrCat("Array B created, read from diskfile ",TempFile),udfArrDump(aB,@LF))
RunZoom("notepad",TempFile)
:CANCEL
Exit
;==========================================================================================================================================
;*EOF*
|
||||
|
||||
udfArrCopy (Array)
If ItemLocate("udfarrcopy",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrcopy
#DefineFunction udfArrCopy (aArray)
dims = ArrInfo(aArray,0)
For i=1 To 5
dim%i% = ArrInfo(aArray,i)
Next
aArrayNew = ArrDimension(dim1, dim2, dim3, dim4, dim5)
For i=1 To 5
dim%i% = dim%i% - 1
Next
Gosub %dims%
Return (aArrayNew)
:1
For a=0 To dim1
aArrayNew[a] = aArray[a]
Next
Return
:2
For a=0 To dim1
For b=0 To dim2
aArrayNew[a,b] = aArray[a,b]
Next
Next
Return
:3
For a=0 To dim1
For b=0 To dim2
For c=0 To dim3
aArrayNew[a,b,c] = aArray[a,b,c]
Next
Next
Next
Return
:4
For a=0 To dim1
For b=0 To dim2
For c=0 To dim3
For d=0 To dim4
aArrayNew[a,b,c,d] = aArray[a,b,c,d]
Next
Next
Next
Next
Return
:5
For a=0 To dim1
For b=0 To dim2
For c=0 To dim3
For d=0 To dim4
For e=0 To dim5
aArrayNew[a,b,c,d,e] = aArray[a,b,c,d,e]
Next
Next
Next
Next
Next
Return
; ? published by George Vagenas in Spring 2001 ?
; modified by Detlev Dalitz.20020203
#EndFunction
:skip_udfarrcopy
;--- test ---
myArray1 = ArrDimension(2,4,6,5,3)
myElements1 = ArrInfo(myArray1,6)
ArrInitialize(myArray1,221)
myArray2 = udfArrCopy(myArray1)
myElements2 = ArrInfo(myArray2,6)
Exit
;*EOF*
|
||||
|
||||
udfArrItemize (aArray, sDelimiter)
;----------------------------------------------------------------------------------------------------------------------
; udfArrItemize (aArray, sDelimiter) ; 2002:07:17:20:56:38
; udfArrItemizeEx (aArray, sDelimiter) ; 2002:07:17:20:56:38
;----------------------------------------------------------------------------------------------------------------------
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemize",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemize
#DefineFunction udfArrItemize (aArray, sDelimiter)
If (VarType(aArray)<>256) Then Return ("") ; No array.
If (ArrInfo(aArray,6)==0) Then Return ("") ; No elements.
If (ArrInfo(aArray,0)>1) Then Return ("") ; Too much dimensions.
sItemList = ""
iHigh = Max(ArrInfo(aArray,1)-1,0)
iLow = 0
For i=iLow To iHigh
If VarType(aArray[i])
sItemList = ItemInsert(aArray[i],-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert("",-1,sItemList,sDelimiter)
EndIf
Next
Return (sItemList)
;----------------------------------------------------------------------------------------------------------------------
; This udf "udfArrItemize" returns an itemlist with each item separated by delimiter character.
;
; Example: myItemList = udfArrayItemize (myArray, @TAB)
; Creates an ItemList from Array.
;
; Note:
; This udf supports only 1-dim Array.
; An Array element which is not initialized has a Vartype=0 (undefined).
; Therefore an empty item will be appended to target itemlist.
;
; Detlev Dalitz.20020718
;----------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarritemize
;----------------------------------------------------------------------------------------------------------------------
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemizeex",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemizeex
#DefineFunction udfArrItemizeEx (aArray, sDelimiter)
If (VarType(aArray)<>256) Then Return ("") ; No array.
If (ArrInfo(aArray,6)==0) Then Return ("") ; No elements.
dims = ArrInfo(aArray,0)
For i=1 To 5
e%i% = Max(ArrInfo(aArray,i)-1,0)
Next
sItemList = ""
For d1=0 To e1
For d2=0 To e2
For d3=0 To e3
For d4=0 To e4
For d5=0 To e5
index=""
For i=1 To dims
index = ItemInsert(d%i%,-1,index,",")
Next
If VarType(aArray[%index%])
sItemList = ItemInsert(aArray[%index%],-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert("",-1,sItemList,sDelimiter)
EndIf
Next
Next
Next
Next
Next
Return (sItemList)
;----------------------------------------------------------------------------------------------------------------------
; This udf "udfArrItemizeEx" returns an sItemlist with each item separated by sDelimiter character.
;
; Example: myItemList = udfArrayItemize (myArray, @tab)
; Creates an ItemList from Array.
;
; Note:
; This udf supports 1-dim to 5-dim Array.
; An Array element which is not initialized has a Vartype=0 (undefined).
; Therefore an empty item will be appended to target itemlist.
;
; Detlev Dalitz.20020718
;----------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarritemizeex
;----------------------------------------------------------------------------------------------------------------------
; --- test ---
sMsgTitle = "Demo udfArrayItemizeEx (aArray, sDelimiter)"
sFilename = IntControl(1004,0,0,0,0) ; We use this file as test input.
; Count lines.
iLineCount = 0
hfr = FileOpen(sFilename,"READ")
While 1
sLine = FileRead(hfr)
If (sLine=="*EOF*") Then Break
iLineCount = iLineCount + 1
EndWhile
FileClose(hfr)
; Define a 2-dim array.
aMyArray = ArrDimension(iLineCount,5) ; 2nd dimension is oversized, may contain not initialized elements
Message (sMsgTitle, StrCat("MyArray contains ",ArrInfo(aMyArray,6)," elements."))
; Fill the array with data from this file.
iLineCount = 0
hfr = FileOpen(sFilename,"READ")
While 1
sLine = FileRead(hfr)
If (sLine=="*EOF*") Then Break
aMyArray[iLineCount,0] = iLineCount+1 ; Line number.
aMyArray[iLineCount,1] = sLine ; Line content.
; aMyArray[iLineCount,2] ; NOT initialized.
; aMyArray[iLineCount,3] ; NOT initialized.
aMyArray[iLineCount,4] = Random(99999) ; Any random number.
iLineCount = iLineCount + 1
EndWhile
FileClose(hfr)
sMyItemList = udfArrItemizeEx (aMyArray, @TAB)
iItemCount = ItemCount(sMyItemList,@TAB)
Message (sMsgTitle, StrCat("MyItemList contains ",iItemCount," items."))
IntControl(28,1,0,0,0)
IntControl(63,100,100,900,900)
AskItemlist (sMsgTitle, sMyItemList, @TAB, @UNSORTED, @SINGLE)
:CANCEL
Exit
;----------------------------------------------------------------------------------------------------------------------
;*EOF*
|
||||
|
||||
udfStrArrayize (sString, bMode)
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrarrayize",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfstrarrayize
#DefineFunction udfStrArrayize (sString, bMode)
If (sString=="") Then Return (ArrDimension(1)) ; 1-dim array with undefined element, must be tested by the caller
bMode = Min(1,Max(0,bMode))
iStrLen = StrLen(sString)
Select bMode
Case 0
aArray = ArrDimension(iStrLen)
For i=1 To iStrLen
aArray[i-1] = StrSub(sString,i,1)
Next
Break
Case 1
aArray = ArrDimension(iStrLen + 1)
aArray[0] = iStrLen
For i=1 To iStrLen
aArray[i] = StrSub(sString,i,1)
Next
Break
EndSelect
Return (aArray)
;----------------------------------------------------------------------------------------------------------------------
; This udf "udfStrArrayize" splits the input sString into it's separate characters
; and returns a 1-dim aArray which contains one character per field element.
;
; If input sString is empty, then this udf returns an 'empty' 1-dim aArray,
; that means, there is one element in the Array, which has it's datatype undefined.
; The caller has to test this error result.
;
; bMode = 0 = creates a zero-based array,
; string length resp. array dimension can be evaluated by WIL function "ArrInfo (array, 1)".
; bMode = 1 = creates a one-based array,
; array element[0] contains the length of the string as an integer number.
;
; Detlev Dalitz.20020516
;----------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfstrarrayize
;----------------------------------------------------------------------------------------------------------------------
; --- test ---
sString = "that's a string" ; sString testcase 1
;sString = "" ; sString testcase 2
;bMode = 0 ; bMode testcase 1 ; zero based array
bMode = 1 ; bMode testcase 2 ; one based array
sMsgTitle = 'Demo udfStrArrayize (sString)'
sMsgText = StrCat('sString = "',sString,'"',@crlf,'aArray =',@crlf)
aArray = udfStrArrayize (sString, bMode)
If VarType(aArray[0]) ; Is the first element defined? (that is Vartype <> 0)
iCount = ArrInfo(aArray,1)-1
For i=0 To iCount
sMsgText = StrCat(sMsgText,'[',i,']',@tab,aArray[i],@crlf)
Next
Message(sMsgTitle,sMsgText)
Else
sMsgText = StrCat(sMsgText,'VarType(aArray[0]) is zero.',@crlf)
sMsgText = StrCat(sMsgText,'Datatype of first element is undefined.',@crlf)
sMsgText = StrCat(sMsgText,'maybe: String is empty, cannot create Array.',@crlf)
Message(sMsgTitle,sMsgText)
EndIf
Exit
;----------------------------------------------------------------------------------------------------------------------
;*EOF*
|
||||
|
||||
udfArrAskRow (sTitle, aArray, iSortMode, iSelectMode, iAskMode)
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarraskrow",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarraskrow
#DefineFunction udfArrAskRow (sTitle, aArray, iSortMode, iSelectMode, iAskMode)
iSortMode = Max(@UNSORTED,Min(@SORTED,iSortMode))
iSelectMode = Max(@SINGLE,Min(@EXTENDED,iSelectMode))
iAskMode = Max(0,Min(1,iAskMode))
chDelimItem = @TAB
chDelimRow = "|"
iDimMin = 1
iDimMax = 2
iDim = ArrInfo(aArray,0)
If (iDim > iDimMax) Then Return ("")
If (iDim < iDimMin) Then Return ("")
For i=1 To iDimMax
e%i%=Max(ArrInfo(aArray,i)-1,0)
Next
sAskList = ""
For d1=0 To e1
sRow = ""
For d2=0 To e2
index = ""
For i=1 To iDim
index = ItemInsert(d%i%,-1,index,",")
Next
sRow = ItemInsert(aArray[%index%],-1,sRow,chDelimItem)
Next
sRow = ItemInsert(d1,-1,sRow,chDelimItem) ; add Row number at end of sRow
sAskList = ItemInsert(sRow,-1,sAskList,chDelimRow)
Next
sResultList = ""
sRowList = AskItemlist(sTitle,sAskList,chDelimRow,iSortMode,iSelectMode)
Select iAskMode
Case 0
iCount = ItemCount(sRowList,chDelimRow)
For i=1 To iCount
sRowItem = ItemExtract(i,sRowList,chDelimRow)
sRowNum = ItemExtract(-1,sRowItem,chDelimItem)
sResultList = ItemInsert(sRowNum,-1,sResultList,chDelimRow)
Next
Break
Case 1
sResultList = sRowList
Break
EndSelect
:CANCEL
Return (sResultList)
;------------------------------------------------------------------------------------------------------------------------------------------
; parameters:
; sTitle = Title of the AskItemList box.
; aArray = 1-Dim or 2-Dim Array variable.
; iSortMode = @sorted for an alphabetic list.
; iSortMode = @unsorted to display the list of items as is.
; iSelectMode = @single to limit selection to one item.
; iSelectMode = @multiple to allow selection of more than one item.
; iSelectMode = @extended to allow selection of multiple items by extending the selection with the mouse or shift key.
; iAskMode = 0 to return a list of selected Array sRow index/es delimited by "|"
; iAskMode = 1 to return a list of selected Array sRow/s delimited by "|"
; If aArray 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
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarraskrow
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
; create 2-Dim test Array with iDim1 sRows and iDim2 columns
iDim1 = 4
iDim2 = 4
aArray = ArrDimension(iDim1,iDim2)
aArray[0,0] = "Mickey"
aArray[0,1] = "Mouse"
aArray[0,2] = 11
aArray[0,3] = "MM"
aArray[1,0] = "Goofy"
aArray[1,1] = "Dog"
aArray[1,2] = 22
aArray[1,3] = "GD"
aArray[2,0] = "Carlo"
aArray[2,1] = "Cat"
aArray[2,2] = 33
aArray[2,3] = "CC"
aArray[3,0] = "Dagobert"
aArray[3,1] = "Duck"
aArray[3,2] = 44
aArray[3,3] = "DD"
; another testcase
; create 1-Dim test Array with iDim1 Rows
;iDim1 = 4
;aArray = ArrDimension(iDim1)
;
;aArray[0] = "Mickey"
;aArray[1] = "Goofy"
;aArray[2] = "Carlo"
;aArray[3] = "Dagobert"
sMsgTitle = "Demo udfArrAskRow (sTitle, aArray, iSortMode, iSelectMode, iAskMode)"
; test 1.0
sTitle = "Test 1.0, select single Array Row (index)"
sRow = udfArrAskRow (sTitle, aArray, @UNSORTED, @SINGLE, 0)
sMsgText = sRow
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 1.1
sTitle = "Test 1.1, select single Array Row"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @SINGLE, 1)
sMsgText = sRowList
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 2.0
sTitle = "Test 2.0, select multiple Array Row/s (index)"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @MULTIPLE, 0)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 2.1
sTitle = "Test 2.1, select multiple Array Row/s"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @MULTIPLE, 1)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 3.0
sTitle = "Test 3.0, select extended Array Row/s (index)"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @EXTENDED, 0)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 3.1
sTitle = "Test 3.1, select extended Array Row/s"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @EXTENDED, 1)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; You can do the tests with "iSortMode = @SORTED" too.
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
||||
|
||||
udfFileArrayize (sFilename, iBaseMode)
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffilearrayize",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffilearrayize
#DefineFunction udfFileArrayize (sFilename, iBaseMode)
If (sFilename=="") Then Return (ArrDimension(1))
iFilesize = FileSize(sFilename)
If !iFileSize Then Return (ArrDimension(1))
iBaseMode = Min(1,Max(0,iBaseMode))
iFilesize = iFilesize+iBaseMode
hBB = BinaryAlloc(iFilesize)
If iBaseMode Then BinaryPokeStr(hBB,0,@LF) ; Insert a leading empty line.
BinaryReadEx(hBB,iBaseMode,sFilename,0,-1) ; Read the whole file.
BinaryReplace(hBB,@CRLF,@LF,@TRUE) ; Unify EOL.
BinaryReplace(hBB,@CR,@LF,@TRUE) ; Unify EOL.
iBBEod = BinaryEodGet(hBB)
sString = BinaryPeekStr(hBB,0,iBBEod-(@LF==BinaryPeekStr(hBB,iBBEod-1,1))) ; Ommit trailing @LF.
BinaryFree(hBB)
aArray = Arrayize(sString,@LF)
If iBaseMode Then aArray[0] = ArrInfo(aArray,1)-1 ; If one based array, then poke number of file lines into element[0].
Return (aArray)
;------------------------------------------------------------------------------------------------------------------------------------------
; This function "udfFileArrayize" reads a textfile and returns a 1-dim array.
; Each array element contains one line of the given input file, with EndOfLine characters stripped off.
; The iBaseMode parameter controls the creation of a zero based or a one based Array.
; The array contains n elements (zero based) resp. n+1 elements (one based), with n = Number of File lines.
; After returning from this function the number of file lines read can be retrieved
; by 'LineCount = Array[0]' (one based array) or 'LineCount = ArrInfo(Array,1)' (zero based).
;
; If the specified Filename is empty or the FileSize is zero this function
; returns a 1-dim Array with one undefined element (VarType=0), which must be checked by the caller.
;
; sFilename ..... The File to be read into the array.
; iBaseMode=0 ... Creates a zero based array with n elements.
; iBaseMode=1 ... Creates a one based array with n+1 elements.
;
; Detlev Dalitz.20020808
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udffilearrayize
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
MsgTitle = "Demo udfFileArrayize (sFilename, iBaseMode)"
sFilename = IntControl(1004,0,0,0,0) ; We use this script as test input file.
:test1
aFileArray = udfFileArrayize("",0)
If VarType(aFileArray[0]) Then MsgText = "Test1: First element is defined"
Else MsgText = "Test1: First element is not defined"
Message(MsgTitle,MsgText)
:test2
iBaseMode = 0
aFileArray = udfFileArrayize(sFilename,iBaseMode)
iLineCount = ArrInfo(aFileArray,1)
MsgText = StrCat("Test2: Lines read = ",iLineCount)
Message(MsgTitle,MsgText)
:test3
iBaseMode = 1
aFileArray = udfFileArrayize(sFilename,iBaseMode)
LineNo = 22
MsgText = StrCat("Test3: This is Line ",LineNo,@LF,aFileArray[LineNo])
Message(MsgTitle,MsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
||||
|
||||
udfArrMap (sCallback, sArrayList, sArrayListSep)
;------------------------------------------------------------------------------------------------------------------------------------------
; udsArrMap (__sCallback, __sArrayList, __sArrayListSep) ; 2002:08:10:17:22:09
; udsIntSum (iNumber) ; 2002:08:10:17:22:09
; udfStrQuote (sStr, sLeft, sRight) ; 2002:08:10:17:22:09
; udfIsValidArray (aArray) ; 2002:08:10:17:22:09
; udfStrUp (sItem) ; 2002:08:10:17:22:09
; udfCube (iNumber) ; 2002:08:10:17:22:09
; udfStrFind (sItem) ; 2002:08:10:17:22:09
; udfTranslatePortugueseNumber (iNumber, sMale, sFemale) ; 2002:08:10:17:22:09
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udsarrmap",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udsarrmap
#DefineSubRoutine udsArrMap (__sCallback, __sArrayList, __sArrayListSep)
If (__sArrayListSep=="") Then __sArrayListSep = @TAB
__ = ArrDimension(1)
__iParamLow = 1
__iParamHigh = ItemCount(__sArrayList,__sArrayListSep)
; If no items in list then return 1-dim array with one undefined element.
If (__iParamHigh < __iParamLow) Then Return (__)
For __iParam=__iParamLow To __iParamHigh
__aA%__iParam% = ItemExtract(__iParam,__sArrayList,__sArrayListSep)
; If the extracted array name is an empty string, then treat it as an empty array.
If (__aA%__iParam%=="") Then __aA%__iParam% = "__"
__aA = __aA%__iParam%
; If the extracted array name points not to an array then return 1-dim array with one undefined element.
; If there is an array with greater than 1 dimension then return 1-dim array with one undefined element.
If (VarType(%__aA%) <> 256) Then Return (__)
If (ArrInfo(%__aA%,0) > 1) Then Return (__)
Next
If (__sCallback > "")
__aA = __aA%__iParamLow%
__iElementCount = ArrInfo(%__aA%,1)
For __iParam=1+__iParamLow To __iParamHigh
__aA = __aA%__iParam%
__iElementCount = Min(__iElementCount,ArrInfo(%__aA%,1))
Next
Drop(_)
_ = ArrDimension(__iElementCount)
__iNewLow = 0
__iNewHigh = __iElementCount-1
For __iNew=__iNewLow To __iNewHigh
__sParamList = ""
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
If (VarType(%__aA%[__iNew]) == 2 ) ; If IsString, may contain comma, which has to be enclosed in quotes.
__sParamList = ItemInsert(udfStrQuote(%__aA%[__iNew],"",""),-1,__sParamList,",")
Else
__sParamList = ItemInsert(%__aA%[__iNew],-1,__sParamList,",")
EndIf
Next
_[__iNew] = %__sCallback% (%__sParamList%)
Next
Else
__iElementCount = 0
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
__iElement = ArrInfo(%__aA%,1)
__iElementCount = Max(__iElementCount,__iElement)
__i%__aA%High = __iElement-1
Next
Drop(_)
_ = ArrDimension(__iElementCount,__iParamHigh)
__iNewLow = 0
__iNewHigh = __iElementCount-1
For __iNew=__iNewLow To __iNewHigh
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
If (__iNew <= __i%__aA%High)
If VarType(%__aA%[__iNew])
_[__iNew,__iParam-1] = %__aA%[__iNew]
EndIf
EndIf
Next
Next
EndIf
DropWild("__*")
Return (_)
;------------------------------------------------------------------------------------------------------------------------------------------
; Sorry, this code looks so ugly because of the "__" prefixes.
; At this time there is no better way known in WinBatch to get rid of "local" variables defined in a user defined subroutine.
;------------------------------------------------------------------------------------------------------------------------------------------
; This UDS subroutine works in two ways:
; 1. The subroutine "udsArrMap" calls a user defined function or subroutine given by parameter 'sCallback'
; and calls the callback routine with a parameterlist built from defined array elements,
; which are extracted from one ore more arrays given by parameter 'sArrayList'.
;
; The "udsArrMap" subroutine returns a 1-dim array containing the results of the callback routine.
; If "udsArrMap" detects an exception to its inner rules, it will return a 1-dim array with one undefined element,
; which has to be checked by the caller, for example: "If Vartype(aArray)==0 Then ...".
; Note: The callback routine will be called as much as the smallest 1-dim array contains defined elements.
;
; 2. If parameter 'sCallback' is an empty string, then the one or more 1-dim arrays given by parameter 'sArrayList'
; will be combined into a 2-dim array.
; The "udsArrMap" subroutine returns a 2-dim array, that has as much number of rows as the largest 1-dim array given,
; and the number of 'columns' is defined by the given number of items in the arraylist parameter.
; If arraylist contains an 'empty' item, then an empty column with undefined elements will be inserted.
;
; Detlev Dalitz.20020809.20020821
;------------------------------------------------------------------------------------------------------------------------------------------
#EndSubRoutine
:skip_udsarrmap
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If (ItemLocate("udfstrquote",IntControl(77,103,0,0,0),@TAB)>0) Then Goto skip_udfstrquote
;
#DefineFunction udfStrQuote (sStr, sLeft, sRight)
; If (sStr == "") then return (sStr)
If (sLeft == "")
If (sRight == "")
sQuote = """'`"
sClean = StrClean(sStr,sQuote,"",@FALSE,2)
If ("" == StrClean(sQuote,sClean,"",@FALSE,1))
sQuote = '"'
sStr = StrReplace(sStr,sQuote,StrCat(sQuote,sQuote))
Else
sClean = StrClean(sQuote,sClean,"",@FALSE,1)
sQuote = StrSub(sClean,1,1)
EndIf
sLeft = sQuote
sRight = sQuote
EndIf
EndIf
Return (StrCat(sLeft,sStr,sRight))
;------------------------------------------------------------------------------------------------------------------------------------------
; With sLeft="" and sRight=""
; this udf chooses a winbatch quote delimiter automagically
; and doubles the quotation char in sStr if necessary.
;
; With sLeft="""" and sRight=""""
; this udf allows quotation without doubling of quotation char in sStr.
;
; With sLeft="(* " and sRight=" *)"
; this udf encloses sStr in pairs of Pascal comments.
;
; DD.20010722.20020628
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
;
:skip_udfstrquote
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisvalidarray",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisvalidarray
;
#DefineFunction udfIsValidArray (aArray)
If (VarType(aArray)<>256) Then Return (@FALSE) ; Datatype is not an array type.
If (ArrInfo(aArray,6)==1) Then If (VarType(aArray[0])<>256) Then Return (@FALSE) ; Datatype is not an array type.
Return (@TRUE)
;------------------------------------------------------------------------------------------------------------------------------------------
; This Function "udfIsValidArray" returns a boolean value,
; which indicates if the given array is assumable a valid usable array.
;
; Detlev Dalitz.20020809
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
;
:skip_udfisvalidarray
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrUp (sItem)
Return (StrUpper(sItem))
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfCube (iNumber)
If IsNumber(iNumber) Then Return (iNumber*iNumber*iNumber)
Return (iNumber)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrFind (sItem)
iPos = StrIndex(sItem,"o",1,@FWDSCAN)
If iPos Then Return (iPos ) ; Return the first positon found character "o" in sItem.
Return ("not found") ; Return "not found" string.
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineSubRoutine udsIntSum (iNumber)
If IsInt(iNumber) Then iIntSum = iIntSum + iNumber
Return (iIntSum)
#EndSubRoutine
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfTranslatePortugueseNumber (iNumber, sMale, sFemale)
If (sMale==sFemale)
Return (StrCat("In Portuguese the number ",iNumber," is called ",@CRLF,sMale))
Else
Return (StrCat("In Portuguese the number ",iNumber," is called",@CRLF,"male:",@TAB,sMale,@CRLF,"female:",@TAB,sFemale))
EndIf
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
; Create some 1-dim arrays.
aNum = Arrayize("""0"",'1',2,3,4,5",",") ; This array has only six elements to show what happens with shorter arrays.
aNum[3] = 3 ; Make sure, that there is an integer the array.
aNum[4] = 4 ; Make sure, that there is an integer the array.
aNum[5] = 5 ; Make sure, that there is an integer the array.
aNumPortugueseMale = Arrayize("zero,um,dois,três,quatro,cinco,seis,sete,oito,nove",",")
aNumPortugueseFemale = Arrayize("zero,uma,duas,três,quatro,cinco,seis,sete,oito,nove",",")
aNumGerman = Arrayize("null,eins,zwei,drei,vier,fünf,sechs,sieben,acht,neun",",")
aNumEnglish = Arrayize("zero,one,two,three,four,five,six,seven,eight,nine",",")
aNumStart = Arrayize("1,1,1,1",",")
aNumLength = Arrayize("1,2,3,4",",")
:test1
; Callback to the user defined function "udfCube".
aArray = udsArrMap("udfCube","aNum","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test1: Callback udfCube (iNumber)",sString%iRow%)
Next
EndIf
;--------------;
; A Value ;
; 0 0 ;
; 1 1 ;
; 2 8 ;
; 3 27 ;
; 4 64 ;
; 5 125 ;
;--------------;
:test2
; Callback to the user defined function "udfStrUp".
aArray = udsArrMap("udfStrUp","aNumEnglish","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test2: Callback udfStrUp (sItem)",sString%iRow%)
Next
EndIf
;--------------;
; A Value ;
; 0 ZERO ;
; 1 ONE ;
; 2 TWO ;
; 3 THREE ;
; 4 FOUR ;
; 5 FIVE ;
; 6 SIX ;
; 7 SEVEN ;
; 8 EIGHT ;
; 9 NINE ;
;--------------;
:test3
; Callback to the internal function "StrSub".
aArray = udsArrMap("StrSub","aNumEnglish|aNumStart|aNumLength","|")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test3: Callback StrSub (sString, iStart, iLength)",sString%iRow%)
Next
EndIf
;--------------;
; A Value ;
; 0 z ;
; 1 on ;
; 2 two ;
; 3 thre ;
;--------------;
:test4
; Callback to the internal function "StrLen".
aArray = udsArrMap("StrLen","aNumEnglish","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test4: Callback StrLen (sString)",sString%iRow%)
Next
EndIf
;---------------;
; A Value ;
; 0 4 ;
; 1 3 ;
; 2 3 ;
; 3 5 ;
; 4 4 ;
; 5 4 ;
; 6 3 ;
; 7 5 ;
; 8 5 ;
; 9 4 ;
;---------------;
:test5
; Callback to the external function "udfStrFind".
aArray = udsArrMap("udfStrFind","aNumEnglish","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test5: Callback udfStrFind (sItem)",sString%iRow%)
Next
EndIf
;-----------------------;
; A Value ;
; zero 4 ;
; one 1 ;
; two 3 ;
; three not found ;
; four 2 ;
; five not found ;
; six not found ;
; seven not found ;
; eight not found ;
; nine not found ;
;-----------------------;
:test6
; Callback to the external subroutine "udsIntSum".
iIntSum = 0
aArray = udsArrMap("udsIntSum","aNum","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test6: Callback udsIntSum (iNumber)",sString%iRow%)
Next
EndIf
Pause("Test6: Callback udsIntSum (iNumber)",StrCat("iIntSum = ",iIntSum))
;---------------;
; A Value ;
; "0" 0 ; "0" is a string, not an integer!
; '1' 0 ; '1' is a string, not an integer!
; 2 2 ;
; 3 5 ;
; 4 9 ;
; 5 14 ;
;---------------;
; iIntSum = 14 ; !!!
;---------------;
:test7
; Callback to the external function "udfTranslatePortugueseNumber".
aArray = udsArrMap("udfTranslatePortugueseNumber","aNum,aNumPortugueseMale,aNumPortugueseFemale",",")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test7: Callback udfTranslatePortugueseNumber (iNumber, sMale, sFemale)",sString%iRow%)
Next
EndIf
;----------------------------------------------;
; A Value ;
; 0 In Portuguese the number 0 is called ;
; zero ;
; 1 In Portuguese the number 1 is called ;
; male: um ;
; female: uma ;
; 2 In Portuguese the number 2 is called ;
; male: dois ;
; female: duas ;
; 3 In Portuguese the number 3 is called ;
; três ;
; 4 In Portuguese the number 4 is called ;
; quatro ;
; 5 In Portuguese the number 5 is called ;
; cinco ;
;----------------------------------------------;
:test8
; Map a single 1-dim array to one 2-dim array.
; Although only one 1-dim array is given, a 2-dim array will be created.
aArray = udsArrMap("","aNum",",")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
iColLow = 0
iColHigh = ArrInfo(aArray,2)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = ""
For iCol=iColLow To iColHigh
If VarType(aArray[iRow,iCol])
sString%iRow% = ItemInsert(aArray[iRow,iCol],-1,sString%iRow%,@TAB)
Else
sString%iRow% = ItemInsert("*N/A*",-1,sString%iRow%,@TAB)
EndIf
Next
Pause("Test8: Create 2-dim Array from a single 1-dim Array",sString%iRow%)
Next
EndIf
;-------------;
; A B=0 ;
; 0 0 ;
; 1 1 ;
; 2 2 ;
; 3 3 ;
; 4 4 ;
; 5 5 ;
;-------------;
:test9
; Map multiple 1-dim arrays to one 2-dim array.
aArray = udsArrMap("","aNum,aNumPortugueseMale,aNumPortugueseFemale,aNumEnglish,aNumGerman",",")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
iColLow = 0
iColHigh = ArrInfo(aArray,2)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = ""
For iCol=iColLow To iColHigh
If VarType(aArray[iRow,iCol])
sString%iRow% = ItemInsert(aArray[iRow,iCol],-1,sString%iRow%,@TAB)
Else
sString%iRow% = ItemInsert("*N/A*",-1,sString%iRow%,@TAB)
EndIf
Next
Pause("Test9: Create 2-dim Array from multiple 1-dim Arrays",sString%iRow%)
Next
EndIf
;-------------------------------------------------;
; A B=0 B=1 B=2 B=3 B=4 ;
; 0 0 zero zero zero null ;
; 1 1 um uma one eins ;
; 2 2 dois duas two zwei ;
; 3 3 três três three drei ;
; 4 4 quatro quatro four vier ;
; 5 5 cinco cinco five fünf ;
; 6 --- seis seis six sechs ;
; 7 --- sete sete seven sieben ;
; 8 --- oito oito eigth acht ;
; 9 --- nove nove nine neun ;
;-------------------------------------------------;
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
||||
|
||||
udfArrUnique (aArray)
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrunique",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrunique
#DefineFunction udfArrUnique (aArray, iSortMode, iSortDirection)
If (VarType(aArray)<>256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,6)==0) Then Return (aArray) ; No elements.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
sDelimiter = Num2Char(7) ; Assuming that the 'bell' control character ASCII-7 does not occur in array data !!!
sItemList = ""
iListLow = 1
iListHigh = ArrInfo(aArray,1)
iArrLow = 0
iArrHigh = iListHigh-1
For i=iArrLow To iArrHigh
If VarType(aArray[i])
sItemList = ItemInsert(aArray[i],-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert("",-1,sItemList,sDelimiter)
EndIf
Next
sUniqueList = ""
For i=iListLow To iListHigh
sItem = ItemExtract(i,sItemList,sDelimiter)
If (sItem>"") Then If !ItemLocate(sItem,sUniqueList,sDelimiter) Then sUniqueList = ItemInsert(sItem,-1,sUniqueList,sDelimiter)
Next
iListHigh = ItemCount(sUniqueList,sDelimiter)
Select iSortMode
Case @UNSORTED
Break
Case @SORTED
Select iSortDirection
Case @ASCENDING
sUniqueList = ItemSort(sUniqueList,sDelimiter)
Break
Case @DESCENDING
sUniqueList = ItemSort(sUniqueList,sDelimiter)
For i=iListHigh To iListLow By -1
sUniqueList = ItemRemove(i,ItemInsert(ItemExtract(i,sUniqueList,sDelimiter),-1,sUniqueList,sDelimiter),sDelimiter)
Next
Break
EndSelect
Break
EndSelect
Return (Arrayize(sUniqueList,sDelimiter))
;------------------------------------------------------------------------------------------------------------------------------------------
; This function "udfArrUnique" removes double entries from input 1-dim array and returns the new 1-dim array as result.
; If the input array parameter does not fit to process, then the function returns the input parameter.
;
; iSortMode = @UNSORTED .......... Returns the unique array as is.
; iSortMode = @SORTED ............ Returns the unique array sorted.
; iSortDirection = @ASCENDING .... Performs an alphabetic ascending sort.
; iSortDirection = @DESCENDING ... Performs an alphabetic descending sort.
;
; Note:
; The function uses the 'bell' control character ASCII-7 to build a temporary itemlist.
; Therefore make sure, that your array elements do not contain an ASCII-7 character,
; or define some other 'strange' ASCII character as delimiter.
;
; Detlev Dalitz.200200820
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarrunique
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sMsgTitle = "Demo udfArrUnique (aArray)"
sMsgText = ""
aArray = Arrayize("zero,,one,two,zero,,,three,four,,,five,zero,six,one,seven,eigth,nine,one",",")
sMsgText = StrCat(sMsgText,"--- aArray ---------",@LF)
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sMsgText = StrCat(sMsgText,aArray[iRow],@LF)
Next
sMsgText = StrCat(sMsgText,"--------------------",@LF)
aArrayUnique = udfArrUnique(aArray,@UNSORTED,0)
sMsgText = StrCat(sMsgText,"--- aArrayUnique --- unsorted ---",@LF)
iRowLow = 0
iRowHigh = ArrInfo(aArrayUnique,1)-1
For iRow=iRowLow To iRowHigh
sMsgText = StrCat(sMsgText,aArrayUnique[iRow],@LF)
Next
sMsgText = StrCat(sMsgText,"--------------------",@LF)
IntControl(28,1,0,0,0)
IntControl(63,200,100,800,900)
AskItemlist(sMsgTitle,sMsgText,@LF,@UNSORTED,@SINGLE)
aArrayUnique = udfArrUnique(aArray,@SORTED,@DESCENDING)
sMsgText = StrCat(sMsgText,"--- aArrayUnique --- sorted descending ---",@LF)
iRowLow = 0
iRowHigh = ArrInfo(aArrayUnique,1)-1
For iRow=iRowLow To iRowHigh
sMsgText = StrCat(sMsgText,aArrayUnique[iRow],@LF)
Next
sMsgText = StrCat(sMsgText,"--------------------",@LF)
IntControl(28,1,0,0,0)
IntControl(63,200,100,800,900)
AskItemlist(sMsgTitle,sMsgText,@LF,@UNSORTED,@SINGLE)
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
||||
|
||||
udfArrItemLocate (aArray, Item)
|
||||
|
||||
How to build a report with grouped sums per item using array functions.
;==========================================================================================================================================
;
; How to build a report with grouped sums per item using array functions.
;
;==========================================================================================================================================
;
; Following example demonstrates how to build a condensed list of "sums per item"
; by using some specific WinBatch User Defined Functions.
;
; The example uses the WinBatch array features.
; Because arrays resides entirely in the PC's memory,
; the amount of source data should be rational low.
;
; The example uses following "User Defined Functions" resp. "User Defined SubRoutines":
;
; udfFileArrayize (sFilename, iBaseMode)
; udfArrItemLocate (aArray, Item)
; udfArrUnique (aArray, iSortMode, iSortDirection)
; udsArrMap (__sCallback, __sArrayList, __sArrayListSep)
; udfStrQuote (sStr, sLeft, sRight)
;
; The example uses the "udfArrMap" subroutine extensively,
; which uses the following Callback routines,
; which are "User Defined Functions" resp. "User Defined SubRoutines" too:
;
; cbExtractUser (sRow)
; cbExtractValue (sRow)
; cbSumPerUser (sUser, iValue)
; cbBuildSumList (sUser, iValue)
; cbFileWriteSum (sUser, iValue)
;
;------------------------------------------------------------------------------------------------------------------------------------------;
; Detlev Dalitz.20020822
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisvalidarray",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisvalidarray
;
#DefineFunction udfIsValidArray (aArray)
If (VarType(aArray)<>256) Then Return (@FALSE) ; Datatype is not an array type.
If (ArrInfo(aArray,6)==1) Then If (VarType(aArray[0])<>256) Then Return (@FALSE) ; Datatype is not an array type.
Return (@TRUE)
;------------------------------------------------------------------------------------------------------------------------------------------
; This Function "udfIsValidArray" returns a boolean value,
; which indicates if the given array is assumable a valid usable array.
;
; Detlev Dalitz.20020809
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
;
:skip_udfisvalidarray
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemlocate",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemlocate
#DefineFunction udfArrItemLocate (aArray, Item)
If (VarType(aArray)<>256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,6)==0) Then Return (aArray) ; No elements.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
iTop = Max(0,ArrInfo(aArray,1)-1)
iBot = 0
While ((iTop>=iBot))
iMid = (iBot+iTop)/2
If (Item==aArray[iMid]) Then Return (iMid)
If (Item<aArray[iMid]) Then iTop = iMid-1
Else iBot = iMid+1
EndWhile
Return (-1)
;..........................................................................................................................................
; This function "udfArrItemLocate" uses the binary search algorithm
; to locate a given item in a given ascending sorted array.
; The function returns the index number of the found element,
; or returns -1 if the item was not found.
;
; The algorithm needs an ascending sorted array.
;
; Detlev Dalitz.20020821
;..........................................................................................................................................
#EndFunction
:skip_udfarritemlocate
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If (ItemLocate("udfstrquote",IntControl(77,103,0,0,0),@TAB)>0) Then Goto skip_udfstrquote
#DefineFunction udfStrQuote (sStr, sLeft, sRight)
; If (sStr == "") then return (sStr)
If (sLeft == "")
If (sRight == "")
sQuote = """'`"
sClean = StrClean(sStr,sQuote,"",@FALSE,2)
If ("" == StrClean(sQuote,sClean,"",@FALSE,1))
sQuote = '"'
sStr = StrReplace(sStr,sQuote,StrCat(sQuote,sQuote))
Else
sClean = StrClean(sQuote,sClean,"",@FALSE,1)
sQuote = StrSub(sClean,1,1)
EndIf
sLeft = sQuote
sRight = sQuote
EndIf
EndIf
Return (StrCat(sLeft,sStr,sRight))
;------------------------------------------------------------------------------------------------------------------------------------------
; With sLeft="" and sRight=""
; this udf chooses a winbatch quote delimiter automagically
; and doubles the quotation char in sStr if necessary.
;
; With sLeft="""" and sRight=""""
; this udf allows quotation without doubling of quotation char in sStr.
;
; With sLeft="(* " and sRight=" *)"
; this udf encloses sStr in pairs of Pascal comments.
;
; DD.20010722.20020628
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfstrquote
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udsarrmap",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udsarrmap
#DefineSubRoutine udsArrMap (__sCallback, __sArrayList, __sArrayListSep)
If (__sArrayListSep=="") Then __sArrayListSep = @TAB
__ = ArrDimension(1)
__iParamLow = 1
__iParamHigh = ItemCount(__sArrayList,__sArrayListSep)
; If no items in list then return 1-dim array with one undefined element.
If (__iParamHigh < __iParamLow) Then Return (__)
For __iParam=__iParamLow To __iParamHigh
__aA%__iParam% = ItemExtract(__iParam,__sArrayList,__sArrayListSep)
; If the extracted array name is an empty string, then treat it as an empty array.
If (__aA%__iParam%=="") Then __aA%__iParam% = "__"
__aA = __aA%__iParam%
; If the extracted array name points not to an array then return 1-dim array with one undefined element.
; If there is an array with greater than 1 dimension then return 1-dim array with one undefined element.
If (VarType(%__aA%) <> 256) Then Return (__)
If (ArrInfo(%__aA%,0) > 1) Then Return (__)
Next
If (__sCallback > "")
__aA = __aA%__iParamLow%
__iElementCount = ArrInfo(%__aA%,1)
For __iParam=1+__iParamLow To __iParamHigh
__aA = __aA%__iParam%
__iElementCount = Min(__iElementCount,ArrInfo(%__aA%,1))
Next
Drop(_)
_ = ArrDimension(__iElementCount)
__iNewLow = 0
__iNewHigh = __iElementCount-1
For __iNew=__iNewLow To __iNewHigh
__sParamList = ""
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
If (VarType(%__aA%[__iNew]) == 2 ) ; If IsString, may contain comma, which has to be enclosed in quotes.
__sParamList = ItemInsert(udfStrQuote(%__aA%[__iNew],"",""),-1,__sParamList,",")
Else
__sParamList = ItemInsert(%__aA%[__iNew],-1,__sParamList,",")
EndIf
Next
_[__iNew] = %__sCallback% (%__sParamList%)
Next
Else
__iElementCount = 0
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
__iElement = ArrInfo(%__aA%,1)
__iElementCount = Max(__iElementCount,__iElement)
__i%__aA%High = __iElement-1
Next
Drop(_)
_ = ArrDimension(__iElementCount,__iParamHigh)
__iNewLow = 0
__iNewHigh = __iElementCount-1
For __iNew=__iNewLow To __iNewHigh
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
If (__iNew <= __i%__aA%High)
If VarType(%__aA%[__iNew])
_[__iNew,__iParam-1] = %__aA%[__iNew]
EndIf
EndIf
Next
Next
EndIf
DropWild("__*")
Return (_)
;------------------------------------------------------------------------------------------------------------------------------------------
; Sorry, this code looks so ugly because of the "__" prefixes.
; At this time there is no better way known in WinBatch to get rid of "local" variables defined in a user defined subroutine.
;------------------------------------------------------------------------------------------------------------------------------------------
; This UDS subroutine works in two ways:
; 1. The subroutine "udsArrMap" calls a user defined function or subroutine given by parameter 'sCallback'
; and calls the callback routine with a parameterlist built from defined array elements,
; which are extracted from one ore more arrays given by parameter 'sArrayList'.
;
; The "udsArrMap" subroutine returns a 1-dim array containing the results of the callback routine.
; If "udsArrMap" detects an exception to its inner rules, it will return a 1-dim array with one undefined element,
; which has to be checked by the caller, for example: "If Vartype(aArray)==0 Then ...".
; Note: The callback routine will be called as much as the smallest 1-dim array contains defined elements.
;
; 2. If parameter 'sCallback' is an empty string, then the one or more 1-dim arrays given by parameter 'sArrayList'
; will be combined into a 2-dim array.
; The "udsArrMap" subroutine returns a 2-dim array, that has as much number of rows as the largest 1-dim array given,
; and the number of 'columns' is defined by the given number of items in the arraylist parameter.
; If arraylist contains an 'empty' item, then an empty column with undefined elements will be inserted.
;
; Detlev Dalitz.20020809.20020821
;------------------------------------------------------------------------------------------------------------------------------------------
#EndSubRoutine
:skip_udsarrmap
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffilearrayize",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffilearrayize
#DefineFunction udfFileArrayize (sFilename, iBaseMode)
If (sFilename=="") Then Return (ArrDimension(1))
iFilesize = FileSize(sFilename)
If !iFileSize Then Return (ArrDimension(1))
iBaseMode = Min(1,Max(0,iBaseMode))
iFilesize = iFilesize+iBaseMode
hBB = BinaryAlloc(iFilesize)
If iBaseMode Then BinaryPokeStr(hBB,0,@CR) ; Insert a leading empty line.
BinaryReadEx(hBB,iBaseMode,sFilename,0,-1) ; Read the whole file.
BinaryReplace(hBB,@CRLF,@CR,@TRUE) ; Unify EOL.
BinaryReplace(hBB,@LF,@CR,@TRUE) ; Unify EOL.
iBBEod = BinaryEodGet(hBB)
sString = BinaryPeekStr(hBB,0,iBBEod-(@CR==BinaryPeekStr(hBB,iBBEod-1,1))) ; Ommit trailing @CR.
BinaryFree(hBB)
aArray = Arrayize(sString,@CR)
If iBaseMode Then aArray[0] = ArrInfo(aArray,1)-1 ; If one based array, then poke number of file lines into element[0].
Return (aArray)
;------------------------------------------------------------------------------------------------------------------------------------------
; This function "udfFileArrayize" reads a textfile and returns a 1-dim array.
; Each array element contains one line of the given input file, with EndOfLine characters stripped off.
; The iBaseMode parameter controls the creation of a zero based or a one based Array.
; The array contains n elements (zero based) resp. n+1 elements (one based), with n = Number of File lines.
; After returning from this function the number of file lines read can be retrieved
; by 'LineCount = Array[0]' (one based array) or 'LineCount = ArrInfo(Array,1)' (zero based).
;
; If the specified Filename is empty or the FileSize is zero this function
; returns a 1-dim Array with one undefined element (VarType=0), which has to checked by the caller.
;
; sFilename ..... The File to be read into the array.
; iBaseMode=0 ... Creates a zero based array with n elements.
; iBaseMode=1 ... Creates a one based array with n+1 elements.
;
; Detlev Dalitz.20020808
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udffilearrayize
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrunique",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarrunique
#DefineFunction udfArrUnique (aArray, iSortMode, iSortDirection)
If (VarType(aArray)<>256) Then Return (aArray) ; No array.
If (ArrInfo(aArray,6)==0) Then Return (aArray) ; No elements.
If (ArrInfo(aArray,0)>1) Then Return (aArray) ; Too much dimensions.
sDelimiter = Num2Char(7) ; Assuming that the 'bell' control character ASCII-7 does not occur in array data !!!
sItemList = ""
iHigh = Max(ArrInfo(aArray,1)-1,0)
For i=0 To iHigh
If VarType(aArray[i])
sItemList = ItemInsert(aArray[i],-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert("",-1,sItemList,sDelimiter)
EndIf
Next
sUniqueList = ""
For i=1 To iHigh
sItem = ItemExtract(i,sItemList,sDelimiter)
If (sItem>"") Then If !ItemLocate(sItem,sUniqueList,sDelimiter) Then sUniqueList = ItemInsert(sItem,-1,sUniqueList,sDelimiter)
Next
iHigh = ItemCount(sUniqueList,sDelimiter)
Select iSortMode
Case @UNSORTED
Break
Case @SORTED
Select iSortDirection
Case @ASCENDING
sUniqueList = ItemSort(sUniqueList,sDelimiter)
Break
Case @DESCENDING
sUniqueList = ItemSort(sUniqueList,sDelimiter)
For i=iHigh To 1 By -1
sUniqueList = ItemRemove(i,ItemInsert(ItemExtract(i,sUniqueList,sDelimiter),-1,sUniqueList,sDelimiter),sDelimiter)
Next
Break
EndSelect
Break
EndSelect
Return (Arrayize(sUniqueList,sDelimiter))
;------------------------------------------------------------------------------------------------------------------------------------------
; This function "udfArrUnique" removes double entries from input 1-dim array and returns the new 1-dim array as result.
; If the input array parameter does not fit to process, then the function returns the input parameter.
;
; iSortMode = @ASCENDING .... Returns an alphabetic ascending sorted unique array.
; iSortMode = @DESCENDING ... Returns an alphabetic descending sorted unique array.
; iSortMode = @UNSORTED ..... Returns the unique array as is.
;
; Note:
; The function uses the 'bell' control character ASCII-7 to build an intermediate itemlist.
; Therefore make sure, that your array elements do not contain an ASCII-7 character,
; or define some other 'strange' ASCII character as delimiter.
;
; Detlev Dalitz.200200820
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarrunique
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
; The Callback Routines
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction cbExtractUser (sRow)
Return (ItemExtract(1,sRow,","))
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction cbExtractValue (sRow)
Return (0+StrCat("0",ItemExtract(2,sRow,",")))
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineSubRoutine cbSumPerUser (sUser, iValue)
i = udfArrItemLocate(aUserUnique,sUser)
If (i>=0) Then aUserSum[i] = aUserSum[i] + iValue
#EndSubRoutine
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineSubRoutine cbBuildSumList (sUser, iValue)
sSumList = ItemInsert(StrCat(sUser,",",iValue),-1,sSumList,@LF)
#EndSubRoutine
; -----------------------------------------------------------------------------------------------------------------------------------------
#DefineSubRoutine cbFileWriteSum (sUser, iValue)
FileWrite(hFW,StrCat(sUser,",",iValue))
#EndSubRoutine
; -----------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
; --- test ---
; We have a comma delimited file that contains information about different users,
; such as how many minutes they have been online, etc..
; What we want to do is a groupby and add up all the users online minutes.
sFilenameIn = "d:\temp\stuff.txt"
; user3,14,....more stuff
; user1,30,....more stuff
; user2,10,....more stuff
; user3,17,....more stuff
; user1,25,....more stuff
; Should become ...
sFilenameOut = "d:\temp\stuff.sum.txt"
; user1,55
; user2,10
; user3,31
; Get the complete file into an array.
aFileArray = udfFileArrayize (sFilenameIn,0)
Terminate(!udfIsValidArray(aFileArray),"Demo aborted.",StrCat("Error while loading file into array:",@LF,sFilenameIn))
; Extract the columns we need.
aUser = udsArrMap ("cbExtractUser","aFileArray","")
aValue = udsArrMap ("cbExtractValue","aFileArray","")
Drop(_,aFileArray)
; Make the group elements unique, and sort alphabetic.
aUserUnique = udfArrUnique (aUser,@SORTED,@ASCENDING)
iUserUniqueLow = 0
iUserUniqueHigh = Max(0,ArrInfo(aUserUnique,1)-1)
; Create an empty array for holding user specific sums.
aUserSum = ArrDimension(ArrInfo(aUserUnique,1))
ArrInitialize(aUserSum,0)
; Do the calculation.
udsArrMap ("cbSumPerUser","aUser,aValue",",")
Drop(_,aUser,aValue)
; Write the result out to diskfile.
hFW = FileOpen(sFilenameOut,"WRITE")
udsArrMap ("cbFileWriteSum","aUserUnique,aUserSum",",")
Drop(_)
FileClose(hFW)
; Ready.
; Just for the demo ...
sSumList = ""
udsArrMap ("cbBuildSumList","aUserUnique,aUserSum",",")
Drop(_)
Drop(aUserUnique,aUserSum)
sMsgTitle = "Demo Grouped Summing with udfArrMap"
sMsgText = sSumList
IntControl(28,1,0,0,0)
IntControl(63,200,100,800,600)
AskItemlist(sMsgTitle,sMsgText,@LF,@UNSORTED,@SINGLE)
Exit
;==========================================================================================================================================
;*EOF*
|
||||
|
||||
How to sort a multi-dimensional array
;==========================================================================================================================================
; How to sort a 2-dim array (c)20040326.Detlev Dalitz
;==========================================================================================================================================
;
; May also be usable for multi-dimensional arrays.
;
; Example array:
;
; Data Array
; +-------+-------------+------------+---------+
; | Array | Col 0 | Col 1 | Col 2 |
; | Index | (Firstname) | (Lastname) | (Age) |
; +-------+-------------+------------+---------+
; | 0 | Micky | Mouse | 33 |
; | 1 | Daisy | Duck | 17 |
; | 2 | Carlo | Cat | 22 |
; | 3 | Lupo | Dog | 11 |
; | 4 | Dagobert | Duck | 66 |
; +-------+-------------+------------+---------+
;
; This array has 5 rows and 3 columns, overall 15 elements.
;
; We want to sort it on each column separately (Firstname, Lastname, Age)
; and on a combination of two columns (Lastname+Firstname).
;
; WinBatch has _no_ built in support for sorting arrays.
; But there exist several attempts by the WinBatch community to do so.
; Indeed, those approaches in WinBatch native script code are focused on
; one-dimensional arrays.
;
; Today there are known two WinBatch extenders, built by Alan Kreutzer and Detlev Dalitz,
; supporting array functions, which can work with multi-dimensional arrays and can sort them.
;
; Here I want to describe a practical way to sort a 2-dim array using WinBatch native script code.
;
;
; To sort a multi-dim array we need a helper array.
; This helper array, better say pointer array, does not need to have more than one column.
; This one column is initialized with integer numbers representing the corresponding row index numbers.
; The number of rows in the pointer array is the same as in the multi-dim data array.
; Each cell in the pointer array points to the corresponding row in the data array.
;
; Pointer Array Data Array
; +-------+-----------+ +-------+-------------+------------+---------+
; | Array | Col 0 | | Array | Col 0 | Col 1 | Col 2 |
; | Index | (DataRow) | | Index | (Firstname) | (Lastname) | (Age) |
; +-------+-----------+ +-------+-------------+------------+---------+
; | 0 | 0 | ==> | 0 | Micky | Mouse | 33 |
; | 1 | 1 | ==> | 1 | Daisy | Duck | 17 |
; | 2 | 2 | ==> | 2 | Carlo | Cat | 22 |
; | 3 | 3 | ==> | 3 | Lupo | Dog | 11 |
; | 4 | 4 | ==> | 4 | Dagobert | Duck | 66 |
; +-------+-----------+ +-------+-------------+------------+---------+
;
;
; To sort the column 'Lastname' we have to create a relation between two elements
; that become true for all elements when the data array has been sorted.
;
; In other words, for ascending sorting we use the relation:
; 'second element must be greater than first element' or 'Array[i+1] > Array[i]'.
;
; Same situation from another point of view:
; 'We have to swap elements if the first element is greater than the second element'.
; This is the sort relation we use in the array sort routine, code looks like:
; 'If (aData[aPointer[ii],iSortCol] > aData[aPointer[ik],iSortCol]) Then swap(...)'.
;
; So we only have to compare elements from the column 'Lastname' and have to re-order
; the 'DataRow' elements in the pointer array accordingly.
;
;
; Pointer Array Data Array
; +-------+-----------+ +-------+-------------+------------+---------+
; | Array | Col 0 | | Array | Col 0 | Col 1 | Col 2 |
; | Index | (DataRow) | | Index | (Firstname) | (Lastname) | (Age) |
; +-------+-----------+ +-------+-------------+------------+---------+
; | 0 | 2 | ===\ | 0 | Micky | Mouse | 33 |
; | 1 | 3 | \ | 1 | Daisy | Duck | 17 |
; | 2 | 1 | \==> | 2 | Carlo | Cat | 22 |
; | 3 | 4 | ===\ | 3 | Lupo | Dog | 11 |
; | 4 | 0 | \===> | 4 | Dagobert | Duck | 66 |
; +-------+-----------+ +-------+-------------+------------+---------+
;
; Now, after an ascending sort on Col 2 'Lastname', the elements of Pointer Array point
; to the rows from Data Array.
;
;
; In general we have access to the value of an array cell by directly addressing the
; cell using integer numbers referencing the row and column where the cell is located.
; This direct addressing method of array cells is common known standard.
; Example:
; The cell in Row 2 Column 0 has the value 'Carlo'.
; x = Data[2,0] ; ==> x = 'Carlo'
;
;
; For our purposes we have to implement an indirect addressing method
; by using the pointer array as an interface to the multi-dim array.
;
; In the first unsorted situation the above example looks like:
; x = Data[Pointer[2],0] ; ==> x = 'Carlo'
; will be calculated as:
; x = Data[2,0] ; ==> x = 'Carlo'
; Because array cell Pointer[2] has the value '2', it addresses row 2 in data array.
;
; After sorting the data array by Column 1 (Lastname) the pointer array cell Pointer[2]
; has got the value '1'.
; x = Data[Pointer[2],0] ; ==> x = 'Daisy'
; will be calculated as:
; x = Data[1,0] ; ==> x = 'Daisy'
; Because array cell Pointer[2] has the value '1', it addresses row 1 in data array.
;
;
; Following example code uses the Shell-Metzner sort algorithm,
; because it is easy to read and easy to understand.
; This sorting algorithm is efficient for sorting small and medium sized arrays (100..1000 elements).
;Goto Script1
Goto Script2
:Script1
;==========================================================================================================================================
; How to sort a 2-dim array (c)20040326.Detlev Dalitz
;==========================================================================================================================================
; Define arrays.
iMaxRows = 5
iMaxCols = 3
aData = ArrDimension(iMaxRows,iMaxCols)
aPointer = ArrDimension(iMaxRows)
;..........................................................................................................................................
; Populate array aData.
aData[0,0] = "Micky"
aData[0,1] = "Mouse"
aData[0,2] = 33
aData[1,0] = "Dagobert"
aData[1,1] = "Duck"
aData[1,2] = 66
aData[2,0] = "Carlo"
aData[2,1] = "Cat"
aData[2,2] = 22
aData[3,0] = "Lupo"
aData[3,1] = "Dog"
aData[3,2] = 11
aData[4,0] = "Daisy"
aData[4,1] = "Duck"
aData[4,2] = 17
;..........................................................................................................................................
; Hint: See moving the location of 'Dagobert Duck'.
;..........................................................................................................................................
; Display array unsorted.
sMsgText = "Array not sorted"
GoSub PointerInit
GoSub ArrayDisplay
;..........................................................................................................................................
; Do the sort on Column1 (Lastname).
sMsgText = "Array sorted on Column1 (Lastname)"
iSortCol = 1
sSortRelation = `aData[aPointer[ii],iSortCol] > aData[aPointer[ik],iSortCol]`
GoSub PointerInit
GoSub ArraySort
GoSub ArrayDisplay
;..........................................................................................................................................
; Do the sort on Column2 (Age).
sMsgText = "Array sorted on Column2 (Age)"
iSortCol = 2
sSortRelation = `aData[aPointer[ii],iSortCol] > aData[aPointer[ik],iSortCol]`
GoSub PointerInit
GoSub ArraySort
GoSub ArrayDisplay
;..........................................................................................................................................
; Do the sort on Column1 + Column0 (Lastname + Firstname).
sMsgText = "Array sorted on Column1 + Column0 (Lastname + Firstname)"
sSortRelation = `StrCat(aData[aPointer[ii],1],aData[aPointer[ii],0]) > StrCat(aData[aPointer[ik],1],aData[aPointer[ik],0])`
GoSub PointerInit
GoSub ArraySort
GoSub ArrayDisplay
;..........................................................................................................................................
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
:PointerInit
; Populate array aPointer.
iHigh = ArrInfo(aPointer,1)-1
For ii=0 To iHigh
aPointer[ii] = ii
Next
Drop(iHigh,ii)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
:ArraySort
; Sort.
iHigh = ArrInfo(aData,1)-1
iLow = 0
iMid = (iHigh-iLow+1)/2
While iMid
iTop = iHigh-iMid
For ii=iLow To iTop
ik = ii + iMid
If %sSortRelation%
aP = aPointer[ii]
aPointer[ii] = aPointer[ik]
aPointer[ik] = aP
EndIf
Next
For ii=iTop To iLow By -1
ik = ii + iMid
If %sSortRelation%
aP = aPointer[ii]
aPointer[ii] = aPointer[ik]
aPointer[ik] = aP
EndIf
Next
iMid = iMid/2
EndWhile
Drop(aP,iHigh,ii,ik,iLow,iMid,iTop)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
:ArrayDisplay
; Read aData sorted by aPointer.
iiHigh = ArrInfo(aData,1)-1
ikHigh = ArrInfo(aData,2)-1
sTable = ""
For ii=0 To iiHigh
sRow = ""
For ik=0 To ikHigh
sRow = ItemInsert(aData[aPointer[ii],ik],-1,sRow,@TAB)
Next
sTable = ItemInsert(sRow,-1,sTable,@LF)
Next
AskItemlist(sMsgText,sTable,@LF,@UNSORTED,@SINGLE)
Drop(ii,iiHigh,ik,ikHigh,sRow,sTable)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:Script2
;==========================================================================================================================================
; It is also possible to encapsulate the sort code into a WinBatch UDF User Defined Function,
; and pass the data array and the sort directives by parameters into the function.
;
; If the array has to be sorted only by one column, the UDF parameter interface can be rather simple:
; '#DefineFunction udfArraySort (aData, iSortCol)'
; All other coding can be done hidden in the inner UDF.
;
; The UDF returns the sorted pointer array, for further access to the data array.
; In case the data array has no elements the UDF returns an empty pointer array.
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfArraySort (aData, iSortCol)
iDim1 = ArrInfo(aData,1)
If !iDim1 Then Return (ArrDimension(0))
; Populate array aPointer.
aPointer = ArrDimension(iDim1)
iHigh = ArrInfo(aPointer,1)-1
For ii=0 To iHigh
aPointer[ii] = ii
Next
Drop(iHigh,ii)
; Do the sort.
iHigh = iDim1-1
iLow = 0
iMid = (iHigh-iLow+1)/2
While iMid
iTop = iHigh-iMid
For ii=iLow To iTop
ik = ii + iMid
If aData[aPointer[ii],iSortCol] > aData[aPointer[ik],iSortCol]
aP = aPointer[ii]
aPointer[ii] = aPointer[ik]
aPointer[ik] = aP
EndIf
Next
For ii=iTop To iLow By -1
ik = ii + iMid
If aData[aPointer[ii],iSortCol] > aData[aPointer[ik],iSortCol]
aP = aPointer[ii]
aPointer[ii] = aPointer[ik]
aPointer[ik] = aP
EndIf
Next
iMid = iMid/2
EndWhile
Drop(aP,iHigh,ii,ik,iLow,iMid,iTop)
Return (aPointer)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfArrayDisplay (iULx, iULy, iLRx, iLRy, sMsgText, aData, aPointer)
; Read aData sorted by aPointer.
sTable = "[no displayable data]"
iDims = ArrInfo(aData,0)
iDim1 = ArrInfo(aData,1)
If ((iDims==2)&&(iDim1>0))
iiHigh = iDim1-1
ikHigh = ArrInfo(aData,2)-1
sTable = ""
For ii=0 To iiHigh
sRow = ""
For ik=0 To ikHigh
sRow = ItemInsert(aData[aPointer[ii],ik],-1,sRow,@TAB)
Next
sTable = ItemInsert(sRow,-1,sTable,@LF)
Next
EndIf
IntControl(63,iULx,iULy,iLRx,iLRy) ; Sets coordinates for AskFileText, AskItemList and AskTextBox windows.
iLastIC28 = IntControl(28,0,0,0,0) ; Selects system font used in list boxes. p1=1=fixed pitch font. p1=0=proportional font (default)
AskItemlist(sMsgText,sTable,@LF,@UNSORTED,@SINGLE)
IntControl(28,iLastIC28,0,0,0)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
; Define array.
iMaxRows = 5
iMaxCols = 3
aData = ArrDimension(iMaxRows,iMaxCols)
;..........................................................................................................................................
; Populate array aData.
aData[0,0] = "Micky"
aData[0,1] = "Mouse"
aData[0,2] = 33
aData[1,0] = "Dagobert"
aData[1,1] = "Duck"
aData[1,2] = 66
aData[2,0] = "Carlo"
aData[2,1] = "Cat"
aData[2,2] = 22
aData[3,0] = "Lupo"
aData[3,1] = "Dog"
aData[3,2] = 11
aData[4,0] = "Daisy"
aData[4,1] = "Duck"
aData[4,2] = 17
;..........................................................................................................................................
; Call the sort UDF.
iSortCol = 0
aPointer0 = udfArraySort(aData,iSortCol)
iSortCol = 2
aPointer2 = udfArraySort(aData,iSortCol)
;..........................................................................................................................................
; Display data array by sorted pointer array.
udfArrayDisplay(200,200,600,600,"Array sorted on Column2 (Age)",aData,aPointer2)
udfArrayDisplay(400,200,800,500,"Array sorted on Column0 (Firstname)",aData,aPointer0)
;..........................................................................................................................................
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
;*EOF*
|
||||
|
||||
udfArrayizeEx (sString, sColDelim, sRowDelim, iMode)
#DefineFunction udfArrayizeEx (sString, sColDelim, sRowDelim, iMode)
If (sString=="") Then Return (ArrDimension(1,1)) ; Return dim-2 array with undefined element.
If (sRowDelim=="") Then Return (ArrDimension(1,1)) ; Return dim-2 array with undefined element.
If (sColDelim=="") Then Return (ArrDimension(1,1)) ; Return dim-2 array with undefined element.
iRows = ItemCount(sString,sRowDelim) - !!iMode ; Trailing sRowDelim counts plus 1, so subtract 1.
iCols = ItemCount(ItemExtract(1,sString,sRowDelim),sColDelim)
aArray = ArrDimension(iRows,iCols)
iRowHigh = iRows-1
iColHigh = iCols-1
For iRow=0 To iRowHigh
sRow = ItemExtract(iRow+1,sString,sRowDelim)
For iCol=0 To iColHigh
aArray[iRow,iCol] = ItemExtract(iCol+1,sRow,sColDelim)
Next
Next
Return (aArray)
;..........................................................................................................................................
; This Function "udfArrayizeEx" returns a Dim-2 array, which array elements are filled
; by iterative separating the given input sString into chunks of data substrings.
;
; The input sString is a serialized string list representation of a 2-Dim array.
; The row components (Dim1) are delimited by sRowDelim.
; The column components (Dim2) are delimited by sColDelim.
; Parameter iMode indicates, if the input string is delimited by a sRowDelim character or not.
; iMode = 0 ... sString has no trailing row delimiter.
; iMode = 1 ... sString has trailing row delimiter.
;
; Syntax:
; a:ArrayDim2 = udfArrayizeEx (s:String, s:ColumnDelimiter, s:RowDelimiter, i:Mode)
;
; Detlev Dalitz.20030225
;..........................................................................................................................................
#EndFunction
; --- test ---
sMsgTitle = "Demo udfArrayizeEx (sString, sColDelim, sRowDelim, iMode)"
sString = "1|apple@2|pear@3|banana@"
sRowDelim = "@"
sColDelim = "|"
iMode = (StrSub(sString,StrLen(sString),1) == sRowDelim)
aArray = udfArrayizeEx (sString, sColDelim, sRowDelim, iMode)
Terminate(!VarType(aArray[0,0]),"Terminated.","Array is not ready.")
:DisplayResult
iDims = ArrInfo(aArray,0) ; Number of dimensions in the array.
sMsgText = StrCat("iDims = ",iDims,@LF)
For iDim=1 To iDims
iDim%iDim% = ArrInfo(aArray,iDim) ; Number of elements in dimension x.
sMsgText = StrCat(sMsgText,"iDim%iDim% = ",iDim%iDim%,@LF)
Next
sMsgText = StrCat(sMsgText,@LF)
sResult = "[No array elements]"
If iDim1
iDim1High = iDim1 - 1
sResult = ""
For iDim1=0 To iDim1High
sRow = ""
iDim2High = iDim2 - 1
For iDim2=0 To iDim2High
sRow = ItemInsert(aArray[iDim1,iDim2],-1,sRow,@TAB)
Next
sResult = StrCat(sResult,sRow,@LF)
Next
EndIf
IntControl(63,300,200,700,600) ; Sets coordinates for AskFileText, AskItemList and AskTextBox windows.
IntControl(28,1,0,0,0) ; Selects system font used in list boxes. p1=1=fixed pitch font.
AskItemlist("Example udfArrayizeEx (sString, sColDelim, sRowDelim, iMode)",StrCat(sMsgText,sResult),@LF,@UNSORTED,@SINGLE)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
||||
| Page Date 2004-05-18 DD-Software |
|
|
|
MyWbtHelp current version |