Tin học Tây Sơn

Xếp hộp lồng nhau

Go down

Xếp hộp lồng nhau

Bài gửi by Admin on Sat Jan 05, 2019 4:47 pm

Bé Ri tuy còn nhỏ nhưng là một cô bé rất xinh xắn và chăm chỉ. Mẹ bé Ri là chủ một cửa hàng. Hàng ngày, cửa hàng của mẹ loại ra rất nhiều hộp giấy hình hộp chữ nhật. Bé Ri thường giúp mẹ xếp những hộp giấy này lồng vào nhau cho gọn.
Giả sử có N hộp giấy, các hộp được đánh số từ 1 đến N. Với mỗi hộp giấy, bé Ri biết được chính xác độ dài hai cạnh đáy của hộp là a và b.
Yêu cầu: Hãy giúp bé Ri xếp các hộp sao cho số lượng các hộp lồng vào nhau là lớn nhất.
Dữ liệu vào: Cho trong file văn bản XEPHOP.INP, có cấu trúc như sau:
- Dòng 1: Ghi số nguyên dương N, là số lượng hộp giấy. (1 ≤ N  ≤ 1000)
- N dòng tiếp theo: Mỗi dòng ghi hai số nguyên dương ai  bi, là độ dài hai cạnh đáy của hộp giấy thứ i.  (1 ≤ ai, bi ≤ 32767)
Dữ liệu ra: Ghi ra file văn bản XEPHOP.OUT theo cấu trúc như sau:
- Dòng 1: Ghi số nguyên dương M là số lượng các hộp giấy lồng nhau tìm được.
- Dòng 2: Ghi M số nguyên dương, là chỉ số của M hộp giấy theo thứ tự từ ngoài vào trong của một cách xếp hộp.
Ví dụ:
XEPHOP.INP
XEPHOP.OUT
5
1   5
5   7
6   4
3   6
2   5
 
3
2   3   5


Có ai còn nhớ cách tiếp cận lam tham cho bài toán này??? ưer
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Xếp hộp lồng nhau

Bài gửi by tonguyengiahan237 on Sun Jan 06, 2019 10:48 am

Code:
Program XEPHOP;
Uses    crt;
Type    Mang2c=array[1..50,1..50]of integer;
        Mang1c=array[1..50]of integer;
Var    N,Tong,e:integer;
        A:Mang2c;
        B,C:Mang1c;
        fi,fo:text;

Procedure Docdl;
Var i,j,k:integer;
Begin
Assign(fi,'XEPHOP.INP');
Reset(fi);
Readln(fi,N);
For i:=1 to N  do
For j:=1 to 2 do
        begin
        Read(fi,A[i,j]);
        B[i]:=i;
        end;
Close(fi);
End;

Function cv(i,j:integer):integer;
Begin
cv:=(i+j)*2;
End;

Procedure Doi(Var x,y:integer);
Var Tam:integer;
Begin
Tam:=x;
x:=y;
y:=Tam;
End;

Procedure Sx;
Var i,k:integer;
Begin
For i:=1 to N-1 do
For k:=i+1 to N do
        If cv(A[i,1],A[i,2])<cv(A[k,1],A[k,2]) then
                begin
                Doi(A[k,1],A[i,1]);
                Doi(A[k,2],A[i,2]);
                Doi(B[k],B[i]);
                end;
End;

Procedure loai;
Var T1,T2,k,i:integer;
Begin
Tong:=0;
T1:=32767;
T2:=32767;
k:=1;
For i:=1 to N do
        If (A[i,1]<T1) and (A[i,2]<T2) or (A[i,1]<T2) and (A[i,2]<T1) then
                begin
                Inc(Tong);
                C[k]:=B[i];
                inc(k);
                T1:=A[i,1];
                T2:=A[i,2];
                end;
End;

BEGIN
CLRSCR;
Docdl;
Sx;
Loai;
Assign(fo,'XEPHOP.OUT');
Rewrite(fo);
Writeln(fo,Tong);
For e:=1 to Tong do
Write(fo,C[e],' ');
Close(fo);
READLN;
END.
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Xếp hộp lồng nhau

Bài gửi by Admin on Sun Jan 06, 2019 5:02 pm

tonguyengiahan237 đã viết:
Code:
Program XEPHOP;
Uses    crt;
Type    Mang2c=array[1..50,1..50]of integer;
        Mang1c=array[1..50]of integer;
Var     N,Tong,e:integer;
        A:Mang2c;
        B,C:Mang1c;
        fi,fo:text;

