Ребятушки помогите родные!!! Дан символьный файл f.Группы символов,разделенные пробелами(одним или несколькими) и не содержащие пробелов внутри себя,будем называть словами.Удалить из файла все однобуквенные слова и лишние пробе...
Ребятушки помогите родные!!!
Дан символьный файл f.Группы символов,разделенные пробелами(одним или несколькими) и не содержащие пробелов внутри себя,будем называть словами.Удалить из файла все однобуквенные слова и лишние пробелы.Результат записать в файл g.
Гость
Ответ(ы) на вопрос:
Гостьprogram gt;
var f,g:text;
s,b:string;
l,i:integer;
begin
assign(f,'c:\input.txt');reset(f);
assign(g,'c:\output.txt');rewrite(g);
while not eof(f)do
begin
readln(f,s);
l:=length(s);
b:='';
if (s[2]<>' ') then b:=s[1];
i:=1;
while i' ') and (s[i+1]=' ') then i:=i+1 else b:=b+s[i];
end;
if (s[l-1]<>' ') then b:=b+s[l];
writeln(g,b);
end;
close(f);
close(g);
end.
Гостьfunction PosBlank(s: string; cursor: integer): integer;
{Возвращает позицию первого пробельного символа в строке s,
начиная с позиции, указанной cursor. Если такого символа нет,
возвращает 0.}
var
n: integer;
begin
n := Length(s);
while (s[cursor] <> ' ') and (cursor < n) do cursor := cursor + 1;
if cursor = n then
if s[cursor] = ' ' then PosBlank := n else PosBlank := 0
else
PosBlank := cursor
end;
function PosNonBlank(s: string; cursor: integer): integer;
{Возвращает позицию первого непробельного символа в строке s,
начиная с позиции, указанной cursor. Если такого символа нет,
возвращает 0.}
var
n: integer;
begin
n := Length(s);
while (s[cursor] = ' ') and (cursor < n) do cursor := cursor + 1;
if cursor = n then
if s[cursor] = ' ' then PosNonBlank := 0 else PosNonBlank := n
else
PosNonBlank := cursor
end;
procedure GetWord(s: string; var cursor: integer; var wd: string);
{Процедура помещает в wd очередное слово из строки s
Начало слова указано в cursor, после завершения процедуры
cursor будет указывать на первый пробельный символ,
следующий за найденным словом. Лидирующие и хвостовые
пробельные символы усекаются. Если слово не найдено, то
в wd помещается пустая строка}
var
n, ibegin: integer;
begin
n := length(s);
if n>0 then
begin
cursor := PosNonBlank(s, cursor);
if cursor > 0 then
begin
ibegin := cursor;
cursor := PosBlank(s, cursor);
if cursor > 0 then wd := Copy(s, ibegin, cursor - ibegin)
else wd := Copy(s, ibegin, n - ibegin + 1)
end
else
wd := ''
end
else
begin
wd:='';
cursor:=0
end
end;
var
c, cc, w: string;
ic: integer;
fin, fout: Text;
begin
Assign(fin, 'input.txt');
Reset(fin);
Assign(fout, 'output.txt');
Rewrite(fout);
while not Eof(fin) do
begin
ic := 1;
cc := '';
readln(fin, c);
while ic > 0 do
begin
GetWord(c, ic, w);
if w <> '' then cc := cc + ' ' + w
end;
cc := Copy(cc, 2, length(cc) - 1);
writeln(fout, cc)
end;
Close(fin);
Close(fout);
end.
Не нашли ответ?
Похожие вопросы