Суть задачи такая.
Нужно удалить из текстового файла повторяющиеся слова. Причем текстовый файл очень большой, порядка 200 000 строк и повторяющихся слов там тоже очень много
Пример
мама
папа
мама
бабушка
дед
мама
Результат должен быть
мама
папа
бабушка
дед
Может это уже решалось здесь, но честное слово искал около часа. Находил тока работу с символами. Хотя может это и почти одно и тоже.
Решение включает в себя две основных задачи:
1. составление словаря;
2. поиск по словарю.
Поскольку размер словаря может быть весьма немалым, и заранее он неизвестен, то желательно использовать динамическую память. При указанном количестве строк и колличество слов может значительно превышать возможности сегмента (64К), так что придется структурировать. Если использование ТР не обязательно, то рекомендую взять 32-битный сомпилятор (например, FPC). Структурирование все равно весьма желательно для ускорения работы и уменьшения размеров. Структура базы данных (словаря) может быть как самой простой (слова в одном массиве of char, разделенные пробелами в алфавитном порядке), так и более сложной Например, блоки описанной струтуры, пронумерованные буквами - или парами, тройками букв.
Вот наглядная иллюстрация сказанного:
1-й способ (1):
а агат аз азот астра аська береза боб бор бочка вода воск восток дед дело дочь дочка
2-й способ с нумерацией одной буквой (2):
!а ? гат з зот стра ська !б ереза об ор очка !в ода оск осток !д ед ело очь очка
2-й способ с нумерацией двумя буквами (3):
1а ? 2г ат 2з ? от 2с тра ька 1б 2е реза 2о б р чка 1в 2о да ск сток 1д 2е д ло 2о чь чка
"?" означает слово без продолжение, только из нумерующих букв. Реально этот знак не нужен - два пробела подряд выполняют его роль.
Даже на глаз видно, что (2) выигрывает по объему по сравнению с (1).
Способ (3) на первый взгляд и сложнее, и места больше требует. Про сложность спорить не буду, но выигрыш в месте там будет заметен при бОльшем размере словаря.
Вот, примерно так.. Выбирай, что нарвится . Или предложи свою реализацию..
Да, еще про поиск.. Его можно вести дихотомией с самого начала - либо можно хранить карту пронумерованных блоков. Внутри блока - дихотомия..
Ну, а само удаление слов - дело несложное.. ломать - не делать! ))))
PS
Уточни также, что считать разделителями слов. Надеюсь, только пробелы..
В принципе, если повторяющихся строк очень много и ограничения по времени не критичны, то можно обойтись без массивов, используя временный файл.
Упс а я это убрал уже ибо про массивы ни слова не было ...
Примеров куча: Поиск + http://forum.pascal.net.ru/index.php?s=&showtopic=2706&view=findpost&p=23570
Хм, если словарь не большой (не много разных слов), то все достаточно быстро работает ...
генирируем большой файл
const
n = 10;
count = 200000;
Strings: array [0..n - 1] of String =
(
'mama', 'papa', 'dedushka', 'babushka', 'probabushka',
'sestra', 'brat', 'tesha', 'test', 'zat'
);
file_name = 'large.txt';
var
f: text;
i: LongInt;
begin
assign(f, file_name); rewrite(f);
randomize;
for i := 1 to count do writeln(f, Strings[Random(10)]);
writeln('Done'); close(f);
end.
uses crt;
const
file_name = 'large.txt';
type
PList = ^TList;
TList = record
data: String;
next: PList;
end;
var
f: Text;
head, T, H: PList;
s: String;
begin
assign(f, file_name); reset(f);
if not(eof(f)) then begin
readln(f, s);
new(T);
T^.data := s;
T^.next := nil;
head := T;
end;
while not(eof(f)) do begin
readln(f, s);
H := head;
while (head^.next <> nil) and (head^.data <> s) do head := head^.next;
if (head^.next = nil) and (head^.data <> s) then begin
new(T);
T^.data := s;
T^.next := nil;
head^.next := T;
end;
head := H;
end;
rewrite(f);
while (head <> nil) do begin
T := head;
writeln(f, head^.data);
head := head^.next;
dispose(T);
end;
close(f);
end.
Ну, со словарем из 10 слов естественно - ограничений по памяти никаких нет, тут все просто... А вот если размеры словаря зашкаливают за 2-3 тысячи, тут придется уже серьезно подумать...
да .. сгенерил файл с рандомными словами, и прога ушла в себя
Программа, написанная с использованием списков (деревья дадут гораздо большую скорость при поиске), отработала за 118 сек. против 49 минут по предыдущему алгоритму (слов в исходном файле - 347621, в алфавите - 24000 слов)
uses list;
var
arr_list: array['A' .. 'Z'] of tlist;
function is_present(var lst: tlist; s: string): boolean;
var st: string;
begin
is_present := lst.present(s);
end;
var
f_in, f_out: text;
s: string;
T: dword;
count_n, count_unique: integer;
ch: char;
begin
for ch := 'A' to 'Z' do begin
arr_list[ch].init;
end;
assign(f_in, 'very_big.txt');
reset(f_in);
assign(f_out, 'very_dup.txt');
rewrite(f_out);
count_n := 0; count_unique := 0;
while not eof(f_in) do begin
readln(f_in, s);
inc(count_n);
if count_n mod 50 = 0 then writeln(':: read ', count_n);
if not is_present(arr_list[upcase(s[1])], s) then begin
writeln(f_out, s);
inc(count_unique);
arr_list[upcase(s[1])].append(s);
end;
end;
close(f_out);
close(f_in);
writeln('count = ', count_n, ' unique = ', count_unique);
for ch := 'A' to 'Z' do begin
arr_list[ch].done;
end;
end.
Мой пример кода, как и говорил volvo работает офигеть, как долго
Uses Crt;
Var
s,st:string;
f1,f2:text;
x:INTEGER;
label a;
Begin
assign(f1,'C:\Pascal\zadachi\pere-ka\words2.txt');reset(f1);
assign(f2,'C:\Pascal\zadachi\pere-ka\words3.txt');
while not eof(f1) do
begin
while not eoln(f1) do
begin
read(f1,s);{Читаем слово из первого файла}
end;
readln(f1);
reset(f2);
while not eof(f2) do
begin
while not eoln(f2) do
begin
read(f2,st); {Читаем слова из второго файла}
if s=st then {Проверяем, есть ли совпадения}
begin
inc(x);
goto a;
end;
end;
readln(f2);
end;
a:
append(f2);
if x=0 then writeln(f2,s);{если совпадения не было,
записываем слово во второй файл (f2)}
x:=0;
end;
close(f1);
close(f2);
end.
{ Пишешь функцию, корректно работающую с кириллицей }
Function UpCase(ch: char): char;
Begin
UpCase := ch;
Case s[i] Of
'a' .. 'z': Upcase := Chr(Ord(s[i])-$20);
#160 .. #175: Upcase := Chr(Ord(s[i])-$20);
#224 .. #239: Upcase := Chr(Ord(s[i])-$50)
End;
End;
{ Перечисляешь весь алфавит }
const
alpha = 'АБВГД...'; { перечислен весь алфавит - 32 буквы }
var
arr_list: array[1 .. 32] of tlist;
...
for i := 1 to 32 do begin
arr_list[i].init;
end;
...
{ и работаешь вот в таком ключе: }
if not is_present(arr_list[pos(upcase(s[1]), s)], s) then begin ...