Tô màu

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);

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<m then Somauxudung := m; 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';

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 i:=1 to N do B[i] := 0;

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;

Inc(B[i]); {Bậc của đỉnh i }

Inc(B[j]); {Bậc của đỉnh j }

End;

Readln(F);

End;

Close(F);

End;

Procedure HienL;

Var i : Byte;

Begin

Writeln;

For i:=1 to N do Write(L[i]:4);

End;

Procedure Sapxep; { Sắp xếp các đỉnh theo bậc của đỉnh }

Var coc,i,j : Byte;

Begin

For i:=1 to N do L[i] := i;

For i:=1 to N-1 do

For j:=i+1 to N do

If B[i]<B[j] then

Begin

coc := B[i];

B[i] := B[j];

B[j] := coc;

coc := L[i]; { L[i] là tên đỉnh thứ i sau khi sắp xếp } L[i] := L[j];

L[j] := coc;

End;

End;

Procedure Tomau;

Var i,d,mau : Byte;

Function Xong: Boolean;{Kiểm tra còn đỉnh nào cha đợc tô màu }

Var i : Byte;

Begin

Xong := False;

For i:=1 to N do

If M[i]=0 then Exit;

Xong := True;

End;

Function Chapnhan(j,i : Byte) : Boolean;

Var k : Byte;

Begin

Chapnhan := False;

For k:=j to i-1 do

If (A[L[k],L[i]]=1) and (M[L[k]]=mau) then Exit;

End;

Begin

For i:=1 to N do M[i] := 0;

d := 1;

mau := 0;

Repeat

Inc(mau);

M[L[d]] := mau;

For i:=d+1 to N do

If (A[L[d],L[i]]=0) then

If Chapnhan(d+1,i) then M[L[i]] := mau; While (M[L[d]]>0) and (d<N) do inc(d); Until xong;

Writeln('Somau = ',mau);

End;

Procedure HienM;

Var i : Byte;

Begin

Writeln;

For i:=1 to N do Write(i:4);

Writeln;

For i:=1 to N do Write(M[i]:4);

End;

BEGIN

Clrscr;

NhapF;

Sapxep;

Tomau;

HienM;

END.