重叠的方框（vijos1030）

1.先求出一共有几个字母，同时有哪个字母做个标记。
2.利用循环找到每个字母的上下左右边界。
3.建立拓扑排序的序列，从在最底层的字母向它上一层的字母连一条有向边。这里的循环要两次，一次是从上到下的，一次是从左到右的。
4.利用DFS找出所有可能的序列。

5.利用排序确定这些序列的所处的位置并输出。

program VJ1030;

const
 maxn=10;
 maxc=26;
 maxp=1000;
 
type
 atp=record
  top,below,left,right:longint;
 end;

var
 n,m,tot,final:longint;
 ans:array [0..maxp] of string;
 b:array ['A'..'Z','A'..'Z'] of boolean;
 ljb:array ['A'..'Z',0..maxc] of char;
 into,outto:array ['A'..'Z'] of longint;
 have,go:array ['A'..'Z'] of boolean;
 a:array [0..maxn,0..maxn] of char;
 size:array ['A'..'Z'] of atp;
 
procedure init;
var
 i,j:longint;
begin
 fillchar(have,sizeof(have),false);
 final:=0;
 tot:=0;
 readln(n);
 readln(m);
 for i:=1 to n do
  begin
   for j:=1 to m do
    begin
     read(a[i,j]);
     if (a[i,j]<>'.') and (not have[a[i,j]]) then inc(tot);
     have[a[i,j]]:=true;
    end;
   readln;
  end;
end;

procedure find;
var
 i,j:longint;
 ch:char;
begin
 for ch:='A' to 'Z' do
  begin
   size[ch].top:=10000000;
   size[ch].below:=-1;
   size[ch].left:=10000000;
   size[ch].right:=-1;
  end;
 for i:=1 to n do
  begin
   for j:=1 to m do
    begin
     ch:=a[i,j];
     if i<size[ch].top then size[ch].top:=i;
     if i>size[ch].below then size[ch].below:=i;
     if j<size[ch].left then size[ch].left:=j;
     if j>size[ch].right then size[ch].right:=j;
    end;
  end;
end;

procedure TP_init;
var
 i:longint;
 ch,t1,t2:char;
begin
 fillchar(into,sizeof(into),0);
 fillchar(outto,sizeof(outto),0);
 fillchar(b,sizeof(b),false);
 for ch:='A' to 'Z' do
  begin
   if have[ch] then
    begin
     for i:=size[ch].left to size[ch].right do
      begin
       t1:=a[size[ch].top,i];
       t2:=a[size[ch].below,i];
       if (t1<>ch) and (not b[ch,t1]) then
        begin
         b[ch,t1]:=true;
         inc(outto[ch]);
         inc(into[t1]);
         ljb[ch,outto[ch]]:=t1;
        end;
       if (t2<>ch) and (not b[ch,t2]) then
        begin
         b[ch,t2]:=true;
         inc(outto[ch]);
         inc(into[t2]);
         ljb[ch,outto[ch]]:=t2;
        end;
      end;
     for i:=size[ch].top to size[ch].below do
      begin
       t1:=a[i,size[ch].left];
       t2:=a[i,size[ch].right];
       if (t1<>ch) and (not b[ch,t1]) then
        begin
         b[ch,t1]:=true;
         inc(outto[ch]);
         inc(into[t1]);
         ljb[ch,outto[ch]]:=t1;
        end;
       if (t2<>ch) and (not b[ch,t2]) then
        begin
         b[ch,t2]:=true;
         inc(outto[ch]);
         inc(into[t2]);
         ljb[ch,outto[ch]]:=t2;
        end;
      end;
    end;
  end;
end;

procedure dfs(st:char;s:string;dep:longint);
var
 i:longint;
 ch:char;
begin
 if dep=tot then
  begin
   inc(final);
   ans[final]:=s;
   exit;
  end;
 for i:=1 to outto[st] do dec(into[ljb[st,i]]);
 for ch:='A' to 'Z' do
  begin
   if (into[ch]=0) and (not go[ch]) and (have[ch]) then
    begin
     go[ch]:=true;
     dfs(ch,s+ch,dep+1);
     go[ch]:=false;
    end;
  end;
 for i:=1 to outto[st] do inc(into[ljb[st,i]]);
end;

procedure main;
var
 ch:char;
begin
 fillchar(go,sizeof(go),false);
 for ch:='A' to 'Z' do
  begin
   if (have[ch]) and (into[ch]=0) then
    begin
     go[ch]:=true;
     dfs(ch,ch,1);
     go[ch]:=false;
    end;
  end;
end;

procedure print;
var
 i,j:longint;
 t:string;
begin
 for i:=1 to final-1 do
  begin
   for j:=i+1 to final do
    begin
     if ans[i]>ans[j] then
      begin
       t:=ans[i];
       ans[i]:=ans[j];
       ans[j]:=t;
      end;
    end;
  end;
 for i:=1 to final do writeln(ans[i]);
end;

begin
 assign(input,'VJ1030.in'); reset(input);
 assign(output,'VJ1030.out'); rewrite(output);
 
 init;
 find;
 TP_init;
 main;
 print;
 
 close(input); close(output);
end.