Cod sursa(job #18370)

Utilizator runnaway90Oprescu Radu Constantin runnaway90 Data 18 februarie 2007 11:47:00
Problema Tricouri Scor 20
Compilator fpc Status done
Runda preONI 2007, Runda 2, Clasa a 9-a si gimnaziu Marime 2.54 kb
var     a:array[1..200000]of longint;
        x:array[0..1000000]of longint;
        n,m,aux,i,j,s,k,p,r,t,numar,numar2:longint;
        f,g:text;
        ok:boolean;

begin
        assign(g,'tricouri.out');
        assign(f,'tricouri.in');
        reseT(f);
        rewrite(g);
                read(f,n,m);
                for i:=1 to n do
                        read(f,a[i]);
                for i:=1 to n-1 do
                for j:=i+1 to n do
                if a[i]<a[j] then
                begin
                        aux:=a[i];
                        a[i]:=a[j];
                        a[j]:=aux;
                end;
                for i:=1 to m do
                begin
                     read(f,k,p);
                     s:=0;numar2:=k;
                     for j:=1 to k do
                        s:=s+a[j];
                     while s mod p<>0 do
                        s:=s-1;
                     ok:=true;
                     while ok=true do
                   begin
                        ok:=false;
                     for j:=1 to s do
                         x[j]:=-1;
                         x[0]:=0;

                     for k:=1 to n do
                     begin
                        r:=0;
                        while r+a[k]<=s do
                        begin
                                if (x[r]>=0)and(x[r]<>k) then
                                begin
                                        t:=r+a[k];
                                        if x[t]=-1 then
                                                x[t]:=k;
                                end;
                             inc(r);
                        end;
                        if x[s]<>-1 then
                                break;
                     end;
                     if x[s]=-1 then
                     begin
                        ok:=true;
                        s:=s-p;
                     end
                     else
                     begin
                        k:=s;
                        numar:=0;
                        while k<>0 do
                        begin
                                inc(numar);
                                k:=k-a[x[k]];
                        end;
                        if numar=numar2 then
                                writeln(g,s)
                        else
                                writeln(g,-1);
                     end;
                  end;

                end;
        close(f);
        close(g);
end.