//
you're reading...
Bài tập huấn luyện, Chủ đề đồ thị (Graph)

Bài tập huấn luyện: Tô màu bản đồ

[Bộ đề huấn luyện về chủ đề đồ thị]


Chuyên đề Đồ thị – Bài 1


Đề bài


Bản đồ của một đất nước có dạng hình chữ nhật M x N ô. Đất nước này được chia làm nhiều vùng, một vùng là tập các ô có chung cạnh liên thông với nhau và được đánh cùng một số trên bản đồ. Biết rằng số vùng không vượt quá 200.

Ví dụ: Bản đồ có kích thước 3 x 4 và chia làm 4 vùng như hình vẽ:

1 1 9 9

2 1 9 2

2 1 9 2

Hãy tìm cách tô màu bản đồ sao cho mỗi vùng có một màu và hai vùng tiếp giáp nhau (hai vùng có ít nhất một cạnh chung) không được tô cùng màu. Tìm cách tô với số màu ít nhất.

Dữ liệu vào trong file BANDO.IN có dạng:

  • Dòng đầu la 2 số nguyên M, N (M, N £50)
  • M dòng tiếp theo, mỗi dòng N số thể hiện bản đồ (các số thuộc kiểu integer).

Kết quả: ra file BANDO.OUT có dạng:

  • Dòng đầu ghi K là số màu tô ít nhất tìm được
  • M dòng sau, mỗi dòng N số thể hiện cách tô màu bản đồ (dùng các màu từ 1 đến K)

Ví dụ:

BANDO.IN BANDO.OUT
3 4

1 1 9 9

2 1 9 2

2 1 9 2

2

1 1 2 2

2 1 2 1

2 1 2 1

 


Hướng dẫn


[]


Chương trình


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

const          max       = 200;
maxx      = 50;
chon      = ‘0’;
fi        = ‘BANDO.in’ + chon;
fo        = ‘BANDO.ou’ + chon;
tx        : array[1..4]of shortint=(0,-1,0,1);
ty        : array[1..4]of shortint=(-1,0,1,0);

var            a         : array[1..maxx,1..maxx]of integer;
d         : array[1..maxx,1..maxx]of byte;
w         : array[1..max,1..max]of byte;
ten,bac,na: array[1..max]of byte;
mau,lmau  : array[1..max]of byte;
m,n,sv    : integer;
sm,lsm    : integer;

procedure docf;
var  f    :text;
i,j  :integer;
begin
assign(f,fi);
reset(f);
readln(f,m,n);
for i:=1 to m do
for j:=1 to n do read(f,a[i,j]);
close(f);
end;

procedure loang(x,y:byte);
var  k,u,v   :byte;
begin
d[x,y]:=sv;
for k:=1 to 4 do
begin
u:=x+tx[k];v:=y+ty[k];
if (u>0)and(v>0)and(u<=m)and(v<=n)then
if (d[u,v]=0)and(a[u,v]=a[x,y])then loang(u,v);
end;
end;

procedure trao(var u,v:byte);
var coc :byte;
begin
coc:=u;u:=v;v:=coc;
end;

procedure init;
var i,j,k,l:byte;
bb,bmax:shortint;
begin
sv:=0;
fillchar(d,sizeof(d),0);
fillchar(w,sizeof(w),0);
for i:=1 to m do
for j:=1 to n do
if d[i,j]=0 then
begin
inc(sv);
loang(i,j);
end;
for k:=1 to sv do ten[k]:=k;

for i:=1 to m do
for j:=1 to n-1 do
if d[i,j]<>d[i,j+1] then
begin
w[d[i,j],d[i,j+1]]:=1;
w[d[i,j+1],d[i,j]]:=1;
end;

for i:=1 to m-1 do
for j:=1 to n do
if d[i,j]<>d[i+1,j] then
begin
w[d[i,j],d[i+1,j]]:=1;
w[d[i+1,j],d[i,j]]:=1;
end;

fillchar(bac,sizeof(bac),0);
for i:=1 to sv-1 do
for j:=i+1 to sv do
if w[i,j]=1 then begin inc(bac[i]);inc(bac[j]);end;

for i:=1 to sv-1 do
for j:=i+1 to sv do
if bac[ten[i]]<bac[ten[j]] then trao(ten[i],ten[j]);

for k:=2 to sv-1 do
begin
bmax:=-1;
for i:=k+1 to sv do
begin
bb:=0;
for j:=1 to k-1 do inc(bb,w[ten[i],ten[j]]);
if bb>bmax then begin bmax:=bb;l:=i;end;
end;
trao(ten[k],ten[l]);
end;
lsm:=5;
sm:=1;
mau[1]:=1;
end;

function check(i,j:byte):boolean;
var k    :byte;
begin
check:=false;
for k:=1 to i-1 do
if (w[ten[k],ten[i]]=1)and(mau[k]=j) then exit;
check:=true;
end;

procedure toiuu;
begin
if sm<lsm then
begin
lsm:=sm;lmau:=mau;
end;
end;

procedure try(i:byte);
var j     :byte;
begin
if sm>=lsm then exit;

for j:=1 to sm do
if check(i,j) then
begin
mau[i]:=j;
if i<sv then try(i+1) else toiuu;
end;

if sm<lsm-1 then
begin
inc(sm);
mau[i]:=sm;
if i<sv then try(i+1) else toiuu;
dec(sm);
end;
end;

procedure ghif;
var f     :text;
i,j,k :byte;
begin
for k:=1 to sv do na[ten[k]]:=k;
assign(f,fo);
rewrite(f);
writeln(f,lsm);
for i:=1 to m do
begin
for j:=1 to n do write(f,lmau[na[d[i,j]]],#32);
writeln(f);
end;
close(f);
end;

BEGIN
docf;
init;
if sv>1 then try(2)
else begin lsm:=sm;lmau:=mau;end;
ghif;
END.
4 4
1 1 3 4
5 1 7 8
5 1 1 8
5 6 6 8

3 3
1 2 3
4 5 6
7 8 9

10 10
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30

7 7
2 2 2 2 2 2 2
2 1 1 1 1 1 2
2 1 2 2 3 1 2
2 1 2 1 3 1 2
2 1 4 4 4 1 2
2 1 1 1 1 1 2
2 2 2 2 2 2 2

Advertisements

About pascalteacher

Trang thông tin Toán học và Tin học

Thảo luận

Không có bình luận

Trả lời

Mời bạn điền thông tin vào ô dưới đây hoặc kích vào một biểu tượng để đăng nhập:

WordPress.com Logo

Bạn đang bình luận bằng tài khoản WordPress.com Log Out / Thay đổi )

Twitter picture

Bạn đang bình luận bằng tài khoản Twitter Log Out / Thay đổi )

Facebook photo

Bạn đang bình luận bằng tài khoản Facebook Log Out / Thay đổi )

Google+ photo

Bạn đang bình luận bằng tài khoản Google+ Log Out / Thay đổi )

Connecting to %s

Các tác giả

Danh mục

Tháng Mười Hai 2016
H B T N S B C
« Th11   Th1 »
 1234
567891011
12131415161718
19202122232425
262728293031  

NCT Computer

Flickr Photos

surge

Edge of the Sun

JWL0043 Eagle..

More Photos

Thống kê

  • 137,017 lượt xem

pascalteacher.nct@gmail.com


Trang huấn luyện học sinh giỏi Tin học

%d bloggers like this: