没用图做的，帮忙跟踪一下看看哪里有错阿
var
  a:Array[0..27,0..27] of longint;
  out,x,y,i,j,k,i1,i2:longint;
  n:longint;
  s:string;
procedure print;
var
  m:array[1..26] of longint;
  max,mi,l,r:longint;
begin
  FILLCHAR(M,SIZEOF(M),0);
  write('Sorted sequence determined after ',i,' relations: ');
  for l:=1 to x do
    for r:=1 to x do
      if a[l,r]=1 then inc(m[l]);
  for l:=1 to x do begin
    max:=-1;
    for r:=1 to x do
      if m[r]>max then begin
        max:=m[r];
        mi:=r;
      end;
    write(chr(mi+64));
    m[mi]:=-1;
  end;
  writeln('.');
end;
function check:boolean;
var
  ii,jj:longint;
begin
  check:=false;
  for ii:=2 to x do
    for jj:=1 to ii-1 do
      if a[ii,jj]=0 then exit;
  check:=true;
end;
procedure sub(q,p:longint);
VAR
  T:LONGINT;
  II:LONGINT;
begin
  T:=3-A[Q,P];
  FOR II:=1 TO X DO
    IF A[Q,II]=T THEN
      IF (A[P,II]<>0)AND(A[P,II]<>T) THEN BEGIN
        N:=1;OUT:=I;
        EXIT;
      END
      ELSE
        IF A[P,II]=0 THEN
        BEGIN
          A[P,II]:=T;
          A[II,P]:=3-T;
          SUB(P,II);
        END;
END;
begin
  repeat
    n:=0;
    fillchar(a,sizeof(a),0);
    readln(x,y);
    if (x=0)and(y=0) then halt;
    for i:=1 to y do
      if (n<>1)and(n<>2) then begin
        readln(s);
        i1:=ord(s[1])-64;
        i2:=ord(s[3])-64;
        IF I1=I2 THEN BEGIN
          N:=1;OUT:=I;
        END
        ELSE BEGIN
        if s[2]='<' then
          if a[i1,i2]=2 then begin n:=1;out:=i;end
          else begin
            a[i1,i2]:=1;
            a[i2,i1]:=2;
          end;
        sub(i1,i2);
        if n<>1 then if check then begin print;n:=2;end;
        END;
      end
      else READLN;
    if n=1 then writeln('Inconsistency found after ',out,' relations.');
    if n=0 then writeln('Sorted sequence cannot be determined.');
  until 1<>1;
end.