Переориентирование орграфа

type List = ^node;
    node = record
      name:string;
      next:list;
    end;
    dyn_arr = array of list;
 
var L1:list;  x:string; G:text; j,n,i:integer;listV: dyn_arr;   InvList: dyn_arr;
 
procedure CreateList( var f:text);
var i,k:integer; p,l,g:list; s:string; u:integer;
begin
  k:=0; i:=1; read(f,x);
  while x[i]<>#46 do
    begin
      new(l); l^.name:= '';
      listV[k]:= l;
      while x[i]<>'[' do
      begin
        l^.name:= l^.name+x[i];
        i:=i+1;
      end;
      inc(i);
      p:= l;
      while x[i]<>#93 do
      begin
        new(g);
        g^.name:='';
        u:=u+1;
        while (x[i]<>#44) and (x[i]<>#93) do
        begin
          g^.name:= g^.name+x[i];
          inc(i);
        end;
        p^.next:= g; p:=g; p^.next:= nil;
        if x[i]=#44 then i:=i+2;
      end;
      if x[i+1]<>#46 then i:=i+2;
      k:= k+1;
      i:=i+1;
    end;
end;
procedure CHECK(u:integer);
begin
        writeln('Check',u);
end;
procedure Out(ff:list);
begin
        if ff<>nil then begin
          write(ff^.name);
          Out(ff^.next);
        end;
 
end;
 
procedure Change(i:integer);
var p,q,l,tt,g:list; k,j:integer;
begin
    g:=listV[i];  new(l); check(1); l^.name:=g^.name; check(2); j:=0;
    while (g^.next<>nil) do
    begin
        new(p); p^.name:=g^.next^.name;
        if InvList[j]=nil then
        begin
          InvList[j]:=p;
          p^.next:=l;          
          g:=g^.next;
        end
        else begin
        op:=0; 
    while (InvList[op]^.name<>p^.name) and (InvList[op]<>nil) do
               op:= op+1;    
        if InvList[op]^.name=p^.name then
          while InvList[op]<>nil do
          begin   
            if InvList[op]^.next= nil then
            begin
              new(q);
              q^.name:= l^.name;
              InvList[op]^.next:= q;     
            end;
            InvList[op]:= InvList[op]^.next;
          end
        else begin
          InvList[op]:=p;
          p^.next:=l;
    end;
    end;
          j:= j+1;  
  end;    
end;
begin
 
    writeln('Enter the number of vertices to create a dynamic array');
    readln(n);
  SetLength(InvList, n);
  SetLength(listV, n);
  assign(G,'G1.txt');
  reset(G);
 
  CreateList(G);
  close(g);
      for i:=0 to N-1 do begin
        writeln;
        InvList[i]:= nil;
      end;
  for i:=0 to N-1 do
  Change(i);
   for i:=0 to N-1 do begin
        Out(invlist[i]);
    writeln;
   end;
 
        readln();
end.

function CheckIn(p: list):integer;
var f: Boolean;
begin
    f:= true;
    for i:=0 to N-1 do
        begin
                if InvList[i]<>nil then
                begin
                if p^.name = InvList[i]^.name then
                begin
                       CheckIn:= i;
                       f:= false;
                    end
                    else
                    if f then CheckIn:=-1;
                end
                else
                if f then CheckIn:=-1;
        end;
end;
procedure ChangeLast(var q:list; p: list);
begin
    if q=nil then
    begin
        new(q);
        q^.name:=p^.name;
        q^.next:=nil;
    end
    else
    ChangeLast(q^.next, p);
end;
procedure AddToNil(q, p:list);
var i: integer;
begin
        i:=0;
    while InvList[i]<>nil do i:= i+1;
    InvList[i]:= q;
    q^.next:= p;
    p^.next:=nil;
end;

program ReverseGraph;
 
type
  {----------------------------------}
  {список смежности для одной вершины}
  {указатель на список}
  PListAdj = ^TListAdj;
  {элемент списка}
  TListAdj = record
    fId: integer;
    fTo: PListAdj;
  end;
  {----------------------------------}
  {описание вершины}
  TVertex = record
    fName: string;
    fId: integer;
    fList: PListAdj;
  end;
  {----------------------------------}
  {списки смежности (список вершин со списками смежности)}
  {указатель на список}
  PList = ^TList;
  {элемент списка}
  TList = record
    fVertex: TVertex;
    fTo: PList;
  end;
 
  {================================================================}
  {процедуры для работы со списком смежности для одной вершины}
  {Процедура добавления нового элемента в конец односвязного списка}
  procedure AddToListAdj(var ARoot: PListAdj; AId: integer);
  var
    tmp: PListAdj;
  begin
    if ARoot = nil then
    begin
      new(ARoot);
      tmp := ARoot;
    end
    else
    begin
      tmp := ARoot;
      while tmp^.fTo <> nil do
        tmp := tmp^.fTo;
      new(tmp^.fTo);
      tmp := tmp^.fTo;
    end;
    tmp^.fTo := nil;
    tmp^.fId := AId;
  end;
 
  {процедура освобождения памяти списка}
  procedure FreeListAdj(var ARoot: PListAdj);
  var
    tmp: PListAdj;
  begin
    while ARoot <> nil do
    begin
      tmp := ARoot;
      ARoot := Aroot^.fTo;
      dispose(tmp);
    end;
  end;
 
  {================================================================}
  {процедуры для работы со списками смежностей (списком списков)}
  {Процедура добавления нового элемента в конец односвязного списка}
  procedure AddToList(var ARoot: PList; AVertex: TVertex);
  var
    tmp: PList;
  begin
    if ARoot = nil then
    begin
      new(ARoot);
      tmp := ARoot;
    end
    else
    begin
      tmp := ARoot;
      while tmp^.fTo <> nil do
        tmp := tmp^.fTo;
      new(tmp^.fTo);
      tmp := tmp^.fTo;
    end;
    tmp^.fTo := nil;
    tmp^.fVertex := AVertex;
  end;
 
  {процедура освобождения памяти списка}
  procedure FreeList(var ARoot: PList);
  var
    tmp: PList;
  begin
    while ARoot <> nil do
    begin
      tmp := ARoot;
      ARoot := Aroot^.fTo;
      dispose(tmp);
    end;
  end;
 
  {процедура поиска вершины в списке смежности (списке списков)
  поиск считается успешным, если совпало или имя вершины или её номер}
  function FindList(ARoot: PList; AVertex: TVertex): PList;
  begin
    while (ARoot <> nil) do
    begin
      if (ARoot^.fVertex.fName = AVertex.fName) or
        (ARoot^.fVertex.fId = AVertex.fId) then
        break;
      Aroot := ARoot^.fTo;
    end;
    FindList := ARoot;
  end;
 
  {================================================================}
  {чтение списка из файла}
  procedure ReadListFromFile(var ARoot: PList; const AFileName: string);
  begin
    Assign(f, AFileName);
    reset(f);
 
    Close(f);
  end;
 
begin
end.