Cod sursa(job #26329)

Utilizator adrianraduleaRadulea Adrian adrianradulea Data 5 martie 2007 14:39:25
Problema Tricouri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.57 kb
var f,g:text;
    n:3..300000;
    i,j:1..300000;
    m:3..100;
    kk,k:1..5;
    p:2..20;
    x:1..1000000;
    a:array[1..300000] of 1..1000000;
    st:array[1..5] of 0..5;
    s,max:longint;
    as,ev:boolean;
procedure init;
begin
st[k]:=0;
end;
procedure succesor;
begin
if st[k]<n then begin
  st[k]:=st[k]+1;
  as:=true;
end
            else as:=false;
end;
procedure valid;
begin
ev:=true;
for i:=1 to k-1 do if st[k]=st[i] then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=k=kk;
end;
procedure tipar;
begin
s:=0;
for i:=1 to k do s:=s+a[st[i]];
if s>max then if s mod p=0 then max:=s;
end;
begin
assign(f,'tricouri.in'); reset(f);
assign(g,'tricouri.out'); rewrite(g);
read(f,n,m);
readln(f);
for i:=1 to n do read(f,a[i]);
readln(f);
for i:=1 to n-1 do
  for j:=1 to n do
    if a[i]<a[j] then begin
      x:=a[i];
      a[i]:=a[j];
      a[j]:=x;
    end;
for i:=1 to m do begin
  read(f,kk,p);
  readln(f);
  k:=1;
  init;
  s:=0;
  max:=0;
  while k>0 do begin
    repeat
      succesor;
      if as then valid;
    until (not as) or (as and ev);
    if as then if solutie(k) then begin
                                    tipar;
                                    break;
                                  end
                             else begin
                               k:=k+1;
                               init;
                             end
          else k:=k-1;
  end;
  if max<>0 then write(g,max)
            else write(g,'-1');
  writeln(g);
end;
close(g);
end.