Cod sursa(job #505744)

Utilizator vendettaSalajan Razvan vendetta Data 3 decembrie 2010 20:06:24
Problema Text Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.94 kb
var
   f,g:text;
   cuv:array[1..20000]of string;
   ncuv,i,sol:integer;
   s:string;
begin
    assign(f,'text.in');reset(f);
    assign(g,'text.out');rewrite(g);
    ncuv:=0;
    while not seekeof(f) do
        begin
            readln(f,s);
            if s='' then continue;
            while s[1]=' ' do delete(s,1,1);
            while s[length(s)]=' ' do delete(s,length(s),1);
            i:=pos(' ',s);
            while i<>0 do
                begin
                    inc(ncuv);
                    cuv[ncuv]:=copy(s,1,i-1);
                    sol:=sol+length(cuv[ncuv]);
                    delete(s,1,i);
                    i:=pos(' ',s)
                end;
            inc(ncuv);
            cuv[ncuv]:=s;
            sol:=sol+length(cuv[ncuv]);
        end;
    {i:=1;
    repeat
        write(g,cuv[i],' ');
        inc(i);
    until i=ncuv;
     }
    write(g,trunc(sol/ncuv));
    close(f);close(g);
end.