Cod sursa(job #70164)

Utilizator MDanFMI - Dan Moldovan MDan Data 4 iulie 2007 21:53:24
Problema Text Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.65 kb
var a:array [1..300] of string;
    f,g:text;
    i,k,len,cuv,j,lk:longint;
    se:set of char;
    asd:char;
begin
assign (f,'text.in');
assign (g,'text.out');
reset (f);
rewrite (g);
i:=0;
for asd:='A' to 'Z' do
se:=se+[asd];
for asd:='a' to 'z' do
se:=se+[asd];
while not eof(f) do
begin
i:=i+1;
read (f,a[i]);
end;
len:=0;
cuv:=0;
k:=0;
for j:=1 to i do
    for lk:=1 to length(a[j]) do
    begin
	if a[j,lk] in se
	then
		begin
		len:=len+1;
		If k>=2
		then
			cuv:=cuv+1;
		k:=k+1;
		end
	else
		k:=0;
    end;
if (cuv=0) or (len=0)
then
    k:=0
else
    k:=round(len/cuv);
writeln (g,k);
close(f);
close(g);
end.