Cod sursa(job #13630)

Utilizator Data 7 februarie 2007 11:45:42 Text 30 fpc done Arhiva de probleme 2.74 kb
``````{\$IFDEF NORMAL}
{\$I-,Q-,R-,S-}
{\$ENDIF NORMAL}
{\$IFDEF DEBUG}
{\$I+,Q+,R+,S-}
{\$ENDIF DEBUG}
{\$IFDEF RELEASE}
{\$I-,Q-,R-,S-}
{\$ENDIF RELEASE}

type as=ansistring;
var fi,fo:text;
a,s:as;
nc,nl,rez:longint;
ok:boolean;

function min(i,j:longint):longint;
begin
if i=0 then begin min:=j; exit; end;
if j=0 then begin min:=i; exit; end;
if i>j then min:=j
else min:=i;
end;

procedure taie;
begin
while pos(',',s)<>0 do
delete(s,pos(',',s),1);
while pos('.',s)<>0 do
delete(s,pos('.',s),1);
while pos('!',s)<>0 do
delete(s,pos('!',s),1);
while pos('?',s)<>0 do
delete(s,pos('?',s),1);
while pos(';',s)<>0 do
delete(s,pos(';',s),1);
while pos(':',s)<>0 do
delete(s,pos(':',s),1);
while pos('(',s)<>0 do
delete(s,pos('(',s),1);
while pos(')',s)<>0 do
delete(s,pos(')',s),1);
end;

{ procedure solve;
var i,j,c:longint;
begin
i:=1;
for i:=1 to 10 do
if s[i] in[('A')..('Z')] then
begin
delete(s,1,i-1);
break;
end
else
if s[i] in[('a')..('z')] then
begin
delete(s,1,i-1);
break;
end;
while pos('- ',s)<>0 do
delete(s,pos('-',s),1);
while s<>'' do
begin
c:=min(pos(' ',s),pos('-',s));
if c=0 then
begin
inc(nl,length(s));
inc(nc);
break;
end;
c:=min(pos(' ',s),pos('-',s));
inc(nl,c-1);
inc(nc);
delete(s,1,c);

end;
rez:=trunc(nl/nc);
end;

}
procedure solve;
var i,j,c,sp,ln:longint;
begin
i:=1;
sp:=0;
ln:=0;
for i:=1 to 10 do
if s[i] in[('A')..('Z')] then
begin
delete(s,1,i-1);
break;
end
else
if s[i] in[('a')..('z')] then
begin
delete(s,1,i-1);
break;
end;
ok:=false;
nc:=1;

while pos('- ',s)<>0 do
delete(s,pos('- ',s),1);
while ok=false do
begin
while pos('-',s)<>0 do
begin
delete(s,pos('-',s),1);
inc(nc);
end;
while pos(' ',s)<>0 do
begin
delete(s,pos(' ',s),1);
inc(nc);
end;
ok:=true;
end;
nl:=length(s);
rez:=trunc(nl/nc);
end;

begin
assign(fi,'text.in'); reset(fi);
assign(fo,'text.out'); rewrite(fo);