Cod sursa(job #772671)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 30 iulie 2012 14:17:27
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.05 kb
program sub;
type vect=array[0..1000] of integer;
var u,v:vect;
    n,x,j,k,i,s,suma:integer;
    f,g:text;
begin
assign(f,'numere.in');reset(f);
assign(g,'numere1.out');rewrite(g);
u[0]:=1;  suma:=0;
for i:=1 to 1000 do
                   u[i]:=0;

readln(f,n);
for i:=1 to n do
                 begin
                 read(f,x);
                j:=0;

for k:=0 to (i-1)*99 do
                   if u[k]>0 then begin
                                  j:=j+1;
                                  v[j]:=x+k;
                                  end;
for K:=1 to j do
              u[v[k]]:=u[v[k]]+1;
              end;
   for i:= 0 to 1000 do
                       if u[i]>0 then         begin
                       suma:=suma+u[i]*(u[i]-1) div 2;write(i,' ',u[i],'*');end;
if u[s]>-1 then
                 while u[s]<>0 do
                                 begin
                                 write(g,u[s],' ');
                                 s:=s-u[s];
                                 end;
write(g,suma);
close(f);
close(g);
END.