POJ 1094(拓扑排序）

拓排+各种判……

Program P1094;
type
   map3=record
        indegree:array['A'..'Z'] of longint;
        map:array['A'..'Z',1..26] of char;
        outdegree:array['A'..'Z'] of longint;
        end;
var
   n,m,i,j,num,value,topvalue:longint;
   s:string;
   topout:string;
   map,map2:map3;
   mark:array['A'..'Z'] of boolean;
   tag:boolean;
Function topsort:longint;
var
   j,k,h,s,zero:longint;
   flag:boolean;
   i:char;
begin
   topsort:=3;
   topout:='';
   flag:=false;
   h:=1;
   s:=0;
   zero:=0;
   for i:='A' to 'Z' do if mark[i] then if map2.indegree[i]=0 then begin inc(zero); topout:=topout+i; end;
   if zero=0 then exit(2);
   s:=length(topout);
   while (h<=s) do
   begin
      if (h<s) then flag:=true;
      for j:=h to s do
      begin
         for k:=1 to map2.outdegree[topout[j]] do
         begin
            dec(map2.indegree[map2.map[topout[j],k]]);
            if map2.indegree[map2.map[topout[j],k]]=0 then
            begin
               topout:=topout+map2.map[topout[j],k];
            end;
         end;
         if length(topout)>num then exit(2);
      end;
      h:=s+1;
      s:=length(topout);
   end;
   if s<num then exit(2);
   if (s=num) and (num<n) then exit(3);

   if flag or (num<n) then exit(3) else exit(1);

end;
Procedure ski(step:longint);
var
   i:longint;
   s:string;
begin
   for i:=step+1 to m do readln(s);
end;
Procedure pri(value,step:longint);
begin
   if value=1 then writeln('Sorted sequence determined after ',step,' relations: ',topout,'.');
   if value=3 then writeln('Sorted sequence cannot be determined.');
   if value=2 then
   begin
      writeln('Inconsistency found after ',step,' relations.');
      ski(step);
   end;
   if value=1 then ski(step);
end;

begin
 {  assign(input,'P1094.in');
   assign(output,'p1094.out');
   reset(input);
   rewrite(output);    }
   readln(n,m);
   while (n+m>0) do
   begin
      topout:='';
      fillchar(map,sizeof(map),0);
      fillchar(mark,sizeof(mark),false);
      num:=0;
      value:=3;
      for i:=1 to m do
      begin
         readln(s);
         if (ord('A')-1+n<ord(s[1])) or (ord('A')-1+n<ord(s[3])) or (s[1]=s[3]) then
         begin
            value:=2;
            break;
         end;

         if not(mark[s[1]]) then begin mark[s[1]]:=true; inc(num); end;
         if not(mark[s[3]]) then begin mark[s[3]]:=true; inc(num); end;
         tag:=false;
         for j:=1 to map.outdegree[s[1]] do
            if map.map[s[1],j]=s[3] then begin tag:=true; break; end;
         if tag then continue;
         inc(map.indegree[s[3]]);
         inc(map.outdegree[s[1]]);
         map.map[s[1],map.outdegree[s[1]]]:=s[3];

         map2:=map;
         topvalue:=topsort;
         if topvalue<=2 then begin value:=topvalue; break; end;
      end;
      pri(value,i);
      readln(n,m);
   end;
{   close(input);
   close(output);  }
end.