Удалить дубликаты строк - Delphi/RAD XE3+

[^D^ima]

Kirilis2018
Тут проблема ещё в том что ты не можешь открыть 2 раза файл через Reset. Я к тому что у тебя если файл крутиться через while not Eof() do то тебе не удастся сделать параллельно ещё один вложенный цикл while not Eof() do

[Kirilis2018]

Цитата ^D^ima @ 17.04.18, 18:17

Получается тупик.... Ох, буду думать.

Добавлено 17.04.18, 18:28
Славян, ^D^ima А что скажете про эту функцию, её можно привязать к кнопке ?

procedure ClearStringFromDublicate(S: TStrings; Coincidence: double = 75);
{-------------------------------------------------------------------}
{ Функция очистки списка предложений от дубликатов по заданному ... }
{ ... проценту определяющему схожесть строк                         }
{-------------------------------------------------------------------}
{ Параметры:                                                        }
{ - S : список обрабатываемых строк;                                }
{ - Coincidence : процент, характеризующий схожесть                 }
{-------------------------------------------------------------------}
type
  TDelimiter = set of #0..'я' ;
 
const
  StandartDelimiters: TDelimiter = [' ', '!', '@', '(', ')', '-', '|', '\', ';',
                                    ':', '"', '/', '?', '.', '>', ',', '<'];
 
var
  i, j: integer;
 
function DoStringMatch(s1, s2: string): double;
{ посимвольное сравнение строк с выдачей ... }
{ ... процента их схожести                   }
var
  i, iMin, iMax, iSameCount: integer;
begin
  iMax:=max(length(s1), length(s2));
  iMin:=min(length(s1), length(s2));
  iSameCount:=-1;
  for i:=0 to iMax do
    begin
      if i > iMin then
        break;
      if s1[i] = s2[i] then
        inc(iSameCount)
      else
        break
    end;
  if iSameCount > 0 then
    result:=(iSameCount / iMax) * 100
  else
    result:=0
end;
 
function StringToWords(const DelimitedText: string; ResultList: TStrings;
                       Delimiters: TDelimiter = []; ListClear: boolean = true): boolean;
{ разделение строки на отдельные слова }
var
  i, Len, Prev: word;
  TempList: TStringList;
begin
  result:=false;
  if (ResultList <> nil) and (DelimitedText <> '') then
    try
      TempList:=TStringList.Create;
      if Delimiters = [] then
        Delimiters:=StandartDelimiters;
      Len:=1; Prev:=0;
      for i:=1 to length(DelimitedText) do
        begin
          if Prev <> 0 then
            begin
              if DelimitedText[i] in Delimiters then
                begin
                  if Len = 0 then
                    Prev:=i + 1
                  else
                    begin
                      TempList.Add(copy(DelimitedText, Prev, Len));
                      Len:=0; Prev:=i + 1
                    end
                end
              else
                inc(Len)
            end
          else
            if not (DelimitedText[i] in Delimiters) then
              Prev:=i
        end;
      if Len > 0 then
        TempList.Add(copy(DelimitedText, Prev, Len));
      if TempList.Count > 0 then
        begin
          if ListClear then
            ResultList.Assign(TempList)
          else
            ResultList.AddStrings(TempList);
          result:=true
        end
    finally
      TempList.Free
    end
end;
 
function CompareStrings(s1, s2: string): double;
{ сравнение списков слов из двух строк на идентичность }
var
  sl1, sl2: tstrings;
  i, mixi: integer;
begin
  sl1:=TStringList.Create;
  sl2:=TStringList.Create;
  StringToWords(s1, sl1); StringToWords(s2, sl2);
  mixi:=min(sl1.Count, sl2.Count);
  result:=0;
  for i:=0 to mixi-1 do
    result:=result + DoStringMatch(sl1[i], sl2[i]);
  sl1.Free; sl2.Free;
  result:=result / mixi;
  messagebox(0, pchar(floattostr(result)), '', 0)
end;
 
begin
  if S.Count = 0 then exit;
  i:=0;
  while i < (S.Count - 1) do
    begin
      for j:=(S.Count - 1) downto (i + 1) do
        if CompareStrings(S[j], S[i]) >= Coincidence then
          S.Delete(j);
      inc(i)
    end
end;

[^D^ima]

Еб...

Вот так все пишется по-человечески:

var
  f1:TextFile;
  st:string;
  s:TStringList;
 
begin
  AssignFile(F1,'c:\123.txt');
  reset(f1);
  s:=TStringList.Create;
    While not EOF(f1) do
      begin
        readln(F1,st);
        If s.IndexOf(st)<0 then s.Add(st);
      end;
 
  s.SaveToFile('c:\321.txt');
  s.Free;
  CloseFile(f1);
end;

[Kirilis2018]

^D^ima,Благодарю, работает но обрабатывает очень долго. Но за то работает - уже успех!

Сообщение отредактировано: Kirilis2018 - 17.04.18, 19:33

