Быстрое удаление дублирующихся слов :).

[Stilet]

Utkin

Тогда либо мой способ либо способ Сержа примерно в таком виде:

var k,TS : TStringList;i:integer;
begin
  TS := TStringList.Create;k := TStringList.Create;
  TS.Sorted := true;
  k.DelimitedText:=та самая строка
  TS.Duplicates := dupIgnore;
  for i:=0 to k.count-1 do
   TS.Append (k[i]);
  k.free;

Теперь в TS.Text будет отсортированная по словам строка без повторов.

[Serge_Bliznykov]

Stilet, если не подключён модуль classes (а он, как я понял со слов TC, не подключён) - то использование TStringList невозможно...


p.s. кстати, свойство DelimitedText появилось только в Delphi 6, в моей Delphi5 такого нет

[Stilet]

если не подключён модуль classes

Не сложно и подключить...

в моей Delphi5 такого нет

Не всем везет на твоей Делфи работать ))))

[maxionans]

Если используется Delphi 2009/2010, то можно использовать код, приведенный ниже. Он однопроходный и очень быстрый - быстрее любого из уже приведенных на данной ветке (100 кб текста обрабатывается примерно за 40 мсек)

uses
  Windows, SysUtils, Generics.Collections;

type
  TStringDict = TDictionary<String,Integer>;

function RemoveDuplicates(const ASource : String) : String;
var
  Dict : TStringDict;
  Word, Key : String;
  I : Integer;
  WordFound : Boolean;
begin
  Dict := TStringDict.Create;
  try
    Result := ''; Word := ''; Key := '';
    WordFound := False;

    for I := 1 to Length( ASource ) do
    begin
      if IsCharAlphaNumeric( ASource[ I ] ) then
        begin
          Word := Word + ASource[ I ];
          Key := Key + AnsiLowerCase( ASource[ I ] )[ 1 ]
        end
      else
        WordFound := True;

      if WordFound or ( I = Length( ASource ) ) then
        begin
          WordFound := False;
          if not Dict.ContainsKey( Key ) then
            begin
              Dict.Add( Key, 0 );
              Result := Result + Word + ' ';
            end;

          Key := ''; Word := '';
        end;
    end;
  finally
    Dict.Free;
  end;
end;

[Utkin]

Ну у меня семерка и потом, мне кажется где-то меня дурят, и скорее всего в районе строки

if not Dict.ContainsKey( Key ) then

Каким образом работает такая строка? Наверняка там живет все тот же второй цикл.

100 кб текста обрабатывается примерно за 40 мсек

Да запросто, но нужно указывать характеристики компа. Я работаю на компе с весьма скромными возможностями.

[maxionans]

Сообщение от Utkin

Ну у меня семерка и потом, мне кажется где-то меня дурят, и скорее всего в районе строки

if not Dict.ContainsKey( Key ) then

Каким образом работает такая строка? Наверняка там живет все тот же второй цикл.

Что значит "дурят"? Вариант с TStringList в таком случает тоже "дурит". Конечно, второй цикл есть, но сложность его минимальна: "Generics.Collections.TDictiona ry represents a generic collection of key-value pairs. Adding or removing a key-value pair and looking up a key are efficient, close to O(1), because keys are hashed."

Сообщение от Utkin

Да запросто, но нужно указывать характеристики компа. Я работаю на компе с весьма скромными возможностями.

Процессор Core 2 DUO T5800 @ 2.Ghz.
Здесь замер времени для каждого из приведенных на данной ветке способов (кроме способа от Alex Cones, т.к. в нем нужно было строить массивы слов и их индексов, а мне было лень написать дополнительный код для этого. Но, т.к. там используется Pos по входной строке, то думаю, что его результат будет близок к RemoveDup3):

Name| Total time (s)
RemoveDup1 0.032927
RemoveDup2 0.038266
RemoveDup3 0.289411

А вот и код для каждой функции:

function RemoveDup1(const ASource : String) : String;
var
  Dict : TStringDict;
  Word, Key : String;
  I : Integer;
  WordFound : Boolean;
begin
  Dict := TStringDict.Create;
  try
    Result := ''; Word := ''; Key := '';
    WordFound := False;

    for I := 1 to Length( ASource ) do
    begin
      if ASource[ I ] <> ' ' then
        begin
          Word := Word + ASource[ I ];
          Key := Key + AnsiLowerCase( ASource[ I ] )[ 1 ]
        end
      else
        WordFound := True;

      if WordFound or ( I = Length( ASource ) ) then
        begin
          WordFound := False;
          if not Dict.ContainsKey( Key ) then
            begin
              Dict.Add( Key, 0 );
              Result := Result + Word + ' ';
            end;

          Key := ''; Word := '';
        end;
    end;
  finally
    Dict.Free;
  end;
