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

[Kirilis2018]

Ребята, подскажите алгоритм - удаление дубликатов строк через:
AssignFile
Reset
Rewrite
writeln

Что то типа такого (поскольку файлы будут по 300 - 700 мегабайт) или ваш вариант:

var f1,f2:TextFile;
s:string;
i:integer;
begin
if OpenDialog1.Execute then begin
AssignFile(f1,OpenDialog1.FileName);
AssignFile(f2,ExtractFileDir(OpenDialog1.FileName)+'\del.txt');
Reset(f1);
Rewrite(f2);
while not Eof(f1) do begin
        Readln(f1,s);
 
// и тут алгоритм удаления.
 
Writeln(f2,s);
end;
CloseFile(f1);
CloseFile(f2);
end;
end

[Славян]

Схема примерно такая:

unical:boolean;
while not Eof(f1) do
begin
        Readln(f1,s);
        pos := SavePos(f1); // сохраняем положение на следующей строке
        // и тут алгоритм удаления:
        unical := true; // пока прочитанная строка уникальна
        while not Eof(f1) do
        begin
        Readln(f1,s2); // ещё строку прочитали
        if s=s2 then begin unical :=false; break; end; // копия нашлась - выйдем из цикла while
        end;
        if unical then Writeln(f2,s); // уникальную - запишем
        RePos(f1, pos); // вернёмся на место, где следующая строчка
end;

Добавлено 17.04.18, 16:08
Метод, конечно, жутко медленный (если строк - N, то время = O(N²)), но как быстрее с файлом провернуть - не знаю.
Можно было бы прочитать строки, узнать их хэш (CRC32 какой-нибудь), и по нему сверяться в памяти, но тогда мы сразу ныряем в вероятностный исход, а не хотелось бы.

[Kirilis2018]

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

Славян спасибо, но почему то подчеркивает ошибки.
Вот так я сделал (Подскажите как исправить ?):

procedure Tfrm_Main.Button1Click(Sender: TObject);
var f1,f2:TextFile;
s:string;
i:integer;
unical:boolean;
begin
if OpenDialog1.Execute then begin
AssignFile(f1,OpenDialog1.FileName);
AssignFile(f2,ExtractFileDir(OpenDialog1.FileName)+'\del.txt');
Reset(f1);
Rewrite(f2);
while not Eof(f1) do begin
        Readln(f1,s);
 
 Readln(f1,s);
        pos := SavePos(f1); // сохраняем положение на следующей строке
        // и тут алгоритм удаления:
        unical := true; // пока прочитанная строка уникальна
        while not Eof(f1) do
        begin
        Readln(f1,s2); // ещё строку прочитали
        if s=s2 then begin unical :=false; break; end; // копия нашлась - выйдем из цикла while
        end;
        if unical then Writeln(f2,s); // уникальную - запишем
        RePos(f1, pos); // вернёмся на место, где следующая строчка
 
Writeln(f2,s);
end;
CloseFile(f1);
CloseFile(f2);
end;
end

[Славян]

Скажите, какие ошибки, а то я на Си пишу, подзабыл Паскаль.
1. SavePos - просто придумалась. В Си есть ftell, коя говорит положение, как в Паскале - не знаю, но тоже что-то есть.
2. RePos - Тоже придумалась. В Си есть fseek(...), устанавливает положение. Как в Паскале - не знаю, но тоже что-то есть.
3. Есть ли в Паскале break - не помню. Но выход из цикла как-то делается.


Добавлено 17.04.18, 16:17
Ну и эту pos надо в var завести. Небось, как long или что-то вроде такого.

Добавлено 17.04.18, 16:18
Вторую Writeln(f2,s); уберите.

[Kirilis2018]

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

RePos - подчеркивает
SavePos - подчеркивает
Пишет: Undeclared identifier: 'RePos'

[Славян]

s2 надо в объявление добавить.
Есть в Паскале: pos :=FilePos(f1);

[Kirilis2018]

Славян Ух, я совсем теперь запутался... .

[Славян]

Сейчас раскопаемся!

