Chào mừng quý vị đến với Trang TIN HỌC - VĂN HỌC
Quý vị chưa đăng nhập hoặc chưa đăng ký làm thành
viên, vì vậy chưa thể tải được các tài liệu của
Thư viện về máy tính của mình.
Nếu chưa đăng ký, hãy nhấn vào chữ ĐK thành viên ở phía bên trái, hoặc xem phim hướng dẫn tại đây
Nếu đã đăng ký rồi, quý vị có thể đăng nhập ở ngay phía bên trái.
Nếu chưa đăng ký, hãy nhấn vào chữ ĐK thành viên ở phía bên trái, hoặc xem phim hướng dẫn tại đây
Nếu đã đăng ký rồi, quý vị có thể đăng nhập ở ngay phía bên trái.
Tin Tức Trong Ngày
Tô màu

- 0 / 0
(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
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
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
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
 

















Các ý kiến mới nhất