Удаление повторяемых строчных элементов в массиве

[Citius]

Код: Выделить всё

    For i = 1 To UBound(Txt)
        For j = 1 To UBound(Txt)
        If i <> j Then
            If Txt(i) = Txt(j) Then
                For k = 1 To UBound(KeyW)
                    If KeyW(k) = Txt(i) Then
                        Countt = 1
                    End If
                Next k
                If Countt <> 1 Then
                    Count = Count + 1
                    ReDim Preserve KeyW(1 To Count)
                    KeyW(Count) = Txt(i)
                    KeyWords = KeyWords & KeyW(Count) & " "
                   
                End If
                Countt = 0
            End If
        End If
        Next j
    Next i

Что скажете про вот такой вот способ избавится от повторения одинаковых слов в массиве?
Как можно улучшить код? И стоит ли это делать?[/code]

[tyomitch]

Скажем, что коллекции рулят.
Кстати: у тебя слова, отличающиеся регистром, будут считаться различными. Это намеренно?

[EUGY]

Смотря для чего это надо.
можно например сначала проделать сортировку,
а потом уже одним прогоном цикла убрать не нужное.
Очень не нравится Redim во вложенных циклах.

[tyomitch]

А с коллекциями даже сортировка не нужна...

[Хакер]

С коллекциями нужно делать специальный класс с одним лишь свойством (стринговым), которое будет свойством по умолчанию.

С Dictionary ничего такого не нужно.

ЗЫ. Появилась идея написать кирпич "PHP-подобные переменные и массивы"

[tyomitch]

Нафига для коллекции делать класс?
Что, я обычные строки не могу в коллекцию положить?

[alibek]

Строки нет, Variant можешь.
Вернее, положить сможешь, забрать же только в Variant.

[tyomitch]

С таким уровнем придирок, я и написанный Хакером класс не смогу положить

[Citius]

Скажем, что коллекции рулят.
Кстати: у тебя слова, отличающиеся регистром, будут считаться различными. Это намеренно?

Не намерено, просто в это кусок кода массив Txt уже поступает обработаным (с обрезанными запятыми, точками и т.д., все слова понижены в нижний регистр) (но не отсортированным)

[Citius]

Очень не нравится Redim во вложенных циклах.

Объясни пожалуйста, почему? Как это влияет на работу программы?

[Хакер]

Citius
ReDim замедляет работу. А во вложенном цикле - замедляет множество раз.

[tyomitch]

Скажем, что коллекции рулят.
Кстати: у тебя слова, отличающиеся регистром, будут считаться различными. Это намеренно?

Не намерено, просто в это кусок кода массив Txt уже поступает обработаным (с обрезанными запятыми, точками и т.д., все слова понижены в нижний регистр) (но не отсортированным)

Ну тогда ещё лучше: коллекция сама отслеживает уникальность без учёта регистра.
Тебе даже не придётся переводить строки в нижний регистр самому.

[SSecurity]

Против редима я ничего не имею ...
Но предложенный код бы составил так

Код: Выделить всё

Dim KeyW() as string
Redim KeyW(0)
Count = 0
For i = 1 To UBound(Txt)
  If Txt(i)<>"" then
    For j = 1 To UBound(Txt)
      If i <> j Then
        '## убъем все похожие слова на корню, чтобы не мешали
        If Txt(i) = Txt(j) Then Txt(j) = ""
      Next j
    End if
    Count = Count + 1
    Redim Preserve KeyW(Count) 
    KeyW(Count) = Txt(I)
  End if
Next i


Здесь мы сначала убиваем все похожие слова, чтобы зря цикл не гонять а масив заполняем если слово ещё не было и без коллекций.

С Уважением,
Сергей

[SSecurity]

Ну или в крайнем случае можешь редим не делать .... а после исполнения кода .... в массиве останутся только уникальные слова ... т.е. простоым перебором и исключением пустых строк получишь нужный тебе массив уникальностей.

С Уважением,
Сергей

[tyomitch]

Здесь мы сначала убиваем все похожие слова, чтобы зря цикл не гонять а масив заполняем если слово ещё не было и без коллекций.

И в чём преимущество кода без коллекций?

[SSecurity]