[^D^ima]

Цитата Kirilis2018 @ 17.04.18, 19:21

но обрабатывает очень долго.

А по другому и никак не сделать. Файл считывает строки. Он должен найти конец строки. Поместить в память, попутно проверив что в памяти такого куска ещё нет. Чтобы поместить в память, например, последнюю строку, программа должна эту строку сравнить со всеми предыдущими.

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

[Kirilis2018]

Цитата ^D^ima @ 17.04.18, 20:05

В любом случае, спасибо. Буду эксперементировать, времени много.

[^D^ima]

Kirilis2018
Ещё есть такой вариант:

Var
  s:TStringList;
begin
  s:=TStringList.Create;
  s.Sorted:=true;
  s.Duplicates:=dupIgnore;
  s.LoadFromFile('c:\123.txt');
  s.SaveToFile('c:\321.txt');
  s.Free;
end;

Он сортирует строки, потом удаляет дубли. Возможно этот метод быстрее, но на выходе файл с отсортированными строками

[Kirilis2018]

^D^ima, Спасибо. Только пробовал, этот по шустрее но файлы до 220 метров только грузит и все. Но тоже как вариант можно использовать..

Сообщение отредактировано: Kirilis2018 - 17.04.18, 20:38

[^D^ima]

Kirilis2018
Смешанный вариант

Должен решить проблему ограничения памяти

var
  f1:TextFile;
  st:string;
  s:TStringList;
 
begin
  AssignFile(F1,'c:\123.txt');
  reset(f1);
  s:=TStringList.Create;
  s.Sorted:=true;
  s.Duplicates:=dupIgnore;
    While not EOF(f1) do
      begin
        readln(F1,st);
        s.Add(st);
      end;
 
  s.SaveToFile('c:\321.txt');
  s.Free;
  CloseFile(f1);
end;

Добавлено 17.04.18, 21:39
Ещё как советует Leo можно буфер задать

  Buf:array[0..4096*2-1] of byte;
 
begin
  AssignFile(F1,'c:\123.txt');
  reset(f1);
  SetTextBuf(Buf);

Сообщение отредактировано: ^D^ima - 17.04.18, 21:40

[Kirilis2018]

^D^ima, Респект Вам, Друг мой. Вот этот вариант самый приемлемый из тех что был.

Только последний вопрос: Buf:array[0..4096*2-1] of byte; Вставлять в var ?
То есть:

var
  f1:TextFile;
  st:string;
  s:TStringList;
  Buf:array[0..4096*2-1] of byte;

Сообщение отредактировано: Kirilis2018 - 18.04.18, 17:41

[^D^ima]

Да

[Kirilis2018]

Цитата ^D^ima @ 18.04.18, 18:06

Огромное Вам спасибо. Выручили меня по полной. Я днями - долбил код и все же до этого не додумался. Такой вариант меня полностью устраивает.

[MIF]

Цитата Славян @ 17.04.18, 15:52

Метод, конечно, жутко медленный (если строк - N, то время = O(N2)), но как быстрее с файлом провернуть - не знаю.

Читаешь строкы, берешь ее hash и смотришь есть ли он в hashset(а есть ли такое в Дельфи?). Если есть, то строку выбрасываешь, если нет, то добавляешь его в hashset. О(N1) получается?

[^D^ima]

Kirilis2018
Во всех примерах попробуй заменить TStringList на THashedStringList (uses inifiles) и посмотри на результат по скорости.

Добавлено 19.04.18, 10:59
Ещё можно такую мутку сделать:

Uses Hash
 
Var
  FIn,FOut:TextFile;
  S,SHash:String;
  SL:TStringList;
 
  Hash: THashMD5;
 
begin
  SL:=TStringList.Create;
  Hash := THashMD5.Create;
 
  AssignFile(FIn,'c:\123.txt');
  AssignFile(FOut,'c:\321.txt');
  reset(FIn);
  Rewrite(FOut);
 
    while not EOF(FIn) do
      Begin
        Readln(FIn,S);
        SHash:=hash.GetHashString(s);
 
        If SL.IndexOf(SHash)<0 then
          begin
            SL.Add(SHash);
            Writeln(FOut,S);
          end;
 
      End;
 
 
  CloseFile(FIn);
  CloseFile(Fout);
 
  SL.Free;
end;

Суть в том что в TStringList хранить хеши строк входящего файла и искать в стринглисте. Можно поиграться с разными хешами(SHA1,SHA2,MD5,BobJenkins)

Добавлено 19.04.18, 11:33
Кстати такой метод прилично экономит память на длинных строках.

[Славян]

Цитата MIF @ 19.04.18, 07:54

Читаешь строкы, берешь ее hash

Цитата Славян @ 17.04.18, 15:52

Можно было бы прочитать строки, узнать их хэш (CRC32 какой-нибудь), и по нему сверяться в памяти, но тогда мы сразу ныряем в вероятностный исход, а не хотелось бы.