Page Date
2004-05-18
DD-Software
Kapitel zurŁck / previous Chapter
Main Index
 
Seite zurŁck / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version

Array Functions



Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*




Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfArrItemLocate (aArray, Item)
udfArrIsItemInArray (aArray, Item)

;------------------------------------------------------------------------------------------------------------------------------------------
; udfArrItemLocate_1 (aArray, Item)                                                                                   ; 2002:08:22:08:50:51
; udfArrItemLocate_2 (aArray, Item)                                                                                   ; 2002:08:22:08:50:51
; udfArrItemLocate_3 (aArray, Item)                                                                                   ; 2002:08:22:08:50:51
; udfArrItemLocate_4 (aArray, Item)                                                                                   ; 2002:08:28:08:50:00
; udfIsItemInArray (aArray, sItem)                                                                                    ; 2002:08:22:08:50:51
;------------------------------------------------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemlocate_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemlocate_1

#DefineFunction udfArrItemLocate_1 (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
iMid = iTop/2
While 1
   If (aArray[iMid]>Item)
      iTop = iMid-1
      iMid = iMid-((iMid-iBot)/2)
   Else
      iBot = iMid
      iMid = iMid+((iTop-iMid)/2)
   EndIf
   If ((iTop-iBot)<=1) Then Break
EndWhile
If (aArray[iTop]==Item) Then Return (iTop)
If (aArray[iBot]==Item) Then Return (iBot)
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_1
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemlocate_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemlocate_2

#DefineFunction udfArrItemLocate_2 (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 1
   If (iBot==iTop)
      If (Item==aArray[iBot]) Then Return (iBot)
         Else Return (-1)
   EndIf
   iMid = (iBot+iTop)/2
   If (Item>aArray[iMid]) Then iBot = 1+iMid
      Else iTop = iMid
EndWhile
;..........................................................................................................................................
; 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_2
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemlocate_3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemlocate_3

#DefineFunction udfArrItemLocate_3 (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_3
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemlocate_4",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarritemlocate_4

#DefineFunction udfArrItemLocate_4 (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)>1)
   iMid = (iTop+iBot)/2
   If (Item>aArray[iMid]) Then iBot = iMid
      Else iTop = iMid
EndWhile
If (aArray[iTop]==Item) Then Return (iTop)
If (aArray[iBot]==Item) Then Return (iBot)
Return (-1)
#EndFunction

:skip_udfarritemlocate_4
;------------------------------------------------------------------------------------------------------------------------------------------



;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisiteminarray",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisiteminarray

#DefineFunction udfIsItemInArray (aArray, sItem)
Return (udfArrItemLocate_4(aArray,sItem)>-1)
;Return (udfArrItemLocate_3(aArray,sItem)>-1)
;Return (udfArrItemLocate_1(aArray,sItem)>-1)
;Return (udfArrItemLocate_2(aArray,sItem)>-1)
;..........................................................................................................................................
; This function "udfisItemInArray" returns a boolean value (@FALSE..@TRUE resp. 0..1)
; which indicates if a given item is element of a given ascending sorted array.
; This udf needs an ascending sorted array.
;
; Detlev Dalitz.20020821
;..........................................................................................................................................
#EndFunction

:skip_udfisiteminarray
;------------------------------------------------------------------------------------------------------------------------------------------



:performancetest
sMsgTitle = "Demo udfArrItemLocate (aArray, Item)  Performance Test"

iTestHigh = 4
iTestLow  = 1

iLoopHigh = 20
iLoopLow  = 1

Item1 = "ZZZ"     ; -1 ; Item is not in array, beyond right edge.
Item2 = "???"     ; -1 ; Item is not in array, beyond left edge.
Item3 = ""        ;  0 ; Item is in array, left edge.
Item4 = "zzzz"    ; 20 ; Item is in array, right edge.
Item5 = "drei"    ;  2 ; Item is in array, element 8 from the middle to the left.
Item6 = "zero"    ; 18 ; Item is in array, element 8 from the middle to the right.
Item7 = "four"    ;  6 ; Item is in array, element 4 from the middle to the left.
Item8 = "six"     ; 14 ; Item is in array, element 4 from the middle to the right.

iItemHigh = 8
iItemLow = 1

; aArray contains 21 elements
aArray = Arrayize(",acht,drei,eight,eins,five,four,fuenf,neun,nine,one,sechs,seven,sieben,six,three,two,vier,zero,zwei,zzzz",",")


For iTest=iTestLow To iTestHigh
   iTicks%iTest% = 0
   Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
   For iItem=iItemLow To iItemHigh
      For iLoop=iLoopLow To iLoopHigh
         Exclusive(@ON)
         iStart = GetTickCount()
         iResult = udfArrItemLocate_%iTest% (aArray, Item%iItem%)
         iStop = GetTickCount()
         Exclusive(@OFF)
         iTicks%iTest% = iTicks%iTest% + iStop-iStart
      Next
   Next
Next

iTicksMax = 0
For iTest=iTestLow To iTestHigh
   iTicksMax = Max(iTicksMax,iTicks%iTest%)
Next
For iTest=iTestLow To iTestHigh
   iPct%iTest% = 100*iTicks%iTest%/iTicksMax
Next
sMsgText = ""
For iTest=iTestLow To iTestHigh
   sMsgText = StrCat(sMsgText,"Test ",iTest,@TAB,"Ticks = ",@TAB,iTicks%iTest%,@TAB,iPct%iTest%," %%",@LF)
Next
Pause(sMsgTitle,sMsgText)
;................................
;   Test 1 Ticks =   9983   93 %
;   Test 2 Ticks =  10699  100 %
;   Test 3 Ticks =   9401   87 %
;   Test 4 Ticks =   9236   86 %
;................................
;   Test 1 Ticks =   9955   92 %
;   Test 2 Ticks =  10715  100 %
;   Test 3 Ticks =   9437   88 %
;   Test 4 Ticks =   9210   85 %
;................................

:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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*




Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

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
Kapitel zurŁck / previous Chapter
Main Index
 
Seite zurŁck / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version