Results 1 to 2 of 2

Thread: Multidimensional indexing in unlimited dimensions

  1. #1
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,525
    Rep Power
    170

    Multidimensional indexing in unlimited dimensions

    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.
    Last edited by ReneMiner; 13-08-2013 at 17:23.
    I think there are missing some Forum-sections as beta-testing and support

  2. #2
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,525
    Rep Power
    170

    #MinVersion 1.9.16.x

    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
    ' ...................................................................
    
    Attached Images Attached Images
    Last edited by ReneMiner; 02-12-2015 at 11:34.
    I think there are missing some Forum-sections as beta-testing and support

Similar Threads

  1. Multidimensional array limit???
    By Oscar Ugolini in forum thinBasic General
    Replies: 2
    Last Post: 20-10-2012, 13:09
  2. Dimensions, from Riemann to M theory
    By Charles Pegge in forum Science
    Replies: 3
    Last Post: 27-05-2011, 15:23
  3. dimensions
    By kryton9 in forum Resources
    Replies: 0
    Last Post: 29-07-2007, 11:22

Members who have read this thread: 6

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •