COLLECT - VOI05 Bộ sưu tập

Tác giả: ladpro98

Ngôn ngữ: Pascal

program collect;
uses    math;
type    e=record
        a,b,c:longint;
        end;
        e2=record
        a,b,c,pa,pb,pc:longint;
        end;
const   fi='';
        maxn=100000;
var     s:e;
        q:array[1..maxn] of e;
        c:array[1..maxn] of e2;
        p:array[1..maxn] of e;
        avail:array[0..10,0..10,0..10] of boolean;
        res:array[0..10,0..10,0..10] of longint;
        k,la,lb,lc,d:longint;

procedure input;
var     inp:text;
        i,j,t:longint;
begin

        assign(inp,fi);reset(inp);
        readln(inp,k);
        readln(inp,s.a,s.b,s.c,la,lb,lc);
        i:=0;
        while not eof(inp) do
        begin
                inc(i);
                readln(inp,c[i].a,c[i].b,c[i].c,c[i].pa,c[i].pb,c[i].pc);
        end;
        d:=i;
        for i:=0 to 4 do
        for j:=0 to 4 do
        for t:=0 to 4 do
        avail[i,j,t]:=true;
        close(inp);
end;

function isValue(x:e):boolean;
begin
        exit((x.a>=la) and (x.b>=lb) and (x.c>=lc));
end;


procedure bfs;
var     i,l,r:longint;
        u,v:e;
begin
        l:=1;r:=1;
        q[1]:=s;
        res[s.a,s.b,s.c]:=0;
        avail[s.a,s.b,s.c]:=false;
        while l<=r do
        begin
                u:=q[l];inc(l);
                if isValue(u) or (res[u.a,u.b,u.c]>=k) then continue;
                for i:=1 to d do
                begin
                        if (u.a>=c[i].a) and (u.b>=c[i].b) and (u.c>=c[i].c) then

                        begin
                                v.a:=u.a-c[i].a+c[i].pa;
                                v.b:=u.b-c[i].b+c[i].pb;
                                v.c:=u.c-c[i].c+c[i].pc;
                                if (v.a<=4) and (v.b<=4) and (v.c<=4)
                                and avail[v.a,v.b,v.c] then
                                begin
                                        avail[v.a,v.b,v.c]:=false;
                                        inc(r);
                                        q[r]:=v;
                                        res[v.a,v.b,v.c]:=res[u.a,u.b,u.c]+1;
                                end;
                        end;
                end;

        end;
end;

procedure output;
var     i,j,t,count:longint;
begin
        count:=0;
        for i:=la to 4 do
        for j:=lb to 4 do
        for t:=lc to 4 do
        if (not avail[i,j,t]) and (res[i,j,t]<=k)
        then
        begin
                inc(count);
                p[count].a:=i;
                p[count].b:=j;
                p[count].c:=t;
        end;
        if count=0 then write(-1) else
        begin
                writeln(count);
                for i:=1 to count do
                writeln(p[i].a,' ',p[i].b,' ',p[i].c,' ',res[p[i].a, p[i].b,p[i].c]);
        end;
end;

begin
        input;
        bfs;
        output;
end.

Download