http://acm.pku.edu.cn/JudgeOnline/problem?id=1123

Код:
type
acust=record
      w,p:longint;
      end;
{blank record...?}
var
ti,tn,i,j,k,a,m,n:integer;
minc,maxc,bb,bpr,bco,bp,bs,bf,bc,npr,np,ns,nc:longint;
mask:array[0..31] of longint;
cost:array[1..20] of longint;
cust:array[1..20] of acust;
fb:boolean;

  procedure search(const nb,nn,nco,nf:longint);
    begin
    if nn>n then
      begin
      if (nco<minc) or (nco>maxc) then exit;
      npr:=0;
      nc:=0;
      for i:=1 to m do
        with cust[i] do
          if (nb and w)=w then
            begin
            inc(npr,p);
            inc(nc);
            end;
      np:=round(npr/nco*1000);
      if np<bp then exit;
      ns:=npr-nco;
      if (np=bp) and (ns<bs) then exit;
      if (np=bp) and (ns=bs) and (nf>bf) then exit;
      if (np=bp) and (ns=bs) and (nf=bf) and (nc<=bc) then exit;
      bp:=np;
      bs:=ns;
      bf:=nf;
      bc:=nc;
      bb:=nb;
      bpr:=npr;
      bco:=nco;
      exit;
      end;
    if nco>maxc then exit;
    search(nb or mask[nn],succ(nn),nco+cost[nn],succ(nf));
    search(nb,succ(nn),nco,nf);
    end;

begin
for i:=0 to 31 do
  mask[i]:=longint(1) shl i;
readln(tn);
for ti:=1 to tn do
  begin
  readln(minc,maxc,n,m);
  for i:=1 to n do
    readln(cost[i]);
  for i:=1 to m do
    with cust[i] do
      begin
      read(k);
      w:=0;
      for j:=1 to k do
        begin
        read(a);
        inc(w,mask[a]);
        end;
      readln(p);
      end;
  bb:=0;
  bp:=0;
  bs:=0;
  bf:=0;
  bc:=0;
  bpr:=0;
  bco:=0;
  search(0,1,0,0);
  writeln('Feature Set ',ti);
  writeln(bp/1000:0:3);
  writeln(bpr);
  writeln(bco);
  fb:=false;
  for i:=1 to n do
    if (bb and mask[i])<>0 then
      begin
      if fb then write(' ') else fb:=true;
      write(i);
      end;
  writeln;
  fb:=false;
  for i:=1 to m do
    with cust[i] do
      if (bb and w)=w then
        begin
        if fb then write(' ') else fb:=true;
        write(i);
        end;
  writeln;
  end;
end.