По моему мнению
При небольших размерах массива (до сотни) перебор будет быстрее.

[tyomitch]

А в сто раз медленнее не хочешь?

Код: Выделить всё

Option Explicit

Const Sample = "Twas brillig and the slithy toves " & _
               "Did gyre and gimble in the wabe " & _
               "All mimsy were the borogoves " & _
               "And the mome raths outgrabe " & _
               "Beware the Jabberwock my son " & _
               "The jaws that bite the claws that catch " & _
               "Beware the Jubjub bird and shun " & _
               "The frumious Bandersnatch " & _
               "He took his vorpal sword in hand " & _
               "Long time the manxome foe he sought " & _
               "So rested he by the Tumtum tree " & _
               "And stood awhile in thought " & _
               "And as in uffish thought he stood " & _
               "The Jabberwock with eyes of flame " & _
               "Came whiffling through the tulgey wood " & _
               "And burbled as it came" '95 слов

Sub Main()
Dim test1() As String, test2() As String, Start As Double
test1 = Split(Sample)
test2 = test1

Start = Timer
Debug.Print Join(SSecurity(test1))
Debug.Print Timer - Start

Start = Timer
Debug.Print Join(tyomitch(test2))
Debug.Print Timer - Start
End Sub

Private Function SSecurity(Txt() As String) As String()
ReDim KeyW(0) As String
Dim Count As Long, i As Long, j As Long
Count = 0
For i = LBound(Txt) To UBound(Txt)
  If Txt(i) <> "" Then
    For j = LBound(Txt) To UBound(Txt)
      If i <> j Then
        '## убъем все похожие слова на корню, чтобы не мешали
        'tyomitch: для справедливости добавил приведение регистров
        If LCase(Txt(i)) = LCase(Txt(j)) Then Txt(j) = ""
      End If
    Next j
    Count = Count + 1
    ReDim Preserve KeyW(Count)
    KeyW(Count) = Txt(i)
  End If
Next i
SSecurity = KeyW
End Function

Private Function tyomitch(Txt() As String) As String()
Dim c As Collection: Set c = New Collection
On Error Resume Next
Dim i: For Each i In Txt
    c.Add i, i
Next
ReDim Result(1 To c.Count) As String
Dim j As Long: j = 1
For Each i In c
    Result(j) = i
    j = j + 1
Next
tyomitch = Result
End Function


На моём прогоне получаются 1,63E-02 и 3,75E-04 секунд, соответственно.

[SSecurity]

S: 7,24999999947613E-02
T: 1,03125000023283E-02

(ну не вижу тут я 100 кратного опережения)

Это получилось у меня ... Когда я лишь твой СИМПЛ сделал Стрингом, и просто в МАЙНе твой массив поместил.

А после того как я предварительно провел операцию LCase со всему исходному массиву, как это у автора топика и происходит, то вообще получил

S: 1,83125000039581E-02
T: 1,95625000051223E-02

S: 4,63750000053551E-02
T: 6,66875000024447E-02

(а здесь и поспорить можно) ...

Все говорит о том, что все зависит от кокретных условий:)

С Уважением,
Сергей

[SSecurity]

Код: Выделить всё

Option Explicit

Dim Sample As String


Sub Main()
Dim test1() As String, test2() As String, Start As Double

Sample = "Twas brillig and the slithy toves " & _
               "Did gyre and gimble in the wabe " & _
               "All mimsy were the borogoves " & _
               "And the mome raths outgrabe " & _
               "Beware the Jabberwock my son " & _
               "The jaws that bite the claws that catch " & _
               "Beware the Jubjub bird and shun " & _
               "The frumious Bandersnatch " & _
               "He took his vorpal sword in hand " & _
               "Long time the manxome foe he sought " & _
               "So rested he by the Tumtum tree " & _
               "And stood awhile in thought " & _
               "And as in uffish thought he stood " & _
               "The Jabberwock with eyes of flame " & _
               "Came whiffling through the tulgey wood " & _
               "And burbled as it came" '95 ñëîâ

Sample = LCase(Sample)
test1 = Split(Sample)

test1 = Split(Sample)
test2 = test1

Start = Timer
Debug.Print Join(SSecurity(test1))
Debug.Print Timer - Start

