http://acm.pku.edu.cn/JudgeOnline/problem?id=1184

Код:
program PKU1184;

const maxn = 6;
  maxm = 1 * 2 * 3 * 4 * 5 * 6 * 7;
  none = 10000000;

type integer = longint;
     node = array[0 .. 7] of integer;

var f: array[0 .. maxm - 1, 0..63] of integer;
    q: array[1 .. maxm * 64] of node;
    s, b, bit, data: node;
    ans, open, closed: integer;

function min(i, j: integer): integer;
begin
  if i < j then min := i else min := j;
end;

function num(var c: node): integer;
var i, j, tmp: integer;
begin
  tmp := 0;
  for i := 1 to 5 do
    for j := i + 1 to 6 do
    if c[j] < c[i] then tmp := tmp + data[c[i]];
  num := tmp + c[0] * data[7];
end;

function calc(var c: node): integer;
var i, tmp: integer;
begin
  tmp := 0;
  for i := 1 to 6 do if (s[c[i]] <> b[i]) and (c[7] and bit[c[i]] = 0) then exit(none)
  else tmp := tmp + abs(s[c[i]] - b[i]);
  calc := tmp;
end;

procedure prepare;
var i: integer;
    ch: char;
begin
  for i := 1 to 6 do bit[i] := 1 shl (i - 1);
  data[2] := 1;
  for i := 3 to 7 do data[i] := data[i - 1] * (i - 1);
  for i := 1 to 6 do begin
    read(ch);
    s[i] := ord(ch) - ord('0');
  end; read(ch);
  for i := 1 to 6 do begin
    read(ch);
    b[i] := ord(ch) - ord('0');
  end;
end;

procedure push(var c: node; dep: integer);
var k: integer;
begin
  k := num(c); c[7] := c[7] or bit[c[c[0]]];
  if f[k, c[7]] = 0 then begin
    f[k, c[7]] := dep;
    ans := min(ans, calc(c) + f[k, c[7]]);
    closed := closed + 1;
    q[closed] := c;
  end;
end;

var temp: integer;

procedure swap(var i, j: integer);
begin
  temp := i; i := j; j := temp;
end;

procedure main;
var t: integer;
    a, c: node;
begin
  fillchar(f, sizeof(f), 0);
  open := 0; closed := 1;
  for t := 1 to 6 do a[t] := t;
  a[0] := 1; a[7] := 1;
  q[1] := a; t := num(a);
  f[t, 1] := 1;
  ans := calc(a) + 1;
  while open < closed do begin
    open := open + 1;
    a := q[open]; t := num(a);
    if a[0] < 6 then begin
      c := a; c[0] := a[0] + 1;
      push(c, f[t, a[7]] + 1);
    end;
    if a[0] > 1 then begin
      c := a; c[0] := a[0] - 1;
      push(c, f[t, a[7]] + 1);
    end;
    c := a; swap(c[c[0]], c[1]);
    push(c, f[t, a[7]] + 1);
    c := a; swap(c[c[0]], c[6]);
    push(c, f[t, a[7]] + 1);
  end;
  writeln(ans - 1);
end;

begin
  prepare;
  main;
end.