Multidimensional indexing in unlimited dimensions

**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.

**ReneMiner** · 01-12-2015, 21:52

Makeover of the above:

The Type tDimensions will hold your dimension-bounds-information and is able to calculate the 1-dimensional Index of multidimensional stored data.
The count of possible dimensions is nearly unlimited (> 268 millions)

(see the attachement for some code-overview)

' #Filename "Multidimensional.tBasic"    

Uses "console"

' example use:

' -------------------------------------------------------------
Function TBMain()
' -------------------------------------------------------------
  Dim i1, i2, i3, i4 As Long            ' little helpers
  
  ' setup dimensions for x(): 
  Dim dims As tDimensions((1, 3, _    ' first dimension low + hibounds 1 to 3
                           0, 5 ))    ' second dimension               0 to 5
  
  
                       
  ' now create x( Ubound be count of all elements in dims ) 
  Dim x( dims.ElementCount ) As String
  
       
  PrintL "Ubound X: " & Str$(UBound(x))
  
  ' assign some data, passing 2-dimensional Index
  
  x(dims.Index((1,0))) = "Hello, i am 1,0"
  x(dims.Index((2,1))) = "Hello, i am 2,1"
  x(dims.Index((3,2))) = "Hello, i am 3,2"
  x(dims.Index((1,3))) = "Hello, i am 1,3"
  x(dims.Index((2,4))) = "Hello, i am 2,4"
  x(dims.Index((3,5))) = "Hello, i am 3,5"
  
  
  ' loop through data
  For i1 = dims.LowBound(1) To dims.HiBound(1)
    For i2 = dims.LowBound(2) To dims.HiBound(2)
        ' read array x(         (dim1, dim2))
      PrintL i1, i2, x(dims.Index((i1, i2)))  
    Next
  Next
  
  PrintL $CRLF & "key to continue"     
  WaitKey 
  PrintL Repeat$(50, "-")
  
  
  PrintL "create three dimensions now, 1-based"
  PrintL "to show that the indexes fit thinBasic-dimensions then"
  
  dims._Create(( 1, 3, _
                 1, 3, _
                 1, 3  ))
                 
  Local l(dims.ElementCount) As Long  ' another 1-dimensional array  
                                      ' shall hold data in dimensions as dims
                                      
  PrintL "Ubound l: " & Str$(UBound(l))
  
  
  For i1 = dims.LowBound(1) To dims.HiBound(1)
    For i2 = dims.LowBound(2) To dims.HiBound(2)
      For i3 = dims.LowBound(3) To dims.HiBound(3) 
      ' fill in 3-dimensional values
      
        l(dims.Index((i1, i2, i3))) = 100 * i1 + 10 * i2 + i3
      
      Next
    Next
  Next  
  
  ' create virtual 3d-layover vl() on l():
  
  Local vl(dims.HiBound(1), _
           dims.Hibound(2), _
           dims.HiBound(3)  ) As Long At VarPtr(l(1))
  
   
  For i1 = 1 To UBound(vl, 1)
    For i2 = 1 To UBound(vl, 2)
      For i3 = 1 To UBound(vl, 3)
        Print i1, i2, i3 & ": " & Str$( vl(i1, i2, i3) ) & $TAB
      Next
      PrintL
    Next
  Next
  
  PrintL $CRLF & "key to continue"     
  WaitKey 
  PrintL Repeat$(50, "-")
  
  
  
  PrintL "create four dimensions now"
   
  dims._Create(( -1, 2, _      ' 1. dimension low, high
                  0, 3, _      ' 2. dimension
                  1, 4, _      ' 3. dimension
                  2, 5  ))     ' 4. dimension
  
  ' create 1-dimensional array to contain all elements:
  ReDim x( dims.ElementCount )
  
  PrintL "Ubound X: " & Str$(UBound(x))
  
  ' fill in some data:
  x(dims.Index((-1,0,1,2))) = "Hello, i am -1,0,1,2"
  x(dims.Index(( 0,1,2,3))) = "Hello, i am 0,1,2,3"
  x(dims.Index(( 1,2,3,4))) = "Hello, i am 1,2,3,4"
  x(dims.Index(( 2,3,4,5))) = "Hello, i am 2,3,4,5"
  
  For i1 = dims.LowBound(1) To dims.HiBound(1)
    For i2 = dims.LowBound(2) To dims.HiBound(2)
      For i3 = dims.LowBound(3) To dims.HiBound(3)
        For i4 = dims.LowBound(4) To dims.HiBound(4)
          '                      request data
          PrintL i1, i2, i3, i4, x(dims.Index((i1, i2, i3, i4)))
        Next
      Next
    Next
  Next  
  
  
  PrintL $CRLF & "key to end"
  WaitKey 
  
End Function   


' ######################################################################
Type tDimensions
' ######################################################################
    
Private  

  pDims As DWord ' stores multidimensional bounds 
  
