Получить в новом файле отредактированный текст, в котором удалены повторные вхождения

За вознаграждение или нахаляву (если повезёт)

Модераторы: Хыиуду, MOTOCoder, Medved, dr.Jekill

Ответить
Powersej
Сообщения: 6
Зарегистрирован: 19 дек 2012, 19:57

Дан файл, содержащий текст на русском языке. В предложениях некоторые слова повторяются подряд несколько раз(предложения заканчиваются точкой или знаком восклицания). Получить в новом файле отредактированный текст, в котором удалены повторные вхождения слов в предложения.(с комментариями)
Powersej
Сообщения: 6
Зарегистрирован: 19 дек 2012, 19:57

Powersej писал(а):Дан файл, содержащий текст на русском языке. В предложениях некоторые слова повторяются подряд несколько раз(предложения заканчиваются точкой или знаком восклицания). Получить в новом файле отредактированный текст, в котором удалены повторные вхождения слов в предложения.(с комментариями)
Powersej писал(а):Короче сам решил, а вот со множествами проблема
Program Failbl;
Const m=[' ','.','!','?'];
Var s,s1,s2:string;
A:array[1..50] of string;
f,g:text;
i,k:byte;
Function kak_to_tak(s:string;k:byte):boolean;
Var i:byte;
b:boolean;
Begin
b:=true;
For i:=1 to k do
if A=s then b:=false;
kak_to_tak:=b;
End;
Begin
Assign(f,'in.txt');Reset(f);
Assign(g,'out.txt');Rewrite(g);
k:=0;
While not Eof(f) do
Begin
readln(f,s);
s:=s+' ';s1:='';s2:='';
For i:=1 to Length(s) do
if not(s in m) then s1:=s1+s
else
Begin
if kak_to_tak(s1,k) then
Begin
s2:=s2+s1+s;
inc(k);
A[k]:=s1;
End;
s1:='';
End;
if s2<>'' then writeln(g,s2);
End;
writeln('преобразование завершено');
Close(f);Close(g);
readln;
End.
Ответить