Vladimir_S |
19.12.2013 12:12 |
Цитата:
Сообщение от Aksinia
(Сообщение 982522)
Помогите найти ошибку в программе, пожалуйста!
|
Пожалуйста. Вот, отладил. Вроде работает. Пояснение: булевский флажок "b" поставлен для подстраховки: цикл перебора функций продолжается до тех пор, пока строка не перестанет изменяться. Но не уверен в его необходимости: вроде бы и без него получается, но, может быть, просто я не нашел комбинации символов, где бы он "сработал".
Код:
var
S:string;
f1,f2:text;
b:boolean;
function Lit(C:Char):boolean;
begin
Lit:=((ord(C)>64) and (ord(C)<91)) or
((ord(C)>96) and (ord(C)<123));
end;
function BeginOfLine(S:string):string;
var
O:string;
begin
O:=S;
while not(Lit(O[1])) do
begin
delete(O,1,1);
b:=false;
end;
BeginOfLine:=O;
end;
function DelProbBefCh(S:string):string;
var
P:string;
i:integer;
begin
P:=S;
i:=1;
repeat
if (P[i]=' ') and (P[i+1]=' ') then
begin
delete(P,i+1,1);
b:=false;
end
else i:=i+1;
until i=length(P)-1;
DelProbBefCh:=P;
end;
function DelNextSimb(S:string):string;
var N:string;
i:integer;
begin
i:=1;
N:=S;
while i<=(length(N)-1) do
begin
if Not(Lit(N[i])) and Not(Lit(N[i+1])) and (N[i+1]<>' ') then
begin
delete(N,i+1,1);
b:=false;
end else i:=i+1;
end;
DelNextSimb:=N;
end;
function InsProb(S:string):string;
var
M:string;
i:integer;
begin
M:=S;
i:=1;
repeat
if Not(Lit(M[i])) and (M[i]<>' ') and Lit(M[i+1]) then
begin
insert(' ',M,i+1);
b:=false;
i:=i+1;
end;
i:=i+1;
until i=length(M)-1;
InsProb:=M;
end;
begin
assign(f1, 'Input.txt');
reset(f1);
assign(f2, 'Output.txt');
rewrite(f2);
while not eof(f1) do
begin
readln(f1,S);
repeat
b:=true;
S:=BeginOfLine(S);
S:=DelProbBefCh(S);
S:=DelNextSimb(S);
S:=InsProb(S);
until b;
writeln(f2,S);
end;
close(f1);
close(f2);
end.
|