一霎微雨洒庭轩

2007-08-22

地图四色问题 - [Algorithms]

版权声明：转载时请以超链接形式标明文章原始出处和作者信息及本声明
http://conoon.blogbus.com/logs/7858527.html

{问题描述：任何一张地图只要用四种颜色进行填涂，就可以保证相邻省份不同色}

program tt;
const num=20;
var a:array [1..num,1..num] of 0..1;
    s:array [1..num] of 0..4; {用1-4分别代表RBWY四种颜色;0代表末填进任何颜色}
    k1,k2,n:integer;
function pd(i,j:integer):boolean;{判断可行性：第I个省填上第J种颜色}
var k:integer;
begin
     for k:=1 to i-1 do   {一直从第一个省开始进行比较一直到I省减一的那个省，目的是对已经着色的省份来进行比较，因为>I的省还没                           有着色，比较没有意义，着色的顺序是先第一、二、三……I个省}
         if (a[i,k]=1) and (j=s[k]) then {省I和省J相邻且将填进的颜色和已有的颜色相同}
            begin
               pd:=false; {即不能进行着色}
               exit;   {退出当前函数}
            end;
     pd:=true;  {可以进行着色}
end;

procedure print;{打印结果}
var k:integer;
begin
      for k:=1 to n do{将数字转为RBWY串}
          case s[k] of
            1:write('R':4);
            2:write('B':4);
            3:write('W':4);
            4:write('Y':4);
          end;
      writeln;
end;

procedure try(i:integer);
var j:integer;
begin
     for j:=1 to 4 do
         if pd(i,j) then begin
                              s[i]:=j;
                              if i=n then print
                                 else try(i+1);  {对下一个省进行着色}
                              s[i]:=0;  {不能进行着色，将当前状态设置0，即不进行着色}
                          end;
end;

BEGIN
     write('please input city number: '); readln(n);
     writeln('please input the relation of the cities:');
     for k1:=1 to n do
     begin
          for k2:=1 to n do read(a[k1,k2]);  {A[K1，K2]=1表示省K1、K2相邻，为0就不相邻}
          readln;
     end;
     for k1:=1 to n do s[k1]:=0;  {把所有的颜色设置为0，即还没有进行着色}
     try(1);
END.