建立数学模型

　　初始状态设为对应女客，-1对应男客。
　　表演过程可以看成一个的矩阵，表示(i,j)上的客人表演，否则不表演。为了处理方便，矩阵外的格子中元素看成1。
　　一个人表演完后，其周围的八个人改变性别。因此，最后所有客人全为女客等价于
　　　　
　　可以得到个这样的方程。利用高斯消元法求解即可。

优化数学模型

　　可以看出，上述方法方程数目太多，复杂度很大。
　　首先确定第一行、第一列的元素，共2n-1个未知数。

　　　　　　　　　　　　　　　　　

　　将变形成。根据上式可以把第二行、第二列的元素写成含未知数的形式，然后再写出第三行、第三列的元素……以此类推，可以确定整个矩阵。最后，只需要把第n行、第n列的元素代入，得到2n-1个方程，再求解即可。这样方程数目大大减少，效率就比较高了。

参考程序

const
　fin = 'game.in';
　fout = 'game.out';
　base = 10000;
　maxn = 55;

type
　tvalue = array[0 .. maxn * 2] of byte;

var
　n : integer;
　m : array[0 .. maxn, 0 .. maxn] of tvalue;
　f : array[0 .. maxn, 0 .. maxn] of tvalue;
　equa : array[0 .. maxn * 2] of tvalue;
　last, result : integer;

procedure init;
　var
　i, j : integer;
　c : char;
begin
　assign(input, fin); reset(input);
　fillchar(m, sizeof(m), 0);
　readln(n);
　for i := 1 to n do begin
　　for j := 1 to n do begin
　　　read(c);
　　　if c = 'M' then m[i, j, 0] := 1;
　　end;
　　readln;
　end;
　close(input);
end;

procedure print;
var
　i : integer;
　s : longint;
begin
　assign(output, fout); rewrite(output);
　if result = -1 then
　　writeln(0)
　else begin
　　s := 1;
　　for i := 1 to result do
　　　s := s * 2 mod base;
　　writeln(s);
　end;
　close(output);
end;

function zero(var s : tvalue) : boolean;
var
　i : integer;
begin
　zero := false;
　for i := 0 to last do if s[i] <> 0 then exit;
　zero := true;
end;

procedure main;
var
　p, i, j, k : integer;
begin
　last := n * 2 - 1;
　fillchar(f, sizeof(f), 0);
　for i := 1 to n do f[1, i, i] := 1;
　for i := 2 to n do f[i, 1, i + n - 1] := 1;
　for i := 2 to n do
　　for j := 2 to n do
　　　for k := 0 to last do
　　　　f[i, j, k] := m[i - 1, j - 1, k] xor f[i, j - 1, k] xor f[i, j - 2, k] xor
　　　　　　　　　　f[i - 1, j, k] xor f[i - 1, j - 2, k] xor
　　　　　　　　　　f[i - 2, j, k] xor f[i - 2, j - 1, k] xor f[i - 2, j - 2, k];
　for i := 1 to n do
　　for j := 0 to last do
　　　equa[i, j] := m[i, n, j] xor f[i - 1, n, j] xor f[i + 1, n, j] xor
　　　　　　　　　　　f[i - 1, n - 1, j] xor f[i, n - 1, j] xor
　　　　　　　　　　　f[i + 1, n - 1, j];
　for i := 1 to n - 1 do
　　for j := 0 to last do
　　　equa[i + n, j] := m[n, i, j] xor f[n, i - 1, j] xor f[n, i + 1, j] xor
　　　　　　　　f[n - 1, i - 1, j] xor f[n - 1, i, j] xor f[n - 1, i + 1, j];
　result := last;
　for i := 1 to last do if not zero(equa[i]) then begin
　　for p := last downto 0 do
　　　if equa[i, p] = 1 then break;
　　if p = 0 then begin result := -1; break; end;
　　dec(result);
　　for j := i + 1 to last do
　　　if equa[j, p] = 1 then
　　　　for k := 0 to last do equa[j, k] := equa[i, k] xor equa[j, k];
　end;
end;

begin
　init;
　main;
　print;
end.