Cod sursa(job #18620)

Utilizator maria_pparcalabescu maria daniela maria_p Data 18 februarie 2007 12:48:10
Problema Tricouri Scor 20
Compilator fpc Status done
Runda preONI 2007, Runda 2, Clasa a 9-a si gimnaziu Marime 2.37 kb
var f,g:text;
    n,m,k,p,j,l,i,s1,q,w:longint;
    s,nr:array[0..1500000]of integer;
    a,b:array[1..300000]of longint;
    e:array[1..300000,0..6]of string[6];
    ok:boolean;
    u:integer;

procedure interclasare(st,dr,mij:longint);
var q:longint;
begin
for i:=st to dr do
    b[i]:=a[i];
k:=st-1;
i:=st;j:=mij+1;
while (i<=mij)and(j<=dr)do
      if b[i]<b[j] then begin
                        inc(k);
                        a[k]:=b[j];
                        inc(j);
                        end
                   else begin
                        inc(k);
                        a[k]:=b[i];
                        inc(i);
                        end;
for q:=i to mij do
    begin
    inc(k);
    a[k]:=b[q];
    end;
for q:=j to dr do
    begin
    inc(k);
    a[k]:=b[q];
    end;
end;

procedure sort(st,dr:longint);
var mij:longint;
begin
if st<dr then begin
              mij:=(st+dr)div 2;
              sort(st,mij);
              sort(mij+1,dr);
              interclasare(st,dr,mij);
              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
    read(f,a[i]);
sort(1,n);
for i:=1 to m do
    begin
    readln(f,k,p);
    for j:=1 to n do
        b[j]:=a[j] mod p;
    s[0]:=1;s[1]:=0;nr[1]:=0;
    ok:=true;j:=1;
    while ok and (j<=n)do
          begin
          for l:=1 to s[0] do
              if nr[l]<=k-1 then begin
              inc(s[0]);
              s[s[0]]:=s[l]+b[j];nr[s[0]]:=nr[l]+1;
              val(e[l,0],w,u);
              for q:=1 to w do e[s[0],q]:=e[l,q];
              str(w+1,e[s[0],0]);
              str(j,e[s[0],w+1]);
              if (s[s[0]]mod p=0)and(nr[s[0]]=k)then begin
                                                     ok:=false;
                                                     break;
                                                     end;
              end;
          inc(j);
          end;
    if not ok then begin
                   s1:=0;
                   val(e[s[0],0],w,u);
                   for j:=1 to w do
                       begin
                       val(e[s[0],j],q,u);
                       s1:=s1+a[q];
                       end;
                   writeln(g,s1);
                   end
              else writeln(g,'-1');
    end;
close(f);
close(g);
end.