Procedure Docdl;
Var i,j,k:integer;
Begin
Assign(fi,'XEPHOP.INP');
Reset(fi);
Readln(fi,N);
For i:=1 to N  do
For j:=1 to 2 do
        begin
        Read(fi,A[i,j]);
        B[i]:=i;
        end;
Close(fi);
End;

Function cv(i,j:integer):integer;
Begin
cv:=(i+j)*2;
End;

Procedure Doi(Var x,y:integer);
Var Tam:integer;
Begin
Tam:=x;
x:=y;
y:=Tam;
End;

Procedure Sx;
Var i,k:integer;
Begin
For i:=1 to N-1 do
For k:=i+1 to N do
        If cv(A[i,1],A[i,2])<cv(A[k,1],A[k,2]) then
                begin
                Doi(A[k,1],A[i,1]);
                Doi(A[k,2],A[i,2]);
                Doi(B[k],B[i]);
                end;
End;

Procedure loai;
Var T1,T2,k,i:integer;
Begin
Tong:=0;
T1:=32767;
T2:=32767;
k:=1;
For i:=1 to N do
        If (A[i,1]<T1) and (A[i,2]<T2) or (A[i,1]<T2) and (A[i,2]<T1) then
                begin
                Inc(Tong);
                C[k]:=B[i];
                inc(k);
                T1:=A[i,1];
                T2:=A[i,2];
                end;
End;

