remove duplicates intries in an array

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
aloberoger
Posts: 507
Joined: Jan 13, 2009 19:23

remove duplicates intries in an array

Post by aloberoger »

Code: Select all

Sub  RemoveDuplicate (Arr() As Integer)
Dim i As Integer
Dim k As Integer
   
    k = LBound(Arr)
    For i = LBound(Arr)+1 To UBound(Arr)
        If Arr(k) <> Arr(i) Then
            k = k + 1
            Arr(k) = Arr(i)
        End If
    Next i

    ' Remove unused entries from the result array.
    ReDim Preserve Arr(LBound(Arr) To k)

  
End Sub
 
 
 Dim mem() As Integer
 ReDim mem(0 To 6) 
 mem(0)=10 
 mem(1)=12 
 mem(2)=12 
 mem(3)=11 
 mem(4)=10 
 
 mem(5)=20 
 mem(6)=210 
 
 
 For i As Integer=LBound(mem) To UBound(mem)
 	Print i,mem(i)
 Next
 Print
 Print
 RemoveDuplicate(mem())
 
 For i As Integer=LBound(mem) To UBound(mem)
 	Print i,mem(i)
 Next
 
 
 
 Sleep
 
this procedure does not give the expected result
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: remove duplicates intries in an array

Post by badidea »

aloberoger wrote:this procedure does not give the expected result
If you expected to remove all duplicates then that statement is correct.

I you take pen en paper and draw the row of numbers with 2 pointers i & k and run the algorithm manually, then you quickly see where it fails. The first number 10 is checked only once and never again. The 2 numbers 10 are never compared against each other because pointer k does not return to the beginning of the row where the first number 10 is.
Lost Zergling
Posts: 534
Joined: Dec 02, 2011 22:51
Location: France

Re: remove duplicates intries in an array

Post by Lost Zergling »

Not optimal for speed, but you could use a list

Code: Select all

' This one works
 #Include once "F:\Basic\LZLE_.bi"
 
Dim MyList As List
Dim As Integer k=0, i=0, keycount=0,  Arr()
Redim Arr(10)
For i=0 to 10 : Arr(i)=100+i : Next i
Arr(7)=102

For i = LBound(Arr) To UBound(Arr)
   If MyList.HashTag(Str(Arr(i)))=1 Then
        Print "Duplicate found on " & MyList.HashTag
        k+=1
    Else
        keycount+=1
        MyList.RwTag1(Str(i-k))
   End If
Next i

MyList.Root
While MyList.KeyStep
   ' ? "HashTag=" & MyList.HashTag & " Tag1=" & MyList.Tag(1)
   Arr(Cint(MyList.Tag(1)))=Cint(MyList.HashTag) 'Use the required type conversion
Wend
Redim Preserve Arr( LBound(Arr) To LBound(Arr)+keycount-1)

For i=LBound(Arr) To Ubound(Arr)
    ? "i=" & i & "   Arr(i)=" & Arr(i)
Next i
sleep
Short algo. easy to use. added k.
Last edited by Lost Zergling on Mar 09, 2021 9:57, edited 2 times in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: remove duplicates intries in an array

Post by dodicat »

A quickie

Code: Select all

#macro cleanup(a,b)
Redim  b(0)
Scope
    Dim As Long flag
    For n1 As Long=Lbound(a) To Ubound(a)
        flag=0
        For n2 As Long=n1+1 To Ubound(a)
            If a(n1)=a(n2) Then flag=1:Exit For
        Next n2
        If flag=0 Then
            Redim Preserve b(1 To Ubound(b)+1)
            b(Ubound(b))=a(n1)
        End If
    Next n1
    Var lb=Lbound(a)
    Redim Preserve b(lb To Ubound(b)+lb-1)
End Scope
#endmacro


#macro show(a)
For n As Integer=Lbound(a) To Ubound(a)
    Print n,a(n)
Next
Print
#endmacro



Dim mem() As Integer
Redim mem(0 To 6)
mem(0)=10
mem(1)=12
mem(2)=12
mem(3)=11
mem(4)=10

mem(5)=20
mem(6)=210

Redim result() As Integer
cleanup(mem,result)
show(result)

Dim As String s(3 To ...)={"a","b","c","a","b","c","d","f","f","f","q"}
Redim As String resultS()
cleanup(s,resultS)
show(resultS)

Redim As Long L2(-3 To 2000000)
For n As Long=-3 To Ubound(L2)
    L2(n)=Int(Rnd*10)
Next
Redim As Long Lanswer()
cleanup(L2,Lanswer)
Print 
show(LAnswer)
Sleep


 
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: remove duplicates intries in an array

Post by fxm »

Not optimized neither exhaustively tested:

Code: Select all

Sub  RemoveDuplicate (Arr() As Integer)
    Dim As Integer i, j
    Do
        For i = LBound(Arr) To UBound(Arr) - 1
            For j = i + 1 To Ubound(Arr)
                If Arr(i) = Arr(j) Then
                    Swap Arr(j), Arr(Ubound(Arr))
                    Redim Preserve Arr(LBound(Arr) To Ubound(Arr) - 1)
                    Continue Do
                End If
            Next j
        Next i
    Loop Until i = Ubound(Arr)
End Sub
Last edited by fxm on Mar 08, 2021 22:56, edited 2 times in total.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: remove duplicates intries in an array

Post by jj2007 »

Is your array sorted? If not, why would there be duplicate entries?
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: remove duplicates intries in an array

Post by badidea »