Public
  
  ' -------------------------------------------------------------
  Function _Create(ByVal bounds(Any) As Long)              
  ' -------------------------------------------------------------
    ' setup dimensions
    ' pass (Dim1_LowBound, Dim1_HiBound [, Dim2_LowBound, Dim2_HiBound [,...]])
    
    
    Local i As Long
    
    
    If CountOf(bounds) And 1 Then 
      ' need low- & highbound for each dimension
      Exit Function
    EndIf                                      
    
    For i = 1 To CountOf(bounds) Step 2
      ' make sure the higher bounds are second
      If bounds(i) > bounds(i+1) Then
        Memory_Swap(VarPtr(bounds(i)), VarPtr(bounds(i+1)), 4)
      EndIf
    Next
    
    Me.pDims = HEAP_ReAllocByStr(Me.pDims, Memory_Get(VarPtr(bounds(1)), CountOf(bounds) * 4))
    
  End Function
                                                                 
  
  ' -------------------------------------------------------------
  Function _Destroy()                                                                                                             
  ' ------------------------------------------------------------- 
  ' free dimensions-information
  
    HEAP_Free(Me.pDims)
    Me.pDims = 0
    
  End Function
  
  ' -------------------------------------------------------------
  Function ElementCount() As Long
  ' -------------------------------------------------------------
  
  ' returns number of elements
    
    If Not Me.pDims Then Exit Function
    
    Local lResult As Long = 1
    Local lLow    As Long At Me.pDims
    Local lHigh   As Long At Me.pDims + 4
    
    While GetAt(lLow) < HEAP_End(Me.pDims)
    
      lResult *= lHigh - lLow + 1
      SetAt(lLow,  GetAt(lLow)  + 8) 
      SetAt(lHigh, GetAt(lHigh) + 8)
    Wend
    
    Function = lResult             
      
  End Function
  

  ' -------------------------------------------------------------
  Function Index(ByVal lIndex(Any) As Long) As Long             
  ' -------------------------------------------------------------
  ' returns 1-dimensional Index for multidimensional stored elements
  ' pass (Dim1_Index[,Dim2_Index [,...]])   
    
    If CountOf(lIndex) <> HEAP_Size(Me.pDims)/8 Then
      ' parameters not matching dimensions count
      MsgBox 0, "Error:  CountOf(Index) does not match dimensions"
      Stop
    EndIf                                      

    Local i, lResult, lTotal(CountOf(lIndex) + 1) As Long
   
    Local lLow    As Long At Me.pDims
    Local lHigh   As Long At Me.pDims + 4
   
      
    lTotal(UBound(lTotal)) = Me.ElementCount()
    
    
    For i = 1 To CountOf(lIndex)
      If Not Between(lIndex(i), lLow, lHigh) Then
        MsgBox 0, "Error:  Index(" & TStr$(i) & ") out of bounds" _
                   & $CRLF & "Value = " & Str$(lIndex(i)) & $CRLF _
                   & "should be between" & Str$(lLow) & " and" & Str$(lHigh)
        Stop
      EndIf
      lIndex(i) -= lLow
      lTotal(i) = lHigh - lLow + 1
      
      SetAt(lLow,  GetAt(lLow)  + 8) 
      SetAt(lHigh, GetAt(lHigh) + 8)
    Next  
     
    If CountOf(lIndex) = 1 Then
      lResult = lIndex(1) + 1
    Else
      lResult = 1
      For i = CountOf(lIndex) To 2 Step - 1
        lTotal(UBound(lTotal)) = lTotal(UBound(lTotal))/lTotal(i)
        lResult += lIndex(i) * lTotal(UBound(lTotal))
      Next
      lResult += lIndex(1)
    EndIf
      
    Function = lResult
    
  End Function
                                                                 
  ' -------------------------------------------------------------
  Function LowBound(ByVal lDim As Long) As Long
  ' -------------------------------------------------------------
    
    ' returns low bound of desired dimension
    
    If HEAP_Size(Me.pDims) < 8 Then
      MsgBox 0, "Error - no dimensions lowbound available at all"
      Stop
    EndIf
    
    If Outside(lDim, 1, HEAP_Size(Me.pDims)/8) Then
      MsgBox 0, "Error - no dimensions lowbound(" & TStr$(lDim) & ") available"
      Stop
    EndIf
    
    Function = Peek(Long, Me.pDims + (lDim - 1) * 8)  
    
  End Function

  ' -------------------------------------------------------------
  Function HiBound(ByVal lDim As Long) As Long
  ' -------------------------------------------------------------
    ' returns high bound of desired dimension
    
    If HEAP_Size(Me.pDims) < 8 Then
      MsgBox 0, "Error - no dimensions hibound available at all"
      Stop
    EndIf
    
    If Outside(lDim, 1, HEAP_Size(Me.pDims)/8) Then
      MsgBox 0, "Error - no dimensions hibound(" & TStr$(lDim) & ") available"
      Stop
    EndIf
    
    Function = Peek(Long, Me.pDims + 4 + (lDim-1) * 8)  
    
  End Function
  
  
  ' -------------------------------------------------------------
  Function DimCount() As Long
  ' -------------------------------------------------------------
    ' returns count of dimensions
    
    Function = HEAP_Size(Me.pDims) / 8
    
  End Function
                                                                     
' ...................................................................
End Type
' ...................................................................