Описание
Дано прямоугольное клетчатое поле M×N клеток. Каждая клетка поля покрашена в один из шести цветов, причем левая верхняя и правая нижняя клетки имеют различный цвет. В результате поле разбивается на некоторое количество одноцветных областей: две клетки одного цвета, имеющие общую сторону, принадлежат одной области

Правила игры
Играют два игрока. За первым игроком закреплена область, включающая левую верхнюю клетку, за вторым - правую нижнюю. Игроки ходят по очереди. Делая ход, игрок перекрашивает свою область:

  1. в любой из шести цветов

  2. в любой из шести цветов, за исключением цвета своей области и цвета области противника

В результате хода к области игрока присоединяются все прилегающие к ней области выбранного цвета, если такие имеются. Если после очередного хода окажется, что области игроков соприкасаются, то игра заканчивается

Задание
Напишите программу, которая для каждого из пунктов (А и Б) определяет минимально возможное число ходов, по прошествии которых игра может завершиться.


Входные данные
Цвета пронумерованы цифрами от 1 до 6. Первая строка входного файла содержит целые числа M и N - размеры поля (1M,N50). Далее следует описание раскраски поля - M строк по N цифр (от 1 до 6) в каждой без пробелов. Первая цифра файла соответствует цвету левой верхней клетки игрового поля. 

Количество одноцветных областей не превосходит 50

Выходные данные
В выходной файл выведите искомое количество ходов для каждого из пунктов. Если ваша программа решает только один из пунктов, выведите произвольное целое число в качестве ответа на другой пункт


Например:

TOGOTO.IN
4 3
122
221
143
132

TOGOTO.OUT
3
4




Комментарии
Идеи и метод решения задачи авторами не комментировались


Решение

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+,Y+} 
{$M 65384,0,655360} 
{.$DEFINE DEBUG} 
 
program togoto; 
type table = array [0..51, 0..51] of integer; 
const dx : array [1..4] of integer = (1, -1, 0, 0); 
      dy : array [1..4] of integer = (0, 0, 1, -1); 
var t : table; 
    i, j : integer; 
    a_result, b_result : integer; 
    m, n : integer; 
    temp : string; 
    qx, qy, qc : array [1..2500]  of integer; 
    qh, qt : integer; 
 
function ok(a, b : integer): boolean; begin 
 ok := false; 
 if (a<1) or (a > m) or (b < 1 ) or (b > n) then exit; 
 ok := true; 
end; 
 
{Получаем и достаем из очереди}
function  put(a, b, c : integer) : boolean; 
begin 
  put := false; 
  if not ok(a, b) then exit; 
  put := true; 
  qx[qh] := a; qy[qh] := b; qc[qh] := c; 
  inc(qh); 
  if qh > 2500 then qh := 1; 
end; 
 
procedure get(var a, b, c : integer); 
begin 
  a := qx[qt]; b := qy[qt]; c := qc[qt]; 
  inc(qt); 
  if qt > 2500 then qt := 1; 
end; 
{-----------------------------------} 
 
function min (a, b : integer) : integer; 
begin 
 if a < b then min := a else min := b; 
end; 
 
procedure Fill(a, b, cur : integer; var l : table); 
procedure reFill(a, b : integer); 
var i : integer; 
begin 
   if not put(a, b, cur) then exit; 
  l[a][b] := cur; 
  for i := 1 to 4 do 
    if (l[a  + dx[i]][b+dy[i]] = 16448) 
    and (t[a][b] = t[a+dx[i]][b+dy[i]]) then reFill(a + dx[i], b + dy[i]); 
end; 
begin 
 ReFill(a, b); 
end; 
 
procedure find(sa, sb : integer; Var l : table); 
var cur : integer; 
    i, a,b, c : integer; 
 
begin 
    cur := 0; 
   fill(sa, sb, 0, l); 
   while qt <> qh do begin 
     get(a, b, c); 
     for i := 1 to 4 do 
      if l[a  + dx[i] ] [ b + dy[i]] = 16448 then 
       fill(a + dx[i], b + dy[i], c+1, l); 
   end; 