yes, instead of removing duplicates, can you prevent adding duplicates?
aloberoger
Posts: 507
Joined: Jan 13, 2009 19:23

Re: remove duplicates intries in an array

Post by aloberoger »

in general for the automated drawing there are often duplicate values ​​that can draw a text for example twice, when one wants to perform operations on the text, only one text is selected. and ...
aloberoger
Posts: 507
Joined: Jan 13, 2009 19:23

Re: remove duplicates intries in an array

Post by aloberoger »

the method of fxm is correct, but not suitable for large loops
on the other hand the dodicat method is optimized but does not give the expected result for the following case:
Dim mem () As Long
Redim mem (0 to 6)
mem (0) = 10
mem (1) = 12
mem (2) = 12
mem (3) = 11
mem (4) = 10

mem (5) = 20
mem (6) = 210

the result must be:
mem (0) = 10
mem (1) = 12
mem (2) = 11
mem (3) = 20
mem (4) = 210
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: remove duplicates intries in an array

Post by fxm »

My optimized version:

Code: Select all

Sub RemoveDuplicate (Arr() As Integer)
    Dim As Integer i, j, k
    k = Ubound(Arr)
    i = LBound(Arr)
    Do While i < k
        j = i + 1
        Do While j <= k
            If Arr(i) = Arr(j) Then
                Swap Arr(j), Arr(k)
                k = k - 1
            Else
                j = j + 1
            End If
        Loop
        i = i + 1
    Loop
    Redim Preserve Arr(LBound(Arr) To k)
End Sub
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: remove duplicates intries in an array

Post by fxm »

One more last small improvement in execution time:

Code: Select all

Sub RemoveDuplicate (Arr() As Integer)
    Dim As Integer i, j, k
    k = Ubound(Arr)
    i = LBound(Arr)
    Do While i < k
        j = i + 1
        Do While j <= k
            If Arr(i) = Arr(j) Then
                Arr(j) = Arr(k)
                k = k - 1
            Else
                j = j + 1
            End If
        Loop
        i = i + 1
    Loop
    Redim Preserve Arr(LBound(Arr) To k)
End Sub
Lost Zergling
Posts: 534
Joined: Dec 02, 2011 22:51
Location: France

Re: remove duplicates intries in an array

Post by Lost Zergling »

The correct way to do this is indeed and obviously to only build an index when required. This little code or stuff might find some use in lzae. :-)
aloberoger
Posts: 507
Joined: Jan 13, 2009 19:23

Re: remove duplicates intries in an array

Post by aloberoger »

fxm I think you need to improve your code a bit because look what happens with this example.



Code: Select all

Sub RemoveDuplicate OverLoad (Arr() As String,Lanswer()As String)
  
 Redim Lanswer(0)
Scope
 Dim As Long flag
   For n1 As Long=Lbound(Arr) To Ubound(Arr)
      flag=0
      For n2 As Long=n1+1 To Ubound(Arr)
        If Arr(n1)=Arr(n2) Then flag=1:Exit For
      Next n2
      If flag=0 Then
         ReDim Preserve Lanswer(1 To Ubound(Lanswer)+1)
         Lanswer(Ubound(Lanswer))=Arr(n1)
      End If
   Next n1
   Var lb=Lbound(Arr)
   ReDim Preserve Lanswer(lb To Ubound(Lanswer)+lb-1)
End Scope
End Sub

Sub Remove_Duplicate (Arr() As String)
    Dim As Integer i, j, k
    k = Ubound(Arr)
    i = LBound(Arr)
    Do While i < k
        j = i + 1
        Do While j <= k
            If Arr(i) = Arr(j) Then
                Arr(j) = Arr(k)
                k = k - 1
            Else
                j = j + 1
            End If
        Loop
        i = i + 1
    Loop
    Redim Preserve Arr(LBound(Arr) To k)
End Sub



 Print "-----3------"

Dim As String s(0 To ...)={"a","b","c","a","b","c","d","f","f","f","q"}
Redim As String resultS()
RemoveDuplicate(s(),resultS())
For n As Integer=Lbound(resultS) To Ubound(resultS)
 Print n,resultS(n)
Next
Print

 Print "-----4------"
 Dim As String ss()'={"a","b","c","a","b","c","d","f","f","f","q"}
 ReDim ss(0 To 10)
 ss(0)= "a"
  ss(1)="b"
  ss(2)="c"
  ss(3)="a"
  ss(4)="b"
  ss(5)="c"
  ss(6)="d"
  ss(7)="f"
  ss(8)="f"
  ss(9)="f"
  ss(10)="q"
 
Remove_Duplicate(ss())
For n As Integer=Lbound(sS) To Ubound(sS)
 Print n,sS(n)
Next
Print


Sleep
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: remove duplicates intries in an array

Post by fxm »

To be quick, the principle of this code does not necessarily respect the initial chronological order of the elements.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: remove duplicates intries in an array

Post by fxm »

Slightly modified version to respect the initial chronological order of the elements:

Code: Select all

Sub Remove_Duplicate (Arr() As String)
    Dim As Integer i, j, k, l
    k = Ubound(Arr)
    i = LBound(Arr)
    Do While i < k
        j = i + 1
        Do While j <= k
            If Arr(i) = Arr(j) Then
                For l = j To k - 1
                    Arr(l) = Arr(l + 1)
                Next l
                k = k - 1
            Else
                j = j + 1
            End If
        Loop
        i = i + 1
    Loop
    Redim Preserve Arr(LBound(Arr) To k)
End Sub
Post Reply