BEGIN
CLRSCR;
Docdl;
Sx;
Loai;
Assign(fo,'XEPHOP.OUT');
Rewrite(fo);
Writeln(fo,Tong);
For e:=1 to Tong do
Write(fo,C[e],' ');
Close(fo);
READLN;
END.
Cách tiệp cận bài này  ko phải theo chu vi, vì nếu chủ vi lo vd: 100 nhưng có hai cạnh lcạnh là 1x 100 thì ko thể chứa hình 2x3 được. 
Cách tiệp cận là: đếm số lượng hộp đó có thể chứa được. Hộp lần lượt chọn từ hộp có thể chứa nhiều nhất đến ít nhất. Để biết có thể chứa được hay không ta phải sợ sánh dài với davới dài, rộng với rộng (sắp xếp lại dữ liệu đầu vào theo dài rộng rồi mới mới sắp xếp tự hồ theo số lượng có khả năng chứa... Có j ko biết hỏi tiếp nhé.
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Xếp hộp lồng nhau

Bài gửi by mainhatthong2004 on Thu Jan 10, 2019 3:23 pm

thong:
program bai3;
uses crt;
var fi,fo:text;
a,b,c,vt:array[1..100] of integer;
n,i,tg,k,q,j,h:integer;
//---------------------------------------
procedure doi(var x,y:integer);
begin
tg:=x;
x:=y;
y:=tg;
end;
//-------------------------------------
procedure nhap;
begin
assign(fi,'XEPHOP.inp');
reset(fi);
readln(fi,n);
for i:=1 to n do
begin
read(fi,a[i]);
readln(fi,b[i]);
end;
close(fi);
end;
//-----------------------------------
procedure xl;
begin
assign(fo,'XEPHOP.out');
rewrite(fo);
k:=0;
for i:=1 to n do
begin
inc(k);
c[i]:=k;
end;
for i:=1 to n do
if a[i]>b[i] then
doi(a[i],b[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i] begin
doi(a[i],a[j]);
doi(b[i],b[j]);
doi(c[i],c[j]);
end;
i:=1; h:=1; q:=1;
while i begin
j:=i+h;
if b[i]>b[j] then
begin
vt[q]:=c[i];
inc(q);
i:=j;
h:=1;
end else
inc(h);
end;
writeln(fo,q-1);
for i:=1 to q-1 do
write(fo,vt[i],' ');
close(fo);
end;
//-----------------------------------
begin
clrscr;
nhap;
xl;
readln;
end.
avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 85
Reputation : -369988
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Xếp hộp lồng nhau

Bài gửi by tonguyengiahan237 on Fri Jan 11, 2019 9:46 pm

Code:
Program Xep_hop;
Uses crt;
Type Mang2c=array[1..50,1..50]of integer;
    Mang1c=array[1..50]of integer;
Var N,k,f:integer;
    A:Mang2c;
    B,v:Mang1c;
    fi,fo:text;

Procedure Docdl;
Var i,j:integer;
Begin
Assign(fi,'XEPHOP.INP');
Reset(fi);
Readln(fi,N);
For i:=1 to N do
For j:=1 to 2 do
begin
Read(fi,A[i,j]);
B[i]:=i;
end;
Close(fi);
End;

Procedure Doi(Var x,y:integer);
Var Tam:integer;
Begin
Tam:=x;
x:=y;
y:=Tam;
End;

Procedure d_r;
Var i:integer;
Begin
For i:=1 to N do
If A[i,1]>A[i,2] then Doi(A[i,1],A[i,2]);
End;

Function Dem(i,j,N:integer):integer;
Var k,h:integer;
Begin
Dem:=0;
For k:=1 to N do
If (A[k,1]<i) and(A[k,2]<j) then Dem:=Dem+1;
End;

Procedure Sx;
Var i,j:integer;
Begin
For i:=1 to N-1 do
For j:=i+1 to N do
        Begin
        If Dem(A[i,1],A[i,2],N) < Dem(A[j,2],A[j,2],N) then
                begin
                Doi(A[i,1],A[j,1]);
                Doi(A[i,2],A[j,2]);
                Doi(B[i],B[j]);
                end;
        If Dem(A[i,1],A[i,2],N) = Dem(A[j,2],A[j,2],N) then
                begin
                If (A[i,1]<A[j,1]) or (A[i,2]<A[j,2]) then
                        begin
                        Doi(A[i,1],A[j,1]);
                        Doi(A[i,2],A[j,2]);
                          Doi(B[i],B[j]);
                        end;
                end;
        End;
End;

Procedure Xuli;
Var T1,T2,i:integer;
Begin
v[1]:=B[1];
k:=2;
T1:=A[1,1];
T2:=A[1,2];
For i:=2 to N do
If (A[i,1]<T1) and (A[i,2]<T2) then
        begin
        v[k]:=B[i];
        inc(k);
        T1:=A[i,1];
        T2:=A[i,2];
        end;
End;

BEGIN
CLRSCR;
Docdl;
d_r;
Sx;
Xuli;
Assign(fo,'XEPHOP.OUT');
Rewrite(fo);
Writeln(fo,k-1);
For f:=1 to k-1 do
Write(fo,v[f],#32);
Close(fo);
READLN;
END.
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Xếp hộp lồng nhau

Bài gửi by mainhatthong2004 on Sat Jan 12, 2019 1:57 pm

thong:
program bai3;
uses crt;
var fi,fo:text;
a,b,c,vt,o,u,bb,vt2:array[1..100] of integer;
n,i,tg,k,q,j,h,s1,s2:integer;
//---------------------------------------
procedure doi(var x,y:integer);
begin
tg:=x;
x:=y;
y:=tg;
end;
//-------------------------------------
procedure nhap;
begin
assign(fi,'XEPHOP.inp');
reset(fi);
readln(fi,n);
for i:=1 to n do
begin
read(fi,a[i]);
readln(fi,b[i]);
end;
close(fi);
end;
//-----------------------------------
procedure xl;
begin
assign(fo,'XEPHOP.out');
rewrite(fo);
k:=0;
for i:=1 to n do
begin
o[i]:=a[i];
bb[i]:=b[i];
inc(k);
c[i]:=k;
u[i]:=k;
end;
for i:=1 to n do
if a[i]>b[i] then
doi(a[i],b[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i] begin
doi(a[i],a[j]);
doi(b[i],b[j]);
doi(c[i],c[j]);
end;
i:=1; h:=1; q:=1;
while i begin
j:=i+h;
if b[i]>b[j] then
begin
vt[q]:=c[i];
inc(q);
i:=j;
h:=1;
end else
inc(h);
end;
s1:=q-1;
//-----------------------------------------\\
for i:=1 to n do
if bb[i]>o[i] then
doi(bb[i],o[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if bb[i] begin
doi(bb[i],bb[j]);
doi(o[i],o[j]);
doi(u[i],u[j]);
end;
i:=1; h:=1; q:=1;
while i begin
j:=i+h;
if o[i]>o[j] then
begin
vt2[q]:=u[i];
inc(q);
i:=j;
h:=1;
end else
inc(h);
end;
s2:=q-1;
//----------------------------------------------\\
if s1>s2 then
begin
writeln(fo,s1);
for i:=1 to s1 do
write(fo,vt[i],' ');
end else
writeln(fo,s2);
for i:=1 to s2 do
write(fo,vt2[i],' ');
close(fo);
end;
//-----------------------------------
begin
clrscr;
nhap;
xl;
readln;
end.
avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 85
Reputation : -369988
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Xếp hộp lồng nhau

Bài gửi by Sponsored content


Sponsored content


Về Đầu Trang Go down

Về Đầu Trang


 
Permissions in this forum:
Bạn không có quyền trả lời bài viết