end;

function RemoveDup2(const ASource : String) : String;
var
  K, TS : TStringList;
  I : Integer;
begin
  TS := TStringList.Create;
  K := TStringList.Create;

  TS.Sorted := True;
  K.Delimiter := ' ';
  K.DelimitedText := ASource;
  TS.Duplicates := dupIgnore;
  TS.CaseSensitive := False;

  for I := 0 to K.Count - 1 do
    TS.Append( K[ I ] );
  K.free;

  Result := TS.Text;
  TS.Free;
end;

function RemoveDup3(ASource : String) : String;
var
  S : String;
  K : Integer;
begin
  Result := '';
  ASource := Trim( ASource ) + ' ';
  K := Pos( ' ', ASource );
  while K <> 0 do begin
   S := Copy( ASource, 1, K );
   if Pos( S, Result ) = 0 then
    Result := Result + ' ' + S;

   Delete( ASource, 1, K );
   K := Pos( ' ', ASource );
  end;
end;

UPDATE:
В коде процедуры RemoveDup1 я допустил ошибку, написав "if ASource[ I ] = ' ' then" вместо "if ASource[ I ] <> ' ' then", что давало неверный результат работы процедуры. Я исправил ошибку и обновил замеры времени.

[Utkin]

кроме способа от Alex Cones

Но я решил задачу именно этим способом, без использования сторонних классов . Потестите его способ.

[maxionans]

Сообщение от Utkin

Но я решил задачу именно этим способом, без использования сторонних классов . Потестите его способ.

Пожалуйста Вот код функции:

procedure QSortStrings(var AStrings : array of String; L, R : Integer);
var
  I, J: Integer;
  pivot, temp: String;
begin
  repeat
    I := L;
    J := R;
    pivot := AStrings[L + (R - L) shr 1];
    repeat
      while CompareText(AStrings[I], pivot) < 0 do
        Inc(I);
      while CompareText(AStrings[J], pivot) > 0 do
        Dec(J);
      if I <= J then
      begin
        if I <> J then
        begin
          temp := AStrings[I];
          AStrings[I] := AStrings[J];
          AStrings[J] := temp;
        end;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QSortStrings( AStrings, L, J );
    L := I;
  until I >= R;
end;

function RemoveDup4(ASource : String) : String;
var
  Words : array of String;
  Indices : array of Integer;
  I, J : Integer;
  ElemCount : Integer;
  Str : String;
begin
  Result := ASource;
  ASource := ' ' + AnsiLowerCase( Trim( ASource ) ) + ' ';

  Initialize( Words );
  Initialize( Indices );

  J := 1; ElemCount := 0;
  for I := 1 to Length( ASource ) do
  begin
    if ( ASource[ I ] = ' ' ) then
      begin
        if ( I - J > 1 ) then
          begin
            if Length( Words ) <= ElemCount then
              SetLength( Words, ElemCount * 2 + 1 );
            Words[ ElemCount ] := Copy( ASource, J + 1, I - J - 1 );
            Inc( ElemCount );
          end;
        J := I;
      end;
  end;
  SetLength( Words, ElemCount );

  QSortStrings( Words, 0, High( Words ) );

  ElemCount := 0; I := 0; Str := EmptyStr;
  while I < Length( Words ) do
  begin
    if Words[ I ] = Str then
      begin
        if Length( Indices ) <= ElemCount then
          SetLength( Indices, ElemCount * 2 + 1 );
        Indices[ ElemCount ] := I;
        Inc( ElemCount );

        Inc( I );
        while Words[ I ] = Str do Inc( I );
      end
    else
      begin
        Str := Words[ I ];
        Inc( I );
      end;
  end;
  SetLength( Indices, ElemCount );

  for I := 0 to High( Indices ) do
  begin
    Str := ' ' + Words[ Indices[ I ] ] + ' ';
    J := Pos( Str, ASource );
    if J <> 0 then
      repeat
        J := PosEx( Str, ASource, J + 1 );
        if J <> 0 then
          begin
            Delete( ASource, J, Length( Str ) - 1 );
            Delete( Result, J, Length( Str ) - 1 );
          end;
      until J = 0;
  end;

  Finalize( Words );
  Finalize( Indices );

  Result := Trim( Result );
end;

Вот замеры времени:
Name| Total time (s)
RemoveDup1 0.033280
RemoveDup2 0.038365
RemoveDup4 0.281858
RemoveDup3 0.297385

PS. Если вам не нравится моя реализация алгоритма от Alex Cones, то дайте свою и я протестирую её.

