ReneMiner
29-07-2013, 09:09
If the three dimensions for a tB-variable are not enough for your needs, you also can just use an ordinary one-dimensional array and calculate where the position of an element would be located.
This is a formula to retrieve a linear position (1-dimensional, "Index") for any multidimensional addressed element with almost unlimited amount of dimensions. Limit is, there have to be at least 2 dimensions - to keep the formula small - and every dimension has to have at least 2 elements and there are maximum "only" 536.870.912 dimensions possible because we can not pass more parameters in one string...
posted function below works as follows
Pass two strings:
- one has to contain the "address" of the element to search for, one Dword per index
- second has to contain the boundarys of the dimensions, also one Dword per index
result is either the Index/Position where this item is/can be stored or 0 if any of the passed parameters was incorrect.
of course this works 1-based
It might be an idea to raise the performance to store the bounds somewhere and just pass the pointer - just change this to your needs
'example:
Uses "console"
PrintL "retrieve position for element(1, 1, 1, 1, 1)"
String sE = MKDWD$(1, 1, 1, 1, 1)
PrintL "in dimension bounds of (9, 8, 7, 6, 5)"
String sB = MKDWD$(9, 8, 7, 6, 5)
PrintL "element should be at position" + Str$(MultiDimPos sE, sB)
PrintL
sE = sB
PrintL "get last element:" + Str$(MultiDimPos sE, sB)
PrintL
sE = MKDWD$(5,5)
sB = MKDWD$(10,10)
PrintL "two dimensional, element(5,5) in bounds(10, 10)" + Str$(MultiDimPos sE, sB)
PrintL
sE = sB
PrintL "two dimensional, last in bounds(10, 10)" + Str$(MultiDimPos sE, sB)
WaitKey
' --------------------------------------------------------------------------------
' the function:
Function MultiDimPos(ByVal sDims As String, _
ByVal sBounds As String _
) As DWord
' returns linear position of element in "multidimensional" storage
' function awaits two strings
' for sDims pass MKDWD$(dim1, dim2, dim3...)
' for sBounds pass MKDWD$(ubound1, ubound2, ubound3...)
' both strings have to match in length
If StrPtrLen(StrPtr(sDims)) <> StrPtrLen(StrPtr(sBounds)) Then
'ERROR: No match!
Return 0
EndIf
' both need at least two dimensions
If StrPtrLen(StrPtr(sDims)) < 2 * SizeOf(DWord) Then
' ERROR: min 2 dimensions!
Return 0
EndIf
' not necessary if they match in length...
' If StrPtrLen(StrPtr(sBounds)) < 2 * SizeOf(DWord) Then
' ' ERROR: min 2 dimensions!
' Return 0
' EndIf
Local i, dwdPosition, numElements As DWord
Local nDims As DWord = StrPtrLen(StrPtr(sDims))/SizeOf(DWord)
' virtual overlay to both:
Dim vDims(nDims) As DWord At StrPtr(sDims)
Dim vBounds(nDims) As DWord At StrPtr(sBounds)
For i = 1 To nDims
' check to meet minimal requirements
If vDims(i) < 1 Or vDims(i) > vBounds(i) Then
'ERROR: Requested index ecxeeds dimensions bounds
Return 0
EndIf
If vBounds(i) < 2 Then
'ERROR: dimension needs at least 2 elements!
Return 0
EndIf
Next
numElements = vBounds(1)
For i = 2 To nDims
numElements = numElements * vBounds(i)
Next
For i = 1 To nDims - 1
numElements = numElements/vBounds(i)
dwdPosition = dwdPosition + (vDims(i)-1) * numElements
Next
Function = dwdPosition + vDims(nDims)
End Function
setup array like
Dim myArray( UboundDim1 * UboundDim2 [* UboundDim3 [* UboundDim4 [...]]] ) As ...
To "ReDim" the array it can be copied somewhere temporary before, then request elements within shared bounds at old position and assign it to new positions.
This is a formula to retrieve a linear position (1-dimensional, "Index") for any multidimensional addressed element with almost unlimited amount of dimensions. Limit is, there have to be at least 2 dimensions - to keep the formula small - and every dimension has to have at least 2 elements and there are maximum "only" 536.870.912 dimensions possible because we can not pass more parameters in one string...
posted function below works as follows
Pass two strings:
- one has to contain the "address" of the element to search for, one Dword per index
- second has to contain the boundarys of the dimensions, also one Dword per index
result is either the Index/Position where this item is/can be stored or 0 if any of the passed parameters was incorrect.
of course this works 1-based
It might be an idea to raise the performance to store the bounds somewhere and just pass the pointer - just change this to your needs
'example:
Uses "console"
PrintL "retrieve position for element(1, 1, 1, 1, 1)"
String sE = MKDWD$(1, 1, 1, 1, 1)
PrintL "in dimension bounds of (9, 8, 7, 6, 5)"
String sB = MKDWD$(9, 8, 7, 6, 5)
PrintL "element should be at position" + Str$(MultiDimPos sE, sB)
PrintL
sE = sB
PrintL "get last element:" + Str$(MultiDimPos sE, sB)
PrintL
sE = MKDWD$(5,5)
sB = MKDWD$(10,10)
PrintL "two dimensional, element(5,5) in bounds(10, 10)" + Str$(MultiDimPos sE, sB)
PrintL
sE = sB
PrintL "two dimensional, last in bounds(10, 10)" + Str$(MultiDimPos sE, sB)
WaitKey
' --------------------------------------------------------------------------------
' the function:
Function MultiDimPos(ByVal sDims As String, _
ByVal sBounds As String _
) As DWord
' returns linear position of element in "multidimensional" storage
' function awaits two strings
' for sDims pass MKDWD$(dim1, dim2, dim3...)
' for sBounds pass MKDWD$(ubound1, ubound2, ubound3...)
' both strings have to match in length
If StrPtrLen(StrPtr(sDims)) <> StrPtrLen(StrPtr(sBounds)) Then
'ERROR: No match!
Return 0
EndIf
' both need at least two dimensions
If StrPtrLen(StrPtr(sDims)) < 2 * SizeOf(DWord) Then
' ERROR: min 2 dimensions!
Return 0
EndIf
' not necessary if they match in length...
' If StrPtrLen(StrPtr(sBounds)) < 2 * SizeOf(DWord) Then
' ' ERROR: min 2 dimensions!
' Return 0
' EndIf
Local i, dwdPosition, numElements As DWord
Local nDims As DWord = StrPtrLen(StrPtr(sDims))/SizeOf(DWord)
' virtual overlay to both:
Dim vDims(nDims) As DWord At StrPtr(sDims)
Dim vBounds(nDims) As DWord At StrPtr(sBounds)
For i = 1 To nDims
' check to meet minimal requirements
If vDims(i) < 1 Or vDims(i) > vBounds(i) Then
'ERROR: Requested index ecxeeds dimensions bounds
Return 0
EndIf
If vBounds(i) < 2 Then
'ERROR: dimension needs at least 2 elements!
Return 0
EndIf
Next
numElements = vBounds(1)
For i = 2 To nDims
numElements = numElements * vBounds(i)
Next
For i = 1 To nDims - 1
numElements = numElements/vBounds(i)
dwdPosition = dwdPosition + (vDims(i)-1) * numElements
Next
Function = dwdPosition + vDims(nDims)
End Function
setup array like
Dim myArray( UboundDim1 * UboundDim2 [* UboundDim3 [* UboundDim4 [...]]] ) As ...
To "ReDim" the array it can be copied somewhere temporary before, then request elements within shared bounds at old position and assign it to new positions.