Cod sursa(job #600805)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 3 iulie 2011 12:50:07
Problema Text Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.79 kb
program texte;
 var s:string;
    i,j,n,l,k:longint;
    fi,fo:text;
    c:char;
begin
 assign(fi,'text.in');
  reset(fi);
 assign(fo,'text.out');
  rewrite(fo);
 while not eof(fi) do begin
                       read(fi,c);
                       if c<>' ' then s:=s+c
                        else if c=' ' then begin
                         i:=1;
                         while i=1 do
                    if (s[i] in ['a'..'z','A'..'Z','0'..'9']) or (s='') then inc(i)
                                                        else
                   if (ord(s[i])<48) or (ord(s[i])>57) then delete(s,1,i);
                         i:=length(s);
                      while i=length(s) do
                        if (s[i] in ['a'..'z','A'..'Z','0'..'9']) or (s='') then inc(i)
                                                        else
                  if (ord(s[i])<48) or (ord(s[i])>57) then begin
                                                       delete(s,length(s),1);
                                                       dec(i);
                                                       end;
                    if length(s)>0 then
                          for i:=1 to length(s) do
                           if s[i] in ['a'..'z','A'..'Z'] then inc(l)
                            else
                            if (s[i]='-') and (s[i-1] in ['a'..'z','A'..'Z']) and (s[i+1] in ['a'..'z','A'..'Z']) then inc(j);
                        if l=length(s)-j then begin
                                                k:=k+l;
                                                if j>0 then
                                                           n:=n+1+j
                                                else if l>0 then inc(n);
                                                l:=0; j:=0;
                                                s:='';
                                                end
                        else begin
                              l:=0; j:=0;
                              s:='';
                              end;
                              end;
                       end;
 if (eof(fi)) and (length(s)>0) then begin
                         i:=1;
                         while i=1 do
                 if (s[i] in ['a'..'z','A'..'Z','0'..'9']) or (s='') then inc(i)
                                                        else
                   if (ord(s[i])<48) or (ord(s[i])>57) then delete(s,1,i);
                         i:=length(s);
                      while i=length(s) do
                        if (s[i] in ['a'..'z','A'..'Z','0'..'9']) or (s='') then inc(i)
                                                        else
                  if (ord(s[i])<48) or (ord(s[i])>57) then begin
                                                       delete(s,length(s),1);
                                                       dec(i);
                                                       end;
                    if length(s)>0 then
                          for i:=1 to length(s) do
                           if s[i] in ['a'..'z','A'..'Z'] then inc(l)
                            else
                            if (s[i]='-') and (s[i-1] in ['a'..'z','A'..'Z']) and (s[i+1] in ['a'..'z','A'..'Z']) then inc(j);
                        if l=length(s)-j then begin
                                                k:=k+l;
                                                if j>0 then
                                                           n:=n+1+j
                                                else if l>0 then inc(n);
                                                l:=0; j:=0;
                                                s:='';
                                                end;
                     end;
 write(fo,k div n);
 close(fo);
end.