Cod sursa(job #19062)

Utilizator izso88istvan zsolt izso88 Data 18 februarie 2007 18:41:51
Problema Ghiozdan Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.78 kb
const gmaxc=50000;
      nmaxc=200;

var tomb:array[0..gmaxc,0..nmaxc] of word;
    hany:array[1..nmaxc] of word;
    t:text;
    N,G,i,j,co,u:longint;


begin
     assign(t,'ghiozdan.in');
     reset(T);
      read(t,N);
      read(t,G);
      co:=1;
      read(t,tomb[0,1]);
      hany[1]:=1;

      for i:=2 to n do begin
                       read(t,j);
                       if j=tomb[0,1] then inc(hany[co]) else
                       begin
                       inc(co);
                       hany[co]:=1;
                       tomb[0,co]:=j;
                       end;
                       end;
     closE(T);

     for i:=1 to gmaxc do for j:=1 to nmaxc do tomb[i,j]:=0;

     for i:=1 to g do begin

       j:=0;
       while (j<n) and ((tomb[i,0]>2) or (tomb[i,0]=0)) do
        begin
        inc(j);
         co:=i-tomb[0,j];

         if co>0 then begin if (tomb[co,j]<hany[j]) and (tomb[co,0]>0) then
                        if ((tomb[co,0]+1)<tomb[i,0]) or (tomb[i,0]=0) then
                       begin
                        for u:=0 to n do tomb[i,u]:=tomb[co,u];
                         tomb[i,j]:=tomb[i,j]+1;
                         inc(tomb[i,0]);
                       end;
         end
         else
         if co=0 then  begin
                        for u:=0 to n do tomb[i,u]:=0;
                         tomb[i,j]:=1;
                         inc(tomb[i,0]);
                       end;


        end;
     end;

     u:=g;
     while tomb[u,0]=0 do u:=u-1;
     assign(t,'ghiozdan.out');
     rewrite(T);
      write(t,u,' ');
      writeln(t,tomb[u,0]);
      for i:=1 to n do
       if tomb[u,i]>0 then
        for j:=1 to tomb[u,i] do
                          writeln(t,tomb[0,i]);
     close(t);


end.