end; 
 
procedure solve_a; 
var 
  p1, p2 : table; 
  i, j, k : integer; 
begin 
 qh := 1; qt := 1; 
  a_result := maxint; 
  FillChar(p1, sizeof(p1), 64); 
  FillChar(p2, sizeof(p2), 64); 
 
  find(1, 1, p1); 
  find(m, n, p2); 
  for i := 1 to m do 
   for j := 1 to n do 
    for k := 1 to 4 do 
      case p1[ i ][ j ] - p2[ i + dx[k] ] [j + dy[k]] of 
       0, 1: a_result := min(p1[i][j] + p2[i+dx[k]] [j+dy[k]], a_result); 
      end; 
end; 
 
procedure solve_b; 
var area : Table; 
    cur : integer; 
    n_area : integer; 
    color  : array [1..50] of integer; 
    pl : array [1..2] of table; 
    lk : Table; 
    i,j,k,l, t : integer; 
 
procedure upd(var a : integer; b : integer); 
begin a:= min(a, b); end; 
 
label quit; 
begin 
  FillChar(area, sizeof(area), 64); 
  b_result := -1; cur := 0; 
 
  for i := 1 to m do 
   for j := 1 to n do begin 
      if area[i][j] = 16448 then  begin 
        inc(cur); 
        color[cur] := togoto.t[i][j]; 
        Fill(i, j, cur, area); 
      end; 
   end; 
  if cur > 50 then 
   begin writeln('Number of areas exceeds 50 (',cur,')'); 
         halt; 
   end; 
  qh := 1; qt := 1; 
  n_area := cur; 
  fillchar(lk, sizeof(lk), 0); 
 
  for i := 1 to m do 
    for j := 1 to n do 
     for k := 1 to 4 do 
      if ok(i+dx[k], j + dy[k]) then begin 
        lk[area[i][j]][area[i+dx[k]][j + dy[k]]] := 1; 
        lk[area[i+dx[k]][j + dy[k]]][area[i][j]] := 1; 
     end; 
 
  for i := 1 to n_area do lk[i][i] := 1; 
 
  FillChar(pl, Sizeof(pl), 64); 
  pl[1][1][area[m][n]] := 0; 
  pl[2][1][area[m][n]] := 1; 
 
  for T := 0 to 2500 do 
   for i := 1 to n_area do 
    for j := 1 to n_area do begin 
 
       if (pl[1][i][j] = T) and (lk[i][j]=1) then 
          begin b_result := pl[1][i][j]; goto quit; end; 
 
       if (pl[2][i][j] = T) and (lk[i][j]=1) then 
          begin b_result := pl[2][i][j]; goto quit; end; 
 
       if pl[1][i][j] = T then  begin 
         for k := 1 to n_area do 
           if (lk[i][k]=1) then begin 
            if color[k]<>color[j] then upd(pl[2][k][j], T+1) 
               else  
for l := 1 to n_area do 
                   if lk[j][l]=1 then upd(pl[2][k][l], T+3); 
           end; 
       end; 
 
       if pl[2][i][j] = T then begin 
         for k := 1 to n_area do 
           if (lk[j][k]=1) then begin 
            if color[k]<>color[i] then upd(pl[1][i][k], T+1) 
            else 
             for l := 1 to n_area do 
               if lk[i][l]=1 then upd(pl[1][l][k], T+3); 
           end; 
       end; {if} 
 
    end; {for j} 
quit: 
 asm nop; end; 
end; 
 
Begin 
  assign(input, 'togoto.in'); reset(input); 
  readln(m, n); 
 
  for i := 1 to m do begin 
    readln(temp); 
    for j := 1 to n do t[i][j] := ord(temp[j]) - ord('0'); 
  end; 
 
  close(input); 
  assign(input, ''); reset(input); 
  solve_a; 
  solve_b; 
 
{$IFNDEF DEBUG} 
  assign(output, 'togoto.out'); rewrite(output); 
{$ENDIF DEBUG} 
  writeln(a_result); 
  writeln(b_result); 

close(input);close(output)
End.

© Особенности национальных задач по информатике