Tô màu

(Tài liệu chưa được thẩm định)
Nguồn: sưu tầm
Người gửi: Huỳnh Đức Duy (trang riêng)
Ngày gửi: 15h:05' 13-01-2012
Dung lượng: 97.5 KB
Số lượt tải: 2
Số lượt thích: 0 người
Bài toán tô màu

Uses Crt;
Const Max = 20;
Fi = `Tomau0.inp`;
Var A : Array[1..Max,1..Max] of 0..1;
Mau,LMau : Array[1..Max] of Byte;
N,i : Integer;
Somauxudung,SoMauMax : Integer;

Procedure TaoF;
Var i,j,x : Byte;f : Text;
Begin
Assign(f,fi); Rewrite(f);
Randomize;
Writeln(f,Max);
n := Max;
For i:=1 to n-1 do
For j:=i+1 to n do
Begin
x := random(2);
If x =1 then Writeln(f,i:4,j:4);
End;
Close(f);
End;

Procedure NhapFile;
Var i,j : Integer;
F : Text;
Begin
FillChar(A,Sizeof(A),0);
Assign(F,Fi); Reset(F);
Readln(F,N);
While not Eof(F) do
Begin
Read(F,i);
While not eoln(F) do
Begin
Read(F,j);
A[i,j] := 1; A[j,i] := 1;
End;
Readln(F);
End;
End;

Procedure Hien;
Var i,j : Integer;
Begin
Writeln;
For i:=1 to N do
Begin
For j:=1 to N do Write(A[i,j]:4);
Writeln;
End;
End;

Procedure Khoitri;
Begin
FillChar(Mau,sizeof(Mau),0);
SoMauMax := N;
Somauxudung := 1;
Mau[1] := 1;
End;

Function Kt(x,m : Integer): Boolean;{ Mau m gan cho dinh x }
Begin
For i:=1 to N do
If (A[x,i]=1) and (m=Mau[i]) then
Begin Kt := False;Exit;End;
Kt := True;
End;

Procedure Tomau(x : Integer); { To mau cho dinh x }
Var m,luu,Luumaux : Integer;
Begin
If x=N+1 then
Begin
LMau := Mau;
SoMauMax := Somauxudung;
Exit
End;
m := 1;
While m<=SoMauMax do
Begin
If (KT(x,m)) then
Begin
LuuMaux := Mau[x];
Mau[x] := m;
Luu := Somauxudung;
If Somauxudung Tomau(x+1);
Somauxudung := Luu;
Mau[x] := LuuMaux;
End;
Inc(m);
End;
End;

Procedure Thongbao;
Var i : Integer;
Begin
For i:=1 to N do
Writeln( ` Diem `,i:2,` to mau : `,LMau[i]);
End;

BEGIN
Clrscr;
{ TaoF;}
NhapFile;
Hien;
Khoitri;
Tomau(2);
Thongbao;
END.


Cách 2 : Greedy tô màu đỉnh nào có bậc cao trước

Uses Crt;
Const Max = 100;
Fi = `Tomau3.inp`;
Fo = `Tomau.out`;
Type KM = Array[1..Max] of Byte;
KA = Array[1..Max,1..Max] of 0..1;
Var M,B,L: KM;
A : KA;
N : Byte;

Procedure NhapF;
Var i,j : Byte;
F : Text;
Begin
Assign(F,Fi);
{$I-}Reset(F);{$I+}
If IoResult<>0 then
Begin
Writeln(`Loi File `,Fi);
Readln;
Halt;
End;
Readln(F,N);
For i:=1 to N do
For j:=1 to N do A[i,j] := 0;
For