-
Oct 18th, 2020, 12:01 AM
#1
Thread Starter
Fanatic Member
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.
-
Oct 18th, 2020, 12:23 AM
#2
Thread Starter
Fanatic Member
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
-
Oct 18th, 2020, 01:58 AM
#3
Thread Starter
Fanatic Member
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.
-
Oct 18th, 2020, 09:49 AM
#4
Thread Starter
Fanatic Member
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
-
Oct 18th, 2020, 11:38 AM
#5
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
-
Oct 18th, 2020, 02:13 PM
#6
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
-
Oct 18th, 2020, 02:20 PM
#7
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. To all, peace and happiness.
-
Oct 18th, 2020, 03:16 PM
#8
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.
-
Oct 18th, 2020, 06:33 PM
#9
Thread Starter
Fanatic Member
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.
-
Oct 19th, 2020, 08:13 AM
#10
Thread Starter
Fanatic Member
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?
-
Oct 19th, 2020, 11:45 AM
#11
Re: Remove Duplicate Entries From UDT Array
Originally Posted by mms_
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
-
Oct 19th, 2020, 11:50 AM
#12
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
-
Oct 19th, 2020, 11:58 AM
#13
Thread Starter
Fanatic Member
Re: Remove Duplicate Entries From UDT Array
My UDT does in fact have more than two Fields.
Your change is noted. Thank you!
-
Oct 20th, 2020, 12:39 AM
#14
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
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE 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.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|