AssignFile(f1,FileName);
    AssignFile(f2,'el.txt');
    Reset( f1 );
    Rewrite( f2 );
    while not Eof(f1) do
    begin
        Readln( f1, s);
        pos := FilePos( f1 ); // сохраняем положение на следующей строке
        // и тут алгоритм удаления:
        unical := true; // пока прочитанная строка уникальна
        while not Eof(f1) do
        begin
            Readln( f1, s2); // ещё строку прочитали
            if s=s2 then begin unical := false; break; end; // копия нашлась - выйдем из цикла while
        end;
        if unical then Writeln(f2,s); // уникальную - запишем
        //Seek(f1, pos); // вернёмся на место, где следующая строчка
        ResetFile(f1, pos); // вернёмся на место, где следующая строчка
    end;
    CloseFile( f1 );
    CloseFile( f2 );
end.

Схема такая. ResetFile у меня не пашет. Надо доколдовать.

Добавлено 17.04.18, 16:41
Переменная i не нужна.

[Kirilis2018]

Славян Сделал вот так (pos := FilePos( f1 ); // Подчеркивает что неизвестный индентификатор):

var f1,f2:TextFile;
s,S2:string;
i:integer;
unical:boolean;
 
begin
if OpenDialog1.Execute then begin
AssignFile(f1,OpenDialog1.FileName);
AssignFile(f2,ExtractFileDir(OpenDialog1.FileName)+'\del.txt');
    Rewrite( f2 );
    while not Eof(f1) do
    begin
        Readln( f1, s);
        pos := FilePos( f1 ); // сохраняем положение на следующей строке
        // и тут алгоритм удаления:
        unical := true; // пока прочитанная строка уникальна
        while not Eof(f1) do
        begin
            Readln( f1, s2); // ещё строку прочитали
            if s=s2 then begin unical := false; break; end; // копия нашлась - выйдем из цикла while
        end;
        if unical then Writeln(f2,s); // уникальную - запишем
        //Seek(f1, pos); // вернёмся на место, где следующая строчка
        Reset(f1, pos); // вернёмся на место, где следующая строчка
    end;
    CloseFile( f1 );
    CloseFile( f2 );
end;
 end;

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

[Славян]

Ну да, надо в var добавить:
pos :longInt;

Добавлено 17.04.18, 17:36
А! Seek или ResetFile(f, pos) он хочет для бинарных файлов, а не для текстовых.
Надо как-то перевести указатель f1 в бинарный. Как сие в Паскале делать - не ведаю.

[Kirilis2018]

СлавянДобавил все равно ругается на: Reset(f1, pos); // вернёмся на место, где следующая строчка

[^D^ima]

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

RePos(f1, pos); // вернёмся на место, где следующая строчка

Хитрый какой. Для текстовых файлов не катит.

У меня какое то странное дежавю про текстовые файлы и 700 мб.

У меня несколько вариантов:
1 Считать весь файл в память, убрать дубли, поместить на диск. Но это не совсем через Reset Rewrite writeln
2 по тупому перебирать все сторки и сравнивать. Но это текстовый файл придется бесконца перебирать и чтобы взять последнюю строчку перебирать от начала до предпоследней строчки

[Славян]

Так да, это последнее трудное место осталось. Надо спецов по Паскалю спрашивать о переводе. Ну и функция называется ResetFile.

Добавлено 17.04.18, 17:52

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

Для текстовых файлов не катит.

Ну это прямо=честно не катит. А если обмануть и перевести указатель с текстового на бинарный, то думаю, что скушает на 'ура'. Но вот с переводом - проблема. Подскажите, как там эти чёртовы cast'ы делаются?

[Kirilis2018]

^D^ima,Славян Походу, ребята, задача очень сложная. Вы, намного опытней меня и все равно задумались. А что уже говорить про меня. Но все равно Спасибо человеческое. Если получиться то гуд.

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

[Славян]

Ой, Kirilis2018, походу ResetFile указывает каким ему размером стать! Так что не надо её использовать!! Надо Seek докрутить.