Question

Có N khối đá hình hộp chữ nhật. Người ta muốn xây một cái tháp bằng cách chồng các khối đá này lên nhau. Để đảm bảo an toàn, các khối đá được đặt theo nguyên tắc:

+ Chiều cao của mỗi khối là kích thước nhỏ nhất trong ba kích thước

+ Các mép của các khối đươc đặt song song với nhau sao cho không có phần nào của khối nằm trên bị chìa ra ngoài so với khối nằm dưới.

Hãy tìm phương án xây dựng để tháp đạt được độ cao nhất.

Dữ liệu vào: Cho trong file TOWN.INP:

• Dòng đầu tiên là số N
• N dòng tiếp, mỗi dòng ghi 3 số nguyên dương là kích thước của một khối đá. Các khối đá đươc đánh số từ 1 theo trình tự xuất hiện trong file.

Kết quả: ghi ra file TOWN.OUT:

• Dòng thứ nhất ghi số M là số lượng khối đá dùng để xây tháp
• M dòng tiếp theo ghi các khối xếp từ đáy tháp lên đỉnh tháp, mỗi dòng gồm 4 số theo thứ tự K a b c, trong đó K là số hiệu khối đá, a là kích thước chọn làm đáy nhỏ, b là kích thước chọn làm đáy lớn, c là kích thước chọn làm chiều cao.

Các số trên một dòng trong các file được ghi cách nhau ít nhất một dấu cách. Giới hạn số khối đá không quá 5000 và các kích thước của các khối đá không quá 255.

Ví dụ:

TOWN.INP	TOWN.OUT
9 7 5 5 4 4 8 1 1 5 4 2 2 5 1 5 4 2 7 2 9 2 1 3 3 5 5 5	4 1 5 7 5 9 5 5 5 5 5 5 1 4 2 4 2

Answer 1

{*********************************************************************
* Program     :  TOWN    *
*********************************************************************}

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}

uses crt;

const
   tfi='TOWN.INP';
   tfo='TOWN.OUT';
   NN=5000;
   maxN=5000;

type
   HH=record  name: integer; c: array[1..3] of byte; end;

var
   fi,fo: text;
   N: integer;
   Khoi: array[1..maxN] of HH;
   a: array[1..maxN] of LongInt;
   Tr: array[1..maxN] of integer;
   slx: integer;
   x: array[1..maxN] of LongInt absolute a;
   Hmax: LongInt;

procedure Sinhdl;
var ch: char;
    i: integer;
    u1,u2,u3: byte;
begin
   clrscr;
   writeln('Ban co tao file ',tfi,' (C/K)?');
   repeat ch:=readkey until upcase(ch) in ['C','K'];
   if upcase(ch)='K' then exit;
   randomize;
   N:=NN;
   assign(fi,tfi); rewrite(fi);
   writeln(fi,N);
   for i:=1 to N do
      begin
         u1:=random(200)+1;
         u2:=random(200)+1;
         u3:=random(200)+1;
         writeln(fi,u1,' ',u2,' ',u3);
      end;
   close(fi);
end;

procedure Docdl;
var i,k,l: integer;
    tg: byte;
begin
   assign(fi,tfi); reset(fi);
   readln(fi,N);
   for i:=1 to N do
      with khoi[i] do
         begin
            name:=i;
            read(fi,c[1],c[2],c[3]);
            for k:=1 to 2 do
               for l:=k+1 to 3 do
                   if c[k]r do inc(i);
      while DienTich(j)a[i]) then
            begin
               a[i]:=a[j]+Khoi[i].c[3];
               Tr[i]:=j;
            end;
      end;
end;

procedure XLB;
var u,i: integer;
begin
   u:=1;
   for i:=2 to n do
      if a[i]>a[u] then u:=i;
   Hmax:=a[u];
   slx:=0;
   repeat
      inc(slx);
      x[slx]:=u;
      u:=Tr[u];
   until u=-1;
end;

procedure Inkq;
var i: integer;
begin
   assign(fo,tfo); rewrite(fo);
   writeln(fo,slx);
   for i:=slx downto 1 do
    with Khoi[x[i]] do
       writeln(fo,name,' ',c[2],' ',c[1],' ',c[3]);
   close(fo);
end;

BEGIN
   {Sinhdl;}
   Docdl;
   XDB;
   XLB;
   Inkq;
END.