Tµi liÖu «n tËp chuyªn tin 11 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; 1 Tµi liÖu «n tËp chuyªn tin 11 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; 2 Tµi liÖu «n tËp chuyªn tin 11 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'; Fo = 'Tomau.out'; 3 Tµi liÖu «n tËp chuyªn tin 11 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 4 Tài liệu ôn tập chuyên tin 11 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; Chapnhan := True; 5 Tµi liÖu «n tËp chuyªn tin 11 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. 6 . 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;