Results 1 to 14 of 14

Thread: Remove Duplicate Entries From UDT Array

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2018
    Posts
    276

    Remove Duplicate Entries From UDT Array

    I need to remove duplicate entries (RT variable) from an array.

    Currently my code removes array elements after the first occurrence of a RT
    I would like to retain the RT element having the largest glyphWidth

    Here is my code:
    Code:
    Option Explicit
    
    Private Type myType
        RT As Long          'Running Time
        GlyphWidth As Long
    End Type
    
    Private Sub Command1_Click()
    
        Dim i As Long
        
        Dim a() As myType
        ReDim a(1 To 9)
        
        a(1).RT = 0:  a(1).GlyphWidth = 5
        a(2).RT = 0:  a(2).GlyphWidth = 5
        a(3).RT = 3:  a(3).GlyphWidth = 10
        a(4).RT = 3:  a(4).GlyphWidth = 15
        a(5).RT = 3:  a(5).GlyphWidth = 20
        a(6).RT = 3:  a(6).GlyphWidth = 12
        a(7).RT = 3:  a(7).GlyphWidth = 5
        a(8).RT = 8:  a(8).GlyphWidth = 10
        a(9).RT = 12: a(9).GlyphWidth = 5
        
        'inspect before purge
        Debug.Print "before purge -------------------"
        For i = 1 To UBound(a)
            Debug.Print a(i).RT, a(i).GlyphWidth
        Next i
        
        Dim prevRT As Long
        prevRT = -1         'RT can NEVER be negative
        
        Dim aCount As Long
        aCount = UBound(a)
        
        For i = 1 To UBound(a)
        
            If a(i).RT = prevRT Then
                
                'Remove from array
    
                Dim h As Long
                h = i
                For h = i To UBound(a) - 1
                    a(h) = a(h + 1)
                Next h
                aCount = aCount - 1
                ReDim Preserve a(1 To aCount)
                
                i = i - 1
    
            End If
            
            If i > aCount - 1 Then Exit For
    
            prevRT = a(i).RT
            
        Next i
        
        'inspect after purge
        Debug.Print "after purge --------------------"
        For i = 1 To UBound(a)
            Debug.Print a(i).RT, a(i).GlyphWidth
        Next i
        
    End Sub
    Current output
    Code:
    before purge -------------------
     0             5 
     0             5 
     3             10 
     3             15 
     3             20 
     3             12 
     3             5 
     8             10 
     12            5 
    after purge --------------------
     0             5 
     3             10 
     8             10 
     12            5
    Desired output
    Code:
    before purge -------------------
     0             5 
     0             5 
     3             10 
     3             15 
     3             20 
     3             12 
     3             5 
     8             10 
     12            5 
    after purge --------------------
     0             5 
     3             20 
     8             10 
     12            5
    Last edited by mms_; Oct 18th, 2020 at 12:13 AM.

  2. #2

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2018
    Posts
    276

    Re: Remove Duplicate Entries From UDT Array

    My first attempt.
    It does not work. Actually nothing gets purged.

    Code:
    Option Explicit
    
    Private Type myType
        RT As Long          'Running Time
        GlyphWidth As Long
    End Type
    
    Private Sub Command1_Click()
    
        Dim i As Long
        Dim j As Long
        
        Dim a() As myType
        ReDim a(1 To 9)
        
        a(1).RT = 0:  a(1).GlyphWidth = 5
        a(2).RT = 0:  a(2).GlyphWidth = 5
        a(3).RT = 3:  a(3).GlyphWidth = 10
        a(4).RT = 3:  a(4).GlyphWidth = 15
        a(5).RT = 3:  a(5).GlyphWidth = 20
        a(6).RT = 3:  a(6).GlyphWidth = 12
        a(7).RT = 3:  a(7).GlyphWidth = 5
        a(8).RT = 8:  a(8).GlyphWidth = 10
        a(9).RT = 12: a(9).GlyphWidth = 5
        
        'inspect before purge
        Debug.Print "before purge -------------------"
        For i = 1 To UBound(a)
            Debug.Print a(i).RT, a(i).GlyphWidth
        Next i
        
        Dim prevRT As Long
        prevRT = -1         'RT can NEVER be negative
        
        Dim aCount As Long
        aCount = UBound(a)
        
        For i = 1 To UBound(a)
        
            '-------------------------------------------------------
            'Find largest GlyphWidth for this RT
            
            Dim thisRT As Long
            Dim largestGlyphWidthThisRT As Long
            
            thisRT = a(i).RT
            largestGlyphWidthThisRT = a(i).GlyphWidth
            
            For j = 1 To UBound(a)
                If a(j).RT <> thisRT Then
                    Exit For
                Else
                    largestGlyphWidthThisRT = a(i).GlyphWidth
                End If
            Next j
            '-------------------------------------------------------
            
            'If a(i).RT = prevRT Then
            If a(i).RT = prevRT And a(i).GlyphWidth <> largestGlyphWidthThisRT Then
            
                'Remove from array
    
                Dim h As Long
                h = i
                For h = i To UBound(a) - 1
                    a(h) = a(h + 1)
                Next h
                aCount = aCount - 1
                ReDim Preserve a(1 To aCount)
                
                i = i - 1
    
            End If
            
            If i > aCount - 1 Then Exit For
    
            prevRT = a(i).RT
            
        Next i
        
        'inspect after purge
        Debug.Print "after purge --------------------"
        For i = 1 To UBound(a)
            Debug.Print a(i).RT, a(i).GlyphWidth
        Next i
        
    End Sub
    Output
    Code:
    before purge -------------------
     0             5 
     0             5 
     3             10 
     3             15 
     3             20 
     3             12 
     3             5 
     8             10 
     12            5 
    after purge --------------------
     0             5 
     0             5 
     3             10 
     3             15 
     3             20 
     3             12 
     3             5 
     8             10 
     12            5

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2018
    Posts
    276

    Re: Remove Duplicate Entries From UDT Array

    So I've come up with a solution, but as usual, I think I've made it more complicated than need be.

    If someone has a simpler, more intuitive solution, I would appreciate it.
    Code:
    Option Explicit
    
    Private Type myType
        RT As Long          'Running Time
        GlyphWidth As Long
    End Type
    
    Private Sub Command1_Click()
    
        Dim i As Long
        Dim j As Long
        
        Dim a() As myType
        ReDim a(1 To 9)
        
        a(1).RT = 0:  a(1).GlyphWidth = 5
        a(2).RT = 0:  a(2).GlyphWidth = 5
        a(3).RT = 3:  a(3).GlyphWidth = 10
        a(4).RT = 3:  a(4).GlyphWidth = 15
        a(5).RT = 3:  a(5).GlyphWidth = 20
        a(6).RT = 3:  a(6).GlyphWidth = 12
        a(7).RT = 3:  a(7).GlyphWidth = 5
        a(8).RT = 8:  a(8).GlyphWidth = 10
        a(9).RT = 12: a(9).GlyphWidth = 5
        
        'inspect before purge
        Debug.Print "before purge -------------------"
        For i = 1 To UBound(a)
            Debug.Print a(i).RT, a(i).GlyphWidth
        Next i
        
        Dim prevRT As Long
        prevRT = -1         'RT can NEVER be negative
        
        Dim prevWidth As Long
        
        Dim aCount As Long
        aCount = UBound(a)
        
        For i = 1 To UBound(a)
    
            '-------------------------------------------------------
            'Find largest GlyphWidth for this RT
            
            Dim thisRT As Long
            Dim largestGlyphWidthThisRT As Long
            
            thisRT = a(i).RT
            largestGlyphWidthThisRT = a(i).GlyphWidth
            
            For j = i To UBound(a)
                If a(j).RT <> thisRT Then
                    Exit For
                Else
                    If a(j).GlyphWidth > largestGlyphWidthThisRT Then
                        largestGlyphWidthThisRT = a(j).GlyphWidth
                    End If
                End If
            Next j
            '-------------------------------------------------------
    
            If (a(i).RT = thisRT And a(i).GlyphWidth <> largestGlyphWidthThisRT) _
                    Or _
               (a(i).RT = thisRT And a(i).RT = prevRT) _
                    Or _
               (a(i).RT = thisRT And a(i).GlyphWidth = prevWidth) Then
            
                'Remove from array
    
                Dim h As Long
                h = i
                For h = i To UBound(a) - 1
                    a(h) = a(h + 1)
                Next h
                aCount = aCount - 1
                ReDim Preserve a(1 To aCount)
                
                i = i - 1
    
            End If
            
            If i > aCount - 1 Then Exit For
    
            prevRT = a(i).RT
            prevWidth = a(i).GlyphWidth
            
        Next i
        
        'inspect after purge
        Debug.Print "after purge --------------------"
        For i = 1 To UBound(a)
            Debug.Print a(i).RT, a(i).GlyphWidth
        Next i
        
    End Sub
    Output
    Code:
    before purge -------------------
     0             5 
     0             5 
     3             10 
     3             15 
     3             20 
     3             12 
     3             5 
     8             10 
     12            5 
    after purge --------------------
     0             5 
     3             20 
     8             10 
     12            5
    At the very least, can this be simplified?
    Code:
            If (a(i).RT = thisRT And a(i).GlyphWidth <> largestGlyphWidthThisRT) _
                    Or _
               (a(i).RT = thisRT And a(i).RT = prevRT) _
                    Or _
               (a(i).RT = thisRT And a(i).GlyphWidth = prevWidth) Then
    Last edited by mms_; Oct 18th, 2020 at 02:10 AM.

  4. #4

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2018
    Posts
    276

    Re: Remove Duplicate Entries From UDT Array

    My solution does not work.

    This dataset causes "Subscript out of range" CRASH
    Code:
        a(1).RT = 3:  a(1).GlyphWidth = 5
        a(2).RT = 3:  a(2).GlyphWidth = 4
        a(3).RT = 3:  a(3).GlyphWidth = 10
        a(4).RT = 3:  a(4).GlyphWidth = 15
        a(5).RT = 3:  a(5).GlyphWidth = 20
        a(6).RT = 3:  a(6).GlyphWidth = 12
        a(7).RT = 3:  a(7).GlyphWidth = 5
        a(8).RT = 8:  a(8).GlyphWidth = 10
        a(9).RT = 12: a(9).GlyphWidth = 5

  5. #5
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,561

    Re: Remove Duplicate Entries From UDT Array

    Why not just avoid inserting duplicates?

    Code:
    Option Explicit
    
    Private Type myType
        RT As Long          'Running Time
        GlyphWidth As Long
    End Type
    
    Private Function Insert( _
        ByRef A() As myType, _
        ByVal RT As Long, _
        ByVal GlyphWidth As Long) As Long
    
        Const CHUNK = 10
        Static Count As Long
        Dim I As Long
    
        If RT < 0 Then
            If RT = -1 Then
                'Reset:
                Count = 0
                ReDim A(1 To CHUNK)
            ElseIf RT = -2 Then
                'Finalize:
                ReDim Preserve A(1 To Count)
            'Else
                'Just report Count.
            End If
        Else
            For I = 1 To Count
                If A(I).RT = RT Then
                    'Duplicate:
                    If A(I).GlyphWidth < GlyphWidth Then
                        A(I).GlyphWidth = GlyphWidth
                        Exit For
                    Else
                        Exit For
                    End If
                End If
            Next
            If I > Count Then
                Count = I
                If Count > UBound(A) Then ReDim Preserve A(1 To UBound(A) + CHUNK)
                With A(Count)
                    .RT = RT
                    .GlyphWidth = GlyphWidth
                End With
            End If
        End If
        Insert = Count
    End Function
    
    Private Sub Command1_Click()
        Dim I As Long
        Dim A() As myType
    
        Insert A, -1, -1
        Insert A, 0, 5
        Insert A, 0, 5
        Insert A, 3, 10
        Insert A, 3, 15
        Insert A, 3, 20
        Insert A, 3, 12
        Insert A, 3, 5
        Insert A, 8, 10
        Insert A, 12, 5
        Insert A, -2, -2
    
        Debug.Print "Values --------------------"
        For I = 1 To Insert(A, -3, -3)
            Debug.Print A(I).RT, A(I).GlyphWidth
        Next I
    End Sub
    Code:
    Values --------------------
     0             5 
     3             20 
     8             10 
     12            5

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

    Re: Remove Duplicate Entries From UDT Array

    With an SQL-engine one would perform this task via a simple:
    "Select RT, Max(GlyphWidth) Group By RT"
    ... to retrieve the desired result-set.

    Below is an approach, which tries to mimick such a "grouping-operation" via VB-code:

    Here's your example, set-up within a Form_Click-EventHandler.
    Code:
    Option Explicit
    
    Private Type myType
        RT As Long          'Running Time
        GlyphWidth As Long
    End Type
    
    Private Sub Form_Click()
        Dim i As Long, j As Long: ReDim a(1 To 9) As myType
     
        a(1).RT = 0:  a(1).GlyphWidth = 5
        a(2).RT = 0:  a(2).GlyphWidth = 5
        a(3).RT = 3:  a(3).GlyphWidth = 10
        a(4).RT = 3:  a(4).GlyphWidth = 15
        a(5).RT = 3:  a(5).GlyphWidth = 20
        a(6).RT = 3:  a(6).GlyphWidth = 12
        a(7).RT = 3:  a(7).GlyphWidth = 5
        a(8).RT = 8:  a(8).GlyphWidth = 10
        a(9).RT = 12: a(9).GlyphWidth = 5
     
        Debug.Print "before purge -------------------"
        For i = 1 To UBound(a): Debug.Print a(i).RT, a(i).GlyphWidth: Next
      
        GroupByRTMaxGlyphWidth a 'perform the "purge", like an SQL-GroupBy+Max() would do it
        
        Debug.Print "after purge --------------------"
        For i = 1 To UBound(a): Debug.Print a(i).RT, a(i).GlyphWidth: Next
    End Sub
    And here the two "SQL-like" operating Helper-functions, which are needed in addition:
    Code:
    Friend Sub GroupByRTMaxGlyphWidth(a() As myType)
      Dim i As Long, j As Long, gc As Long
      For i = 1 To UBound(a)
          j = FindGroupRTindexOn(a, a(i).RT, gc)
          If j = 0 Then 'no GroupList-entry exists yet...
             gc = gc + 1: a(gc) = a(i) 'so we increment the GroupCount, and copy the new entry
          ElseIf a(j).GlyphWidth < a(i).GlyphWidth Then 'entry does exist, but check for Max in addition
             a(j).GlyphWidth = a(i).GlyphWidth 'we overwrite, when the above Max-condition was true
          End If
      Next
      ReDim Preserve a(1 To gc) 'finally reduce the incoming list to the group-count
    End Sub
    
    Friend Function FindGroupRTindexOn(a() As myType, RT As Long, GroupCount As Long) As Long
      Dim i As Long
      For i = 1 To GroupCount
        If a(i).RT = RT Then FindGroupRTindexOn = i: Exit For
      Next
    End Function
    HTH

    Olaf

  7. #7
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    6,509

    Re: Remove Duplicate Entries From UDT Array

    My first thought here is (if you're allowed to sort the UDT array) to sort the array on the UDT field for which you're trying to eliminate dupes, and then build a new (dupes eliminated) array. It'd be easy to build the new array, just looping through the original array, adding to the new one only when the old array changed values on the no-dupe field.

    This would require two steps (sort, then loop and build new array), but it still eliminates the need to build nested loops that scan each element for dupes.

    And, I'd almost assuredly put it all in a function to which the original array was passed, and returned your no-dupes array.

    IDK, just my quick thoughts.

    EDIT: Actually, if you're not allowed to sort the original array, you could copy it before sorting in your function.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  8. #8
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,561

    Re: Remove Duplicate Entries From UDT Array

    Yeah, more information about the actual use case might reveal a lot of alternative approaches. Even knowing the actual population could make a difference. Things that work well for a small number of items might not be as good for tens of thousands of them.

  9. #9

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2018
    Posts
    276

    Re: Remove Duplicate Entries From UDT Array

    dilettante / Schmidt / Elroy

    Thank you for taking time to code working solutions to my problem!

    My internet was down all afternoon, so I struggled to get my code to work on my own.
    I could not come up with code to work correctly with all my test data sets.

    I'm pretty sure I can incorporate these into my main program.
    I will try this evening, so I will not mark as resolved just yet.

    Edit:
    The input array, will contain anywhere from 1, to probably around 50 max elements.

  10. #10

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2018
    Posts
    276

    Re: Remove Duplicate Entries From UDT Array

    Schmidt
    I was able to to copy/paste your functions into my main project (almost) verbatim, and output seems perfect.
    I will have to do some more testing, to make sure.
    Again, a big thank you!

    p.s. I had to change Friend to Public as those lines turned red in pasting.
    What is the intent of the Friend keyword, as I have never come across, or used this before?

  11. #11
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,950

    Re: Remove Duplicate Entries From UDT Array

    Quote Originally Posted by mms_ View Post
    Schmidt
    I was able to to copy/paste your functions into my main project (almost) verbatim, and output seems perfect.
    I will have to do some more testing, to make sure.
    Again, a big thank you!

    p.s. I had to change Friend to Public as those lines turned red in pasting.
    What is the intent of the Friend keyword, as I have never come across, or used this before?
    Friend can be used in Classes or Forms (which are Class-Modules as well), to allow for easier UDT-passing -
    if you have the routines in a normal *.bas module, then a Public function-signature will work as well.

    HTH

    Olaf

  12. #12
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,950

    Re: Remove Duplicate Entries From UDT Array

    Just a sidenote, regarding the ElseIf-part in one of the two routines:

    as originally posted:
    Code:
    ElseIf a(j).GlyphWidth < a(i).GlyphWidth Then 'entry does exist, but check for Max in addition
       a(j).GlyphWidth = a(i).GlyphWidth 'we overwrite, when the above Max-condition was true
    End If
    In case your UDT-def really contains only the two Fields, then the above is OK.
    But if your UDT-def has more fields, then you should copy over the whole UDT-entry instead:

    better change it to:
    Code:
    ElseIf a(j).GlyphWidth < a(i).GlyphWidth Then 'entry does exist, but check for Max in addition
       a(j) = a(i) 'we overwrite the record completely, when the above Max-condition was true
    End If
    Olaf

  13. #13

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2018
    Posts
    276

    Re: Remove Duplicate Entries From UDT Array

    My UDT does in fact have more than two Fields.

    Your change is noted. Thank you!

  14. #14
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    2,264

    Re: Remove Duplicate Entries From UDT Array

    As a "quick" ( ! ) solution:
    Your "RT"-Field seems to be the "key" of the Array, and you want it to be unique, albeit with the Highest Width of a Glyph.
    As an algorithm (Aircode)
    Define/Dim a Collection
    Turn Off Error-Handling (On Error Resume Next)
    With each instance of a new UDT being created add the RT-Field to the collection with the RT-value added as key to the collection and the "would-be" Array-Index as Item!
    Check if an Error has been returned ("Key already in Collection" or whatever it's called).
    If No, your UDT goes into the Array
    If Yes, check if current GlyphWidth > Array(CollectionItemReturnedByKey).GlyphWidth --> If No, ignore, if yes, replace
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

Posting Permissions

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



Click Here to Expand Forum to Full Width