Cod sursa(job #18512)

Utilizator vanila0406Ionescu Victor vanila0406 Data 18 februarie 2007 12:30:10
Problema Tricouri Scor 0
Compilator fpc Status done
Runda preONI 2007, Runda 2, Clasa a 9-a si gimnaziu Marime 5.48 kb
program tricouri;
var v:array[1..100000] of longint;
        viz:array[1..1000000]of longint;
        f,g:text;
        n,m,k,p:longint;



procedure iofile;
var i:longint;
begin
        fillchar(viz,sizeof(viz),0);
        assign(f,'tricouri.in');
        reset(f);
        assign(g,'tricouri.out');
        rewrite(g);
        readln(f,n,m);
        for i:=1 to n do
                read(f,v[i]);
        readln(f);
end;



procedure pozitie(var m:longint;p,u:longint);
var i,j,di,dj,aux:longint;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
                begin
                        if v[i] <v[j] then
                                begin
                                        aux:=di;
                                        di:=-dj;
                                        dj:=-aux;
                                        aux:=v[i];
                                        v[i]:=v[j];
                                        v[j]:=aux;
                                end;{ else
                                if v[i] mod p=v[j] mod p then
                                        if v[i]<v[j] then
                                                begin
                                                        aux:=di;
                                                        di:=-dj;
                                                        dj:=aux;
                                                        aux:=v[i];
                                                        v[i]:=v[j];
                                                        v[j]:=aux;
                                                end; }
                        i:=i+di;
                        j:=j+dj;
                end;
        m:=i;
end;



procedure quick(p,u:longint);
var m:longint;
begin
        if p<u then
                begin
                        pozitie(m,p,u);
                        quick(p,m-1);
                        quick(m+1,u);
                end;
end;



procedure prel;
var i,j,k,s,l:longint;
        ok:boolean;
begin
        for l:=1 to m do
                begin
                        readln(f,k,p);
                        quick(1,n);
                        ok:=true;
                        if k mod 2=1 then
                                begin
                                        ok:=false;
                                        s:=0;
                                        for i:=1 to n do
                                        if v[i] mod p=0 then
                                                begin
                                                s:=s+v[i];
                                                viz[i]:=1;
                                                ok:=true;break; end;
                                        if not ok then writeln(g,'-1') else dec(k);
                                end;
                        if ok then
                                if k<>0 then
                                begin
                                        ok:=false;
                        for i:=1 to n-1 do
                                if ok then break else
                                for j:=i+1 to n do
                                        if (v[i] mod p+v[j] mod p)mod p=0
                                                then if (viz[i]=0)and(viz[j]=0)
                                                        then
                                                                begin
                                                                        ok:=true;
                                                                        s:=s+v[i]+v[j];
                                                                        break;
                                                                        {break;}
                                                                end;
                                        if not ok then writeln(g,'-1') else dec(k,2);
                                        if ok then
                                                if k<>0 then
                                                        begin

                                                        ok:=false;
                                                        for i:=1 to n-1 do
                                                                if ok then break else
                                                        for j:=i+1 to n do
                                                        if (v[i] mod p+v[j] mod p)mod p=0
                                                then if (viz[i]=0)and(viz[j]=0)
                                                        then
                                                                begin
                                                                        ok:=true;
                                                                        s:=s+v[i]+v[j];
                                                                        break;
                                                                        break;
                                                                end;
                                        if not ok then writeln(g,'-1') else writeln(g,s);
                                        end else writeln(g,s);
                                end else
                                writeln(g,s);
                end;
        close(g);
end;


begin
        iofile;
        prel;
end.