Cod sursa(job #561784)

Utilizator AuditaAlladin Audita Data 21 martie 2011 17:54:35
Problema Text Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.89 kb
program fainut;
var fin,fout:text;
    s:string;
    k,i,j,suma,m,afis:byte;
begin
      assign(fin,'text.in');reset(fin);
      assign(fout,'text.out');rewrite(fout);
      readln(fin,s);
      suma:=0;
      i:=1;
      while i<=length(s) do
        begin
        if (upcase(s[i])>='A') and (upcase(s[i])<='Z') then
                begin
                     k:=1;
                     j:=i+1;
                     while (upcase(s[j])>='A') and (upcase(s[j])<='Z') do
                             begin
                             inc(j);
                             inc(k);
                             end;
                     suma:=suma+k;
                     if k>=2 then inc(m);
                     i:=i+k;
                end
        else inc(i);
        end;

      afis:=suma div m;
      writeln(fout,afis);
      close(fin);
      close(fout);
      end.