[Utkin]

Сообщение от maxionans

PS. Если вам не нравится моя реализация алгоритма от Alex Cones, то дайте свою и я протестирую её.

Она использует некоторые дополнительные функции, но делал немного по-другому . Смысл в том, что я раскладывал в массив сразу без дубликатов, а потом снова собирал его в строку. Необходимости в сортировке элементов нет никакой - функция куда затем передается строка, рассматривает ее как множество, а для него порядок следования элементов значения не имеет (поэтому не сортировал).

// Удаление всех дублирующих элементов в массиве
function RemoveDupMas(Stroka1, razdelitel: String): String;
{var
        stroka, razd, kolvo, elem: String;
        kol, i: Integer;}
var
        i, Dlina, Count: Integer;
        Stroki: Array of String;
        Slovo: String;
begin


    // Альтернативный вариант функции
    // Инициализация
    Count:=0;
    SetLength(Stroki, Count);
    result:='';

    // Быстрая проверка
    If Stroka1='' then Exit;

    // Загоним все в массив
    // Определим число элементов
    Dlina:=StrToInt(GetIndexMas(Stroka1, razdelitel));

    // Разносим элементы
    for i:=1 to Dlina do
    begin

        // Получим элемент
        Slovo:=GetItemMas(Stroka1, razdelitel, IntTostr(i));

        // Проверим, есть ли в массиве элементы
        if CheckInMas(Slovo, Stroki, Count)=false then
        begin

            // Выделяем место под новое значение
            Inc(Count);
            SetLength(Stroki, Count);

            // Вносим элемент
            Stroki[Count-1]:=Slovo;
        end;
    end;

    // Теперь запакуем обратно в строку
    Dec(Count);
    for i:=0 to Count do
    begin

        // Закидываем слова
        result:=result+Stroki[i]+razdelitel;
    end;

    // Уберем последний разделитель
    result:=Copy(result, 1, Length(result)-1);

    // Подчистим массив
    SetLength(Stroki, 0);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////

// Проверка - входит ли данное слово в указанный массив строк
// True - входит
// Нумерация массива от нуля
function CheckInMas(Elem: String; Words: Array of String; DLina: Integer): Boolean;
var
    I: Integer;
begin

      // Инициализация
      result:=false;

      // Сканируем в цикле
      for i:=0 to Dlina-1 do
      begin

          // Совпало?
          If Elem=Words[i] then
          begin

              // Сообщим о совпадении
              result:=true;

              // Выйдем из функции
              Exit;
          end;
      end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////

GetIndexMas - определение числа элементов строкового массива
GetItemMas - получение элемента строкового массива

Мне так удобней .

[maxionans]

Ну так а что у вас в функциях GetIndexMas и GetItemMas?

UPDATE:
Я тут оптимизировал свой вариант реализации алгоритма от Alex Cones (хотя, теперь там от его алгоритма осталось только выделение слов в массив). Вот код:

function RemoveDup4(ASource : String) : String;
var
  Words : array of String;
  I, J : Integer;
  ElemCount : Integer;
  Str : String;
begin
  Result := '';
  ASource := Trim( ASource );
  if ASource = EmptyStr then Exit;

  Initialize( Words );

  J := 1; ElemCount := 0;
  for I := 1 to Length( ASource ) do
  begin
    if ( ASource[ I ] = ' ' ) then
      begin
        if ( I - J > 1 ) then
          begin
            if Length( Words ) <= ElemCount then
              SetLength( Words, ElemCount * 2 + 1 );
            Words[ ElemCount ] := Copy( ASource, J + 1, I - J - 1 );
            Inc( ElemCount );
          end;
        J := I;
      end;
  end;
  SetLength( Words, ElemCount );

  QSortStrings( Words, 0, High( Words ) );

  I := 0; Str := EmptyStr;
  while I < Length( Words ) do
  begin
    if SameText( Words[ I ], Str ) then
      begin
        Inc( I );
        while SameText( Words[ I ], Str ) do Inc( I );
      end
    else
      begin
        Str := Words[ I ];
        Result := Result + Str + ' ';
        Inc( I );
      end;
  end;

  Finalize( Words );

  Result := Trim( Result );
end;

Вот время выполнения:
Name| Total time (s)
RemoveDup4 0.012398
RemoveDup1 0.032941
RemoveDup2 0.038286
RemoveDup3 0.292436

А вот тест с другим файлом размером в 2 МБ:
Name| Total time (s)
RemoveDup4 0.371926
RemoveDup1 0.690033
RemoveDup2 0.946450
RemoveDup3 > минуты, я не дождался её завершения

В общем, быстрая получилась функция. Теперь осталось протестировать вашу