dcsimg
Results 1 to 10 of 10

Thread: Splitting a Flat UDT Array Into An Array Of UDT Arrays

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Nov 2018
    Posts
    132

    Splitting a Flat UDT Array Into An Array Of UDT Arrays

    I have an array obj() that I need to put into a different array sectionObj()

    The output should like like:
    Code:
    ------------------------------------------------------------------
    obj() array
    ------------------------------------------------------------------
    ndx        SectionID      TrackID     ObjectType
    [1]            1             1            A                               
    [2]            1             2            B                               
    [3]            1             3            D                               
    [4]            1             3            B                               
    [5]            1             3            C                               
    [6]            2             1            C                               
    [7]            3             1  
    ------------------------------------------------------------------
    sectionObj() array
    ------------------------------------------------------------------                                          
    section 1
        track 1
            A      
        track 2
            B    
        track 3
            D    
            B   
            C   
    section 2
        track 1
            C  
    section 3
        track 1
    My attempt to get this, is done in Command2_Click
    It is close, but not quite right.

    Any help with this would be appreciated.

    Complete Project (Form1 with 2 Command buttons):
    Code:
    Option Explicit
    
    
    '-----------------------------------
    Private Type GridObject
        objectType As String * 32
        Track As Long
        Section As Long
    End Type
    
    Private obj() As GridObject
    '-----------------------------------
    
    '-----------------------------------
    Private Type TrackObject
        obj() As GridObject
    End Type
    
    Private trackObj() As TrackObject
    '-----------------------------------
    
    '-----------------------------------
    Private Type SectionObject
        trackObj() As TrackObject
    End Type
    
    Private sectionObj() As SectionObject
    '-----------------------------------
    
    
    Private Sub Form_Load()
    
        Command1.Caption = "Load and Inspect"
        Command2.Caption = "Split and Inspect"
    
        Command2.Enabled = False
    
    End Sub
    
    
    Private Sub Command1_Click()
    
        Call LoadTestData02
    
        Command2.Enabled = True
        
        '-------------------------------------------------------------------------------
        ' Print obj for inspection
    
        Dim o As Long   'object counter
    
        Debug.Print "------------------------------------------------------------------"
        Debug.Print "obj() array"
        Debug.Print "------------------------------------------------------------------"
        Debug.Print "ndx        SectionID      TrackID     ObjectType"
        For o = 1 To UBound(obj)
            Debug.Print "[" & o & "]", obj(o).Section, obj(o).Track, obj(o).objectType
        Next o
        '-------------------------------------------------------------------------------
        
    End Sub
    
    
    Private Sub Command2_Click()
    
        ' Split obj array into sectionObj array
        
        Dim i As Long
        Dim objectCount As Long
        
        Dim prevSectionNum As Long
        Dim prevTrackNum As Long
        
        ' Dimension
        For i = 1 To UBound(obj)
            objectCount = objectCount + 1
            If obj(i).Section <> prevSectionNum Then
                ReDim Preserve sectionObj(1 To obj(i).Section)
                ReDim Preserve sectionObj(obj(i).Section).trackObj(1 To obj(i).Track)
                ReDim Preserve sectionObj(obj(i).Section).trackObj(obj(i).Track).obj(1 To objectCount)
            End If
        Next i
        
        'Fill
        Dim sectionID As Long
        Dim trackID As Long
        
        Dim prevSection As Long
        Dim prevTrack As Long
    
        objectCount = 0
        For i = 1 To UBound(obj)
            
            sectionID = obj(i).Section
            trackID = obj(i).Track
            If sectionID <> prevSection And trackID <> prevTrack Then
                prevSection = sectionID
                prevTrack = trackID
                objectCount = 0
            End If
            objectCount = objectCount + 1
            sectionObj(sectionID).trackObj(trackID).obj(objectCount) = obj(i)
        Next i
    
    
        '-------------------------------------------------------------------------------
        ' Print sectionObj for inspection
    
        Dim o As Long   'object counter
        Dim t As Long   'track counter
        Dim s As Long   'section counter
    
        Debug.Print "------------------------------------------------------------------"
        Debug.Print "sectionObj() array"
        Debug.Print "------------------------------------------------------------------"
        For s = 1 To UBound(sectionObj)
            Debug.Print "section " & s
            For t = 1 To UBound(sectionObj(s).trackObj)
                Debug.Print "    track " & t
                For o = 1 To UBound(sectionObj(s).trackObj(t).obj)
                    Debug.Print "        " & sectionObj(s).trackObj(t).obj(o).objectType
                Next o
            Next t
        Next s
        '-------------------------------------------------------------------------------
    
    End Sub
    
    
    Private Sub LoadTestData01()
        
        ReDim obj(1 To 2)
    
        obj(1).Section = 1
        obj(1).Track = 1
        obj(1).objectType = "A"
        
        obj(2).objectType = ""
    
    End Sub
    
    
    Private Sub LoadTestData02()
    
        ReDim obj(1 To 7)
    
        obj(1).Section = 1
        obj(1).Track = 1
        obj(1).objectType = "A"
        
        obj(2).Section = 1
        obj(2).Track = 2
        obj(2).objectType = "B"
        
        obj(3).Section = 1
        obj(3).Track = 3
        obj(3).objectType = "D"
        
        obj(4).Section = 1
        obj(4).Track = 3
        obj(4).objectType = "B"
        
        obj(5).Section = 1
        obj(5).Track = 3
        obj(5).objectType = "C"
        
        obj(6).Section = 2
        obj(6).Track = 1
        obj(6).objectType = "C"
    
        obj(7).Section = 3
        obj(7).Track = 1
        obj(7).objectType = ""
    
    End Sub

  2. #2
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,187

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Why do you use Arrays and not Recordsets?
    With Rs as DataContainers instead of Arrays this would be solvable elegantly via SQL-queries...

    Olaf

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Nov 2018
    Posts
    132

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Olaf
    Yes probably, but I am in way to deep with the way I have set this project up to make any major architecture changes.

    Everything was working good when I only had an array 2 deep (TrackObj/Obj)

    I needed in the past week to add another layer (SectionObj/TrackObj/Obj)
    Hundreds of lines to change.

    Everything else behaves as it should in the GUI, but when it comes to SavingToDisk and ReadingFromDisk, I am having troubles.

    I think I have SavingToDisk re-coded correctly, but I can't retrieve the saved file to open and view it in the GUI because ReadingFromDisk is now wrong,
    and proving difficult to re-write.

    The simple test project posted here is basically what I need to do in my ReadingFromDisk routine.

    The output I am getting from posted code.
    It seems my only problem is how I ReDim the arrays in my loop (hence the gaps)
    Code:
    ------------------------------------------------------------------
    sectionObj() array
    ------------------------------------------------------------------
    section 1
        track 1
            A                               
        track 2
                                            
            B                               
        track 3
                                            
                                            
            D                               
            B                               
            C                               
    section 2
        track 1
                                            
                                            
                                            
                                            
                                            
            C                               
    section 3
        track 1
    Last edited by mms_; May 17th, 2019 at 02:34 PM.

  4. #4
    Lively Member
    Join Date
    Nov 2011
    Posts
    124

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    dont know if this will help, but i had a similar issue and came up with this. Might not be exactly what you need but
    it may help.

    Code:
    ' in main for
    Private Sub Command1_Click()
        Dim a() As tList
    
        Dim x As Integer, Y As Integer
        For x = 0 To 2
    
            For Y = 0 To 3
                ReDim Preserve a(x)
                ReDim Preserve a(x).ClassName(Y)
                
                a(x).Title = Str(x)
                
                Select Case x
                Case 0
    
                    a(x).ClassName(Y) = "A" & Str(Y)
                Case 1
                    a(x).ClassName(Y) = "B" & Str(Y)
                Case 2
                    a(x).ClassName(Y) = "C" & Str(Y)
                Case Else
                    a(x).ClassName(Y) = "Else" + Str(Y)
    
                End Select
    
    
            Next Y
    
        Next x
    
    
        MsgBox UBound(a)
    
        MsgBox UBound(a(0).ClassName)
    
        MsgBox a(1).Title & " -- " & a(1).ClassName(1)
    
    
    End Sub
    
    
    ' place in module
    
    Public Type tList
        Title As String
        ClassName() As String
    
    End Type

  5. #5

    Thread Starter
    Addicted Member
    Join Date
    Nov 2018
    Posts
    132

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Thanks k_zeon for the reply.

    I've been going over and over your code, but I don't think it helps me.

    Thanks again though for trying!

  6. #6
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,187

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Quote Originally Posted by mms_ View Post
    Olaf
    Yes probably, but I am in way to deep with the way I have set this project up to make any major architecture changes.
    If you are not really under monetary constrictions, then a refactoring of existing code is always worthwhile IMO.

    Your problem seems to be a hierarchical one (not sure though, without seeing code) -
    you could at least take a look, how to tackle the task with "hierarchical helper-objects"
    (I'm talking about JSON-Objects - which should work fine in a hierarchy with up to 100000 elements total).

    Here is some demo-code (which requires vbRichClient5 for the JSON-support):
    Code:
    Option Explicit
    
    Private Root As cCollection
    
    Private Sub Form_Load()
      Set Root = New_c.JSONObject 'at startup, this could be initialized directly from file-content as well (see Form_Click)
    End Sub
    
    Private Sub Form_Click()
      H(1, 1, "A").Prop("Row") = 11 'ensure Section 1, Track 1 and ObjType A (with a single Row-Property)
      H(1, 2, "B").Prop("Row") = 22 'ensure Section 1, Track 2 and ObjType B (with a single Row-Property)
      Call H(3, 1) 'ignore the return-value - but ensure only Section 3, Track 1 (without any Objects in Track 1 yet)
      
      Debug.Print "Tracks in Section 1:"; H(1).Count
      Debug.Print "Objects in S 3, T 1:"; H(3, 1).Count
      Debug.Print "Row of Path 1, 1, A:"; H(1, 1, "A").Prop("Row"); vbLf
      
      Dim S As String
          S = Root.SerializeToJSONString
      Debug.Print S; vbLf 'just to print, how it looks like
      
      'now we can write this serialized JSON-String to disk...
      New_c.FSO.WriteTextContent "c:\temp\HierarchyTest.json", S, True
      
      'delete the Root (to show we're not cheating)
      Set Root = Nothing
      
      'and restore the root from the just written file
      Set Root = New_c.JSONDecodeToCollectionUTF8(New_c.FSO.ReadByteContent("c:\temp\HierarchyTest.json"))
      
      'let's do the same print-out test as further above
      Debug.Print "Tracks in Section 1:"; H(1).Count
      Debug.Print "Objects in S 3, T 1:"; H(3, 1).Count
      Debug.Print "Row of Path 1, 1, A:"; H(1, 1, "A").Prop("Row"); vbLf
    End Sub
    
    
    '****** Helper-Functions for this nested scenario **********
    Function Section(ByVal sID As Long) As cCollection
      If Not Root.Exists("s_" & sID) Then Root.Add New_c.JSONObject, "s_" & sID
      Set Section = Root("s_" & sID)
    End Function
    
    Function SectionTrack(Section As cCollection, ByVal tID As Long) As cCollection
      If Not Section.Exists("t_" & tID) Then Section.Add New_c.JSONObject, "t_" & tID
      Set SectionTrack = Section("t_" & tID)
    End Function
    
    Function TrackObject(Track As cCollection, oType As String) As cCollection
      If Not Track.Exists("o_" & oType) Then Track.Add New_c.JSONObject, "o_" & oType
      Set TrackObject = Track("o_" & oType)
    End Function
    
    Function H(Optional ByVal sID As Long, Optional ByVal tID As Long, Optional oType As String) As cCollection
      Set H = Root 'in case all optional Params were left out, we will return the Root
      If sID Then Set H = Section(sID) Else Exit Function
      If tID Then Set H = SectionTrack(H, tID) Else Exit Function
      If Len(oType) Then Set H = TrackObject(H, oType)
    End Function
    The first 3 Lines in Form_Click show already, how simple it would be, to add things into the hierarchys Root-object
    (which after Form_Load is instantiated and usable, but until the first Form_Click not contain any Items)

    The following lines show how to use the H(...) helper for readouts -
    and finally demonstrates JSON-serialization (into a file - and back into a new Root-instance).

    HTH

    Olaf

  7. #7

    Thread Starter
    Addicted Member
    Join Date
    Nov 2018
    Posts
    132

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Thanks Olaf

    No I'm not under any monetary constrictions.
    I'm just getting old and tired, and don't want to learn another language (JSON another language??)

    I did come up with this, and think it works
    Seems pretty straight-forward and intuitive.

    Code:
    Private Sub Command2_Click()
    
        ' Create sectionObj array from obj array
        
        Dim i As Long
        Dim numObjectsInTrack As Long
    
        Dim sectionID As Long
        Dim trackID As Long
        
        Dim prevSectionID As Long
        Dim prevTrackID As Long
    
        
        '-------------------------------------------------------------------------------
        ' Delete last item from obj if Section not assigned
        
        For i = 1 To UBound(obj)
            If obj(i).Section = 0 Then
                ReDim Preserve obj(1 To i - 1)
            End If
        Next i
        '-------------------------------------------------------------------------------
        
        
        '-------------------------------------------------------------------------------
        ' Create sectionObj array from obj array
        
        numObjectsInTrack = 1
        
        For i = 1 To UBound(obj)
    
            sectionID = obj(i).Section
            trackID = obj(i).Track
            
            If sectionID <> prevSectionID Or trackID <> prevTrackID Then
                
                numObjectsInTrack = 1
                
                prevSectionID = sectionID
                prevTrackID = trackID
    
                ReDim Preserve sectionObj(1 To sectionID)
                ReDim Preserve sectionObj(sectionID).trackObj(1 To trackID)
                ReDim Preserve sectionObj(sectionID).trackObj(trackID).obj(1 To numObjectsInTrack)
            
                sectionObj(sectionID).trackObj(trackID).obj(numObjectsInTrack) = obj(i)
    
            Else
    
                ReDim Preserve sectionObj(sectionID).trackObj(trackID).obj(1 To numObjectsInTrack)
                
                sectionObj(sectionID).trackObj(trackID).obj(numObjectsInTrack) = obj(i)
                        
            End If
    
            numObjectsInTrack = numObjectsInTrack + 1
            
        Next i
        '-------------------------------------------------------------------------------
        
        
        '-------------------------------------------------------------------------------
        ' Print sectionObj for inspection
    
        Dim o As Long   'object counter
        Dim t As Long   'track counter
        Dim s As Long   'section counter
    
        Debug.Print "------------------------------------------------------------------"
        Debug.Print "sectionObj() array"
        Debug.Print "------------------------------------------------------------------"
        For s = 1 To UBound(sectionObj)
            Debug.Print "section " & s
            For t = 1 To UBound(sectionObj(s).trackObj)
                Debug.Print "    track " & t
                For o = 1 To UBound(sectionObj(s).trackObj(t).obj)
                    Debug.Print "        " & sectionObj(s).trackObj(t).obj(o).objectType
                Next o
            Next t
        Next s
        '-------------------------------------------------------------------------------
    
    End Sub

  8. #8
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,187

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Quote Originally Posted by mms_ View Post
    No I'm not under any monetary constrictions.
    So you have time for your hobby, and will "code for fun", I guess.

    Quote Originally Posted by mms_ View Post
    I'm just getting old and tired, and don't want to learn another language (JSON another language??)
    JSON is not a language, but a data-format (for hierarchical object-serialization-scenarios).
    So, JSON exists:
    - either "as a String" (when it's serialized)
    - or "as an Object" (when it's de-serialized or "not yet serialized")

    And those JSON-Helper-Objects are usually Collection-like-ClassInstances (in VB6-implementations).

    Quote Originally Posted by mms_ View Post
    I did come up with this, and think it works
    No, not really...

    E.g. your dependence on Array-Indexes makes the whole approach unstable.
    If you change the order in your flat-array-Loading-Routine - or leave one Section- or Track-ID out,
    then your routine above will choke.

    That's (as said) because you're not treating your Section- and Track-IDs as "Keys", but as Array-Indexes
    (which might have gaps, or come in unordered, or need to be deleted in-between)

    Seriously, if you have a bit of time, you should study the test-routine below
    (which makes use of your LoadTestData02 routine, to fill the hierarchy from that "flat-array-list").

    Code to add to your Test-Form (along with a Command3-Button - and a Project-Reference to vbRichClient5):

    First the only Helper-Function you will need (H(...) will represent your Hierarchy):
    Code:
    Function H(ParamArray P()) As cCollection
      Static Root As cCollection, Key
          If Root Is Nothing Then Set Root = New_c.JSONObject
      Set H = Root
      For Each Key In P
        Key = Trim$(Key): If Len(Key) = 0 Then Exit For
        If Not H.Exists(Key) Then H.Add New_c.JSONObject, Key
        Set H = H.Item(Key)
      Next
    End Function
    And this the Command3-Button-Click-handler:
    Code:
    Private Sub Command3_Click()
       LoadTestData02 '<- first make sure, the obj(...) array is loaded (using the original routine)
    
       'now build a Hierarchy (a tree) from the Flat-objArray
       Dim i As Long
       For i = 1 To UBound(obj)
          Call H(obj(i).Section, obj(i).Track, obj(i).objectType) '<- this line is all what's needed import-wise
       Next
       
       'the import is finished, now let's see what we have in our Hierarchy H(...) 
       Debug.Print vbLf; "JSON-string: "; H().SerializeToJSONString; vbLf 'JSON-string-output (could be saved into a file directly)
       
       Dim si&, sk$, ti&, tk$, oi&, ok$ 'the i-suffixes mean an index, the k-suffixes a Key (or ID)
    
       For si = 0 To H().Count - 1 'H() refers to the Root-Col and contains Sections
           sk = H().KeyByIndex(si)
           Debug.Print "SectionID: "; sk
           
           For ti = 0 To H(sk).Count - 1 'H(sk) refers to a Section-Col and contains Tracks
               tk = H(sk).KeyByIndex(ti)
               Debug.Print , "TrackID: "; tk
               
               For oi = 0 To H(sk, tk).Count - 1 'H(sk, tk) refers to a Track-Col and contains Objects
                   ok = H(sk, tk).KeyByIndex(oi)
                   Debug.Print , , "ObjectType: "; ok
               Next oi
           Next ti
       Next si
    End Sub
    Note, that the above Code will not have any problems with non-sequential or inverse Section- or Track-Orderings -
    it will also not choke on ID-gaps - or when a Section 1 contains only a single Track 3.

    HTH

    Olaf

  9. #9

    Thread Starter
    Addicted Member
    Join Date
    Nov 2018
    Posts
    132

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Thanks Olaf,

    I've studied your code, and yes it seems very simple.
    I will look into this JSON data structure, as it works here, and I can see it has lots of other possibilities also.

    ...or leave one Section- or Track-ID out,
    then your routine above will choke.
    Yes, I had already had noticed this and added:
    Code:
        '-------------------------------------------------------------------------------
        ' Delete last item from obj if Section not assigned
        
        For i = 1 To UBound(obj)
            If obj(i).Section = 0 Then
                ReDim Preserve obj(1 To i - 1)
            End If
        Next i
        '-------------------------------------------------------------------------------
    I thought that code block would cover that eventuality??

    Since my SaveArrayToDisk functon is the only function that will create this "flat" array,
    I could ensure there, that this array to be read is always in the correct format, and therefore
    the Command2_Click (aka ReadArrayFromDisk) code will be reading properly formatted data.

    I will now start looking at JSON
    Last edited by mms_; Yesterday at 06:46 AM.

  10. #10
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,187

    Re: Splitting a Flat UDT Array Into An Array Of UDT Arrays

    Quote Originally Posted by mms_ View Post

    Yes, I had already had noticed this and added:
    Code:
        '-------------------------------------------------------------------------------
        ' Delete last item from obj if Section not assigned
        
        For i = 1 To UBound(obj)
            If obj(i).Section = 0 Then
                ReDim Preserve obj(1 To i - 1)
            End If
        Next i
        '-------------------------------------------------------------------------------
    I thought that code block would cover that eventuality??
    No, your routine will fail - when you change your Loader-Routine for example to the following:
    Code:
        obj(6).Section = 2
        obj(6).Track = 5 
        obj(6).objectType = "C"
    Your former, original path for that entry was 2/1/C...
    Now with the above you simply wanted to define a Node-Path of 2/5/C instead
    (which is an entirely valid combination to have IMO)

    Olaf

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width