Cod sursa(job #20301)

Utilizator VmanDuta Vlad Vman Data 20 februarie 2007 23:52:02
Problema Tricouri Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.79 kb
program tricouri;
type stiva=array[1..5]of longint;
var n,k,p,i,x,m,max,r,j,jj:longint;
    a:array[0..20,0..19,0..5]of longint; {a[i][j] da restul j prin impartirea la i}
    f,g:text;
    st:stiva;

procedure cauta(nivel,poz:integer;st:stiva;nr:longint);
var i:integer;
begin
if nivel=k+1 then begin
                  if (nr mod p=0)and(nr>max) then max:=nr;
                  exit;
                  end;
if poz<=a[p][st[nivel-1]][0] then
                                begin
                                st[nivel]:=st[nivel-1];
                                cauta(nivel+1,poz+1,st,nr+a[p][st[nivel]][poz]);
                                end;
for i:=st[nivel-1]+1 to p-1 do
    if a[p][i][0]>0 then
    begin
    st[nivel]:=i;
    cauta(nivel+1,2,st,nr+a[p][st[nivel]][1]);
    end;
end;

begin
assign(f,'tricouri.in');reset(f);
assign(g,'tricouri.out');rewrite(g);
readln(f,n,m);
for i:=1 to n do begin
    read(f,x);
    for j:=1 to 20 do begin
        r:=x-(x div j)*j;
        if a[j][r][0]<5 then begin
                             inc(a[j][r][0]);
                             a[j][r][a[j][r][0]]:=x;
                             end;
                             jj:=a[j][r][0];
                             while (a[j][r][jj]<=x)and(jj>1) do
                                   begin
                                   a[j][r][jj]:=a[j][r][jj-1];
                                   dec(jj);
                                   end;
                             a[j][r][jj]:=x;
    end;
end;
readln(f);
for j:=1 to m do begin
    readln(f,k,p);
    max:=-1;
    for i:=0 to p-1 do
        if a[p][i][0]>0 then
           begin
           st[1]:=i;
           cauta(2,2,st,a[p][i][1]);
           end;
    writeln(g,max);
end;
close(f);
close(g);
end.