TRIBE - Bộ lạc

Tác giả: flashmt

Ngôn ngữ: Pascal

const maxn=51;
var a:array[0..maxn] of string;
    b,d,e,re:array[1..maxn] of longint;
    f:array[0..maxn,0..maxn,-1..maxn] of longint;
    n,x,y,z:longint;
    kq:ansistring;

procedure rf;
var i,t:longint;  c:char; code:integer; s:string;
begin
     readln(n);
     readln(x,y,z);
     for i:=1 to n do
     begin
          readln(a[i]);
          t:=pos(' ',a[i]);
          s:=copy(a[i],t+1,length(a[i])-t);
          delete(a[i],t,length(a[i])-t+1);
          val(s,b[i],code);
     end;
end;

procedure sort;
var i,j,t:longint; p:string;
begin
     for i:=1 to n-1 do
         for j:=i+1 to n do
             if a[i]<a[j] then
             begin
                  p:=a[i]; a[i]:=a[j]; a[j]:=p;
                  t:=b[i]; b[i]:=b[j]; b[j]:=t;
             end;
end;

procedure calc;
var i,j:longint;
begin
     for i:=1 to n do
         for j:=1 to length(a[i]) do
             if a[i,j]='a' then inc(d[i])
             else inc(e[i]);
end;

procedure pr;
var i,j,k,p:longint;
begin
     sort;
     calc;
     f[0,0,-1]:=1;
     for i:=1 to n do
       for j:=d[i] to x do
         for k:=e[i] to y do
           for p:=0 to z do
             if (f[j-d[i],k-e[i],p-1]>0) and (f[j,k,p]<f[j-d[i],k-e[i],p-1]+b[i]) then
                f[j,k,p]:=f[j-d[i],k-e[i],p-1]+b[i];
end;

procedure att(j,k,p:longint);
var i,last:longint; s:ansistring;
begin
     fillchar(re,sizeof(re),0);
     last:=n;
     while p>=0 do
     begin
          for i:=last downto 1 do
              if (d[i]<=j) and (e[i]<=k) and (f[j,k,p]=f[j-d[i],k-e[i],p-1]+b[i]) then
              begin
                   inc(re[i]);
                   j:=j-d[i]; k:=k-e[i]; p:=p-1;
                   last:=i;
                   break;
              end;
     end;
     for i:=n downto 1 do
         for j:=1 to re[i] do
             s:=s+a[i]+' ';
     if s<kq then kq:=s;
end;

procedure trace;
var i,jj,kk,pp,j,k,p,last,res:longint;
begin
     kq:='z';
     res:=0;
     for j:=0 to x do
         for k:=0 to y do
             for p:=-1 to z do
                 if f[j,k,p]>res then
                    res:=f[j,k,p];
     for j:=0 to x do
         for k:=0 to y do
             for p:=-1 to z do
                 if f[j,k,p]=res then att(j,k,p);
     writeln(kq);
end;

begin
     rf;
     pr;
     trace;
end.

Download