Start = Timer
Debug.Print Join(tyomitch(test2))
Debug.Print Timer - Start
End Sub

Private Function SSecurity(Txt() As String) As String()
ReDim KeyW(0) As String
Dim Count As Long, i As Long, j As Long
Count = 0
For i = LBound(Txt) To UBound(Txt)
  If Txt(i) <> "" Then
    For j = LBound(Txt) To UBound(Txt)
      If i <> j Then
        '## óáúåì âñå ïîõîæèå ñëîâà íà êîðíþ, ÷òîáû íå ìåøàëè
        'tyomitch: äëÿ ñïðàâåäëèâîñòè äîáàâèë ïðèâåäåíèå ðåãèñòðîâ
        'If LCase(Txt(i)) = LCase(Txt(j)) Then Txt(j) = ""
        If Txt(i) = Txt(j) Then Txt(j) = ""
      End If
    Next j
    Count = Count + 1
    ReDim Preserve KeyW(Count)
    KeyW(Count) = Txt(i)
  End If
Next i
SSecurity = KeyW
End Function

Private Function tyomitch(Txt() As String) As String()
Dim c As Collection: Set c = New Collection
On Error Resume Next
Dim i: For Each i In Txt
    c.Add i, i
Next
ReDim Result(1 To c.Count) As String
Dim j As Long: j = 1
For Each i In c
    Result(j) = i
    j = j + 1
Next
tyomitch = Result
End Function


[tyomitch]

А после того как я предварительно провел операцию LCase со всему исходному массиву, как это у автора топика и происходит

Нечестно: с моим вариантом этот LCase не нужен, а с твоим нужен.
Вставляй его под свой таймер

[SSecurity]

А, НАХ, текст в том виде в котором он есть ... начальные условия вполне ясно были описаны ...

Я твой намек прекрасно понимаю ... конечно время возрастет если ты N раз будешь вызывать LCase

Сам вызов времени требует ... и ты сам это прекрасно понимаешь:)
Кроме того для сравнения можно использовать нормальную функцию сравнения

Код: Выделить всё

If StrComp(Txt(i), Txt(j), vbTextCompare) = 0 Then Txt(j) = ""


тогда если оставить массив неформатированным получим:

S: 1,61249999946449E-02
T: 1,30000000062864E-02
S: 2,89374999993015E-02
T: 2,23750000004657E-02

С Уважением,
Сергей


[/quote]

[tyomitch]

Кроме того для сравнения можно использовать нормальную функцию сравнения

Код: Выделить всё

If StrComp(Txt(i), Txt(j), vbTextCompare) = 0 Then Txt(j) = ""


тогда если оставить массив неформатированным получим:

S: 1,61249999946449E-02
T: 1,30000000062864E-02
S: 2,89374999993015E-02
T: 2,23750000004657E-02

И где же здесь превосходство в скорости у перебора?


Про стократный перевес при вызове LCase в двойном цикле -- естественно это было только поводом

[SSecurity]

Вообще я речь веду о том, что перебрать массив размерностью до 100 эффективнее чем заюзать коллекцию ...

Ну и так, на всякий случай - про 100 раз это твои слова ... я лишь размерность обозначил:)

С Уважением,
Сергей

[tyomitch]

Вообще я речь веду о том, что перебрать массив размерностью до 100 эффективнее чем заюзать коллекцию ...

А я о том, что это не так
Если при переборе сравнивать без учёта регистра, что соответствует поставленной задаче.

[SSecurity]

Вообще я речь веду о том, что перебрать массив размерностью до 100 эффективнее чем заюзать коллекцию ...

А я о том, что это не так
Если при переборе сравнивать без учёта регистра, что соответствует поставленной задаче.

Хотел матюкнуться, но передумал .... (всеравно остался при своем мнении)
Набей массив элементам и сделай функцию поиска (два варианта)
1. перебором
2. через коллекцию
И посмотри что быстрее

[tyomitch]

Издеваешься что ли? Коллекция -- это хеш-таблица, в ней поиск за константное время.

[Citius]

Сказать по правде, то мне больше подходит код с Коллекциями, т.к. переборов зачастую бывает за 1000!!!