[POJ1094 Sorting It All Out]

[题目来源]：POJ1094

[关键字]：拓扑排序

[题目大意]：给出n各字母和一系列不等式，判断是否能确定所有字母顺序输出在最早在第几个不等式处判断出或是否有矛盾最早在哪判断出，还是不能确定顺序。

//=====================================================================================================

[分析]：将每个不等式从小到大亮连一条边，就成了一个有向图，就是判断是否是一个无环图。每加入一个条件就进行拓扑排序，顺序确定就是完成唯一拓扑排序，矛盾就是有环，不确定就是拓扑序不唯一。注意的是，成立和矛盾可以一下看出，不确定需把所有条件都用完才行。还有即使不唯一也要判断是否有环，否则会WA。

[代码]：

View Code

  1 program Project1;
  2 var
  3   n, m, goal: longint;
  4   ch: char;
  5   d, d2: array[0..30,0..30] of boolean;
  6   q: array[0..1000] of longint;
  7   r, r2: array[0..30] of longint;
  8 
  9 procedure bfs;
 10 var
 11   h, t, i, temp: longint;
 12 begin
 13   h := 1;
 14   t := 0;
 15   fillchar(q,sizeof(q),0);
 16   r2 := r;
 17   for i := 1 to n do
 18     if r2[i] = 0 then
 19       begin
 20         inc(t);
 21         q[t] := i;
 22       end;
 23   if t > 1 then goal := 2;
 24 
 25   d2 := d;
 26   while h <= t do
 27     begin
 28       temp := 0;
 29       for i := 1 to n do
 30         if d2[q[h],i] then
 31           begin
 32             dec(r2[i]);
 33             d2[q[h],i] := false;
 34             if r2[i] = 0 then
 35               begin
 36                 inc(t);
 37                 q[t] := i;
 38                 inc(temp);
 39                 if temp = 2 then goal := 2;
 40               end;
 41           end;
 42       inc(h);
 43     end;
 44   if t < n then
 45     goal := 1
 46   else
 47     if goal <> 2 then goal := 3;
 48 end;
 49 
 50 procedure init;
 51 var
 52   i, j, xx, yy: longint;
 53   x, ch, y: char;
 54 begin
 55   fillchar(d,sizeof(d),false);
 56   fillchar(r,sizeof(r),0);
 57   for i := 1 to m do
 58     begin
 59       goal := 0;
 60       readln(x,ch,y);
 61       xx := ord(x)-ord('A')+1;
 62       yy := ord(y)-ord('A')+1;
 63       d[xx,yy] := true;
 64       inc(r[yy]);
 65       bfs;
 66       case goal of
 67         1:begin
 68             writeln('Inconsistency found after ',i,' relations.');
 69             for j := i+1 to m do readln(x,ch,y);
 70             exit;
 71           end;
 72         2:continue;
 73         3:begin
 74             write('Sorted sequence determined after ',i,' relations: ');
 75             for j := 1 to n do write(chr(q[j]-1+ord('A')));
 76             writeln('.');
 77             for j := i+1 to m do readln(x,ch,y);
 78             exit;
 79           end;
 80       end;
 81     end;
 82   writeln('Sorted sequence cannot be determined.');
 83 end;
 84 
 85 procedure print;
 86 var
 87   i, j: longint;
 88 begin
 89   for i := 1 to n do
 90     begin
 91       for j := 1 to n do write(d[i,j],' ');
 92       writeln;
 93     end;
 94 end;
 95 
 96 begin
 97   //assign(output,'d:\1.out');rewrite(output);
 98   readln(n,m);
 99   while n+m <> 0 do
100     begin
101       init;
102       //print;
103       readln(n,m);
104     end;
105   //close(output);
106 end.