Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[34.203.221.104] |
|
Сообщ.
#1
,
|
|
|
Ребята, подскажите алгоритм - удаление дубликатов строк через:
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 |
Сообщ.
#2
,
|
|
|
Схема примерно такая:
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; Добавлено Метод, конечно, жутко медленный (если строк - N, то время = O(N2)), но как быстрее с файлом провернуть - не знаю. Можно было бы прочитать строки, узнать их хэш (CRC32 какой-нибудь), и по нему сверяться в памяти, но тогда мы сразу ныряем в вероятностный исход, а не хотелось бы. |
Сообщ.
#3
,
|
|
|
Цитата Славян @ Славян спасибо, но почему то подчеркивает ошибки. Вот так я сделал (Подскажите как исправить ?): 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 |
Сообщ.
#4
,
|
|
|
Скажите, какие ошибки, а то я на Си пишу, подзабыл Паскаль.
1. SavePos - просто придумалась. В Си есть ftell, коя говорит положение, как в Паскале - не знаю, но тоже что-то есть. 2. RePos - Тоже придумалась. В Си есть fseek(...), устанавливает положение. Как в Паскале - не знаю, но тоже что-то есть. 3. Есть ли в Паскале break - не помню. Но выход из цикла как-то делается. Добавлено Ну и эту pos надо в var завести. Небось, как long или что-то вроде такого. Добавлено Вторую Writeln(f2,s); уберите. |
Сообщ.
#5
,
|
|
|
Цитата Славян @ RePos - подчеркивает SavePos - подчеркивает Пишет: Undeclared identifier: 'RePos' |
Сообщ.
#6
,
|
|
|
s2 надо в объявление добавить.
Есть в Паскале: pos :=FilePos(f1); |
Сообщ.
#7
,
|
|
|
Славян Ух, я совсем теперь запутался... .
|
Сообщ.
#8
,
|
|
|
Сейчас раскопаемся!
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. Добавлено Переменная i не нужна. |
Сообщ.
#9
,
|
|
|
Славян Сделал вот так (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; |
Сообщ.
#10
,
|
|
|
Ну да, надо в var добавить:
pos :longInt; Добавлено А! Seek или ResetFile(f, pos) он хочет для бинарных файлов, а не для текстовых. Надо как-то перевести указатель f1 в бинарный. Как сие в Паскале делать - не ведаю. |
Сообщ.
#11
,
|
|
|
СлавянДобавил все равно ругается на: Reset(f1, pos); // вернёмся на место, где следующая строчка
|
Сообщ.
#12
,
|
|
|
Цитата Славян @ RePos(f1, pos); // вернёмся на место, где следующая строчка Хитрый какой. Для текстовых файлов не катит. У меня какое то странное дежавю про текстовые файлы и 700 мб. У меня несколько вариантов: 1 Считать весь файл в память, убрать дубли, поместить на диск. Но это не совсем через Reset Rewrite writeln 2 по тупому перебирать все сторки и сравнивать. Но это текстовый файл придется бесконца перебирать и чтобы взять последнюю строчку перебирать от начала до предпоследней строчки |
Сообщ.
#13
,
|
|
|
Так да, это последнее трудное место осталось. Надо спецов по Паскалю спрашивать о переводе. Ну и функция называется ResetFile.
Добавлено Цитата ^D^ima @ Ну это прямо=честно не катит. А если обмануть и перевести указатель с текстового на бинарный, то думаю, что скушает на 'ура'. Но вот с переводом - проблема. Подскажите, как там эти чёртовы cast'ы делаются? Для текстовых файлов не катит. |
Сообщ.
#14
,
|
|
|
^D^ima,Славян Походу, ребята, задача очень сложная. Вы, намного опытней меня и все равно задумались. А что уже говорить про меня. Но все равно Спасибо человеческое. Если получиться то гуд.
|
Сообщ.
#15
,
|
|
|
Ой, Kirilis2018, походу ResetFile указывает каким ему размером стать! Так что не надо её использовать!! Надо Seek докрутить.
|
Сообщ.
#16
,
|
|
|
Kirilis2018
Тут проблема ещё в том что ты не можешь открыть 2 раза файл через Reset. Я к тому что у тебя если файл крутиться через while not Eof() do то тебе не удастся сделать параллельно ещё один вложенный цикл while not Eof() do |
Сообщ.
#17
,
|
|
|
Цитата ^D^ima @ Получается тупик.... Ох, буду думать. Добавлено Славян, ^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; |
Сообщ.
#18
,
|
|
|
Еб...
Вот так все пишется по-человечески: 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; |
Сообщ.
#19
,
|
|
|
^D^ima,Благодарю, работает но обрабатывает очень долго. Но за то работает - уже успех!
|
Сообщ.
#20
,
|
|
|
Цитата Kirilis2018 @ но обрабатывает очень долго. А по другому и никак не сделать. Файл считывает строки. Он должен найти конец строки. Поместить в память, попутно проверив что в памяти такого куска ещё нет. Чтобы поместить в память, например, последнюю строку, программа должна эту строку сравнить со всеми предыдущими. Чтобы это все работало быстрее нужно применять всевозможные механизмы индексации, данные предварительного анализа(например предварительная сортировка в памяти) и т.д. Т.е. база данных по сути. Тогда такая выборка будет быстрее, но и запись в эту базу данных 700 мб строк из файла займет какое-то время. |
Сообщ.
#21
,
|
|
|
Цитата ^D^ima @ В любом случае, спасибо. Буду эксперементировать, времени много. |
Сообщ.
#22
,
|
|
|
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; Он сортирует строки, потом удаляет дубли. Возможно этот метод быстрее, но на выходе файл с отсортированными строками |
Сообщ.
#23
,
|
|
|
^D^ima, Спасибо. Только пробовал, этот по шустрее но файлы до 220 метров только грузит и все. Но тоже как вариант можно использовать..
|
Сообщ.
#24
,
|
|
|
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; Добавлено Ещё как советует Leo можно буфер задать Buf:array[0..4096*2-1] of byte; begin AssignFile(F1,'c:\123.txt'); reset(f1); SetTextBuf(Buf); |
Сообщ.
#25
,
|
|
|
^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; |
Сообщ.
#26
,
|
|
|
Да
|
Сообщ.
#27
,
|
|
|
Цитата ^D^ima @ Огромное Вам спасибо. Выручили меня по полной. Я днями - долбил код и все же до этого не додумался. Такой вариант меня полностью устраивает. |
Сообщ.
#28
,
|
|
|
Цитата Славян @ Метод, конечно, жутко медленный (если строк - N, то время = O(N2)), но как быстрее с файлом провернуть - не знаю. Читаешь строкы, берешь ее hash и смотришь есть ли он в hashset(а есть ли такое в Дельфи?). Если есть, то строку выбрасываешь, если нет, то добавляешь его в hashset. О(N1) получается? |
Сообщ.
#29
,
|
|
|
Kirilis2018
Во всех примерах попробуй заменить TStringList на THashedStringList (uses inifiles) и посмотри на результат по скорости. Добавлено Ещё можно такую мутку сделать: 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) Добавлено Кстати такой метод прилично экономит память на длинных строках. |
Сообщ.
#30
,
|
|
|
Цитата MIF @ Читаешь строкы, берешь ее hash Цитата Славян @ Можно было бы прочитать строки, узнать их хэш (CRC32 какой-нибудь), и по нему сверяться в памяти, но тогда мы сразу ныряем в вероятностный исход, а не хотелось бы. |
Сообщ.
#31
,
|
|
|
^D^ima
Очень дельный совет . Буду пробовать, после отпишусь. Человеческое спасибо! Добавлено ^D^ima, Кстати, когда прописываю в uses System.Hash. Он подчеркивается и надпись: cannot resolve unit name System.Hash. Что за ошибка ?, не могу понять... А если IdHashSHA то все нормально. |
Сообщ.
#32
,
|
|
|
В uses аросто hash
|
Сообщ.
#33
,
|
|
|
^D^ima, Так тоже пробовал так же само пишет. Может косяк в Delphi ?
|
Сообщ.
#34
,
|
|
|
Я в 10 пробовал
|
Сообщ.
#35
,
|
|
|
^D^ima,
Поставлю 2010 и тоже попробую. Скорее всего глюк в Delphi. Спасибо. |
Сообщ.
#36
,
|
|
|
Извращенцы! awk '!a[$0]++' in.file > out.file
|
Сообщ.
#37
,
|
|
|
Цитата Kirilis2018 @ Поставлю 2010 я писал о 10-м |
Сообщ.
#38
,
|
|
|
Цитата ^D^ima @ Аааа, я понял |
Сообщ.
#39
,
|
|
|
Цитата Славян @ хэш (CRC32 какой-нибудь) Кстати да, срс32 это циклический код(контрольная сумма) который имеет огромную коллизию, хеш который у всех на слуху, криптографический типа sha1,md5,sha2 имеет значительно меньшие коллизии и именно их имеют в виду в первую очередь говоря о хеше. Так что никто crc32 хранит не собирается |
Сообщ.
#40
,
|
|
|
Да я понимаю, ^D^ima, просто CRC32 простой и сразу пришёл на память. Но все остальные кэши - лишь уменьшают вероятность "сбоя", не приводя оную к 0. А таковой вероятностный (негарантированный) алгоритм я бы лично не принял. Да и задача явно не про такие ухищрения.
|
Сообщ.
#41
,
|
|
|
Тогда хранить в Dictionary. Там тоже поиск О(1), но коллизия исчезает. Есть в Дeльфи Dictionary?
|
Сообщ.
#42
,
|
|
|
Цитата Славян @ Но все остальные кэши - лишь уменьшают вероятность "сбоя", не приводя оную к 0. Но почти приводящую. Для SHA1 кстати нашли алгоритм подбора коллизий для разного набора данных, но: за десять лет с момента изобретения SHA-1 не было известно ни об одном практическом способе генерации коллизий. для подбора потребовалось: проводила компания Google. В общей сложности было произведено девять квинтиллионов вычислений SHA-1 (9 223 372 036 854 775 808), что потребовало 6500 процессорных лет на первой фазе и 110 лет GPU на второй фазе атаки. Так что если и захочешь, не найдешь. В Гитхабе и много где ещё SHA1 используется, а тут для простого прикладного примера. Не нравится SHA1, используй SHA2. Тем более в delphi, стандартном модуле hash используется SHA2 512, самый большой Добавлено Цитата MIF @ Есть в Дeльфи Dictionary? да |
Сообщ.
#43
,
|
|
|
Цитата Славян @ А таковой вероятностный (негарантированный) алгоритм я бы лично не принял Лол. Почитай как HashSet/HashMap устроен, про разрешение коллизий. Цитата Славян @ Да и задача явно не про такие ухищрения. Какие ухищрения? Использование HashSet/HashMap — стандартный способ решения этой задачи. |
Сообщ.
#44
,
|
|
|
Цитата korvin @ Что мне почитать - я уж как-нибудь сам придумаю; а если у вас есть обоснованные возражения о вероятностном характере получаемого алгоритма с хэшем - вполне могли бы здесь и набросать оные. Цитата Славян @ Почитай как HashSet/HashMap устроен, про разрешение коллизий.А таковой вероятностный (негарантированный) алгоритм я бы лично не принял. |
Сообщ.
#45
,
|
|
|
Цитата Славян @ Что мне почитать - я уж как-нибудь сам придумаю Но тогда не стоит писать и делать выводы о том, о чём имеешь плохое представление. Цитата Славян @ а если у вас есть обоснованные возражения о вероятностном характере получаемого алгоритма с хэшем Ты бы вместо набора слов писал бы лучше осмысленными выражениями. Какой ещё «вероятностный характер» в алгоритме с хэшами? Никакого random там не используется. Цитата Славян @ вполне могли бы здесь и набросать оные Зачем мне заниматься копипэйстингом? |
Сообщ.
#46
,
|
|
|
Цитата korvin @ Хорошее у меня представление или плохое - субъективная сторона, оставляйте лично ваше мнение при себе, не распространяйте на всех, не следует. Но тогда не стоит писать и делать выводы о том, о чём имеешь плохое представление. Цитата korvin @ Если вы не видите смысл, то не значит, что его нет. Другие вполне могут увидеть.Ты бы вместо набора слов писал бы лучше осмысленными выражениями. Цитата korvin @ Всякий хэш - попытка заменить огромный уникальный объём малым уникальным числовым значением. Гарантии уникальности числа хэш, как правило, не даёт, но указывает на маленькую вероятность коллизии. Так что да, random тут не при чём, но вероятности всё же рождаются, из иной составляющей.Какой ещё «вероятностный характер» в алгоритме с хэшами? Никакого random там не используется. Цитата korvin @ Мне точно было бы полезно услышать вкратце обоснованное возражение (если оно у вас есть). Зачем мне заниматься копипэйстингом? |