Написать программу с использованием алгоритма обхода графа в ширину - Pascal ABC

Формулировка задачи:

Написать программу с использованием алгоритма обхода графа в ширину.За ранее спасибо

Решение задачи: «Написать программу с использованием алгоритма обхода графа в ширину»

Листинг программы

Program P28;
 
Const MAX_VERT = 100;
 
Var LstS    : Array[1..MAX_VERT,1..MAX_VERT] of integer;
Var Chk     : Array[1..MAX_VERT] of integer;
Var Que     : Array[1..MAX_VERT] of integer;
Var ptrQ       : integer;
Var CurrN      : integer;
Var finp         : Text;
Var i,j,l,k        : integer;
Var Stri,s,tmp : String;
 
Procedure Enque(n : integer);
Begin
      ptrQ:=ptrQ+1;
      Que[ptrQ]:=n;
      Chk[n]:=1;
End;
 
Function Deque : integer;
Var k,i : integer;
Begin
    k:=Que[1];
    for i:=2 to ptrQ Do Que[i-1]:=Que[i];
    ptrQ:=ptrQ-1;
    Deque:=k;
End;
 
Function isBound(i,j : integer) : Boolean;
Var k : integer;
Begin
     for k:=1 to CurrN Do
         if LstS[i,k]=j Then Begin
            isBound:=True;
            exit;
         End;
     For k:=1 to CurrN Do
         if LstS[j,k]=i Then Begin
            isBound:=True;
            exit;
         End;
     isBound:=False;
End;
 
 
Procedure BFS(n : integer);
Var i,j : integer;
 
Begin
 
    Enque(n);
    
    While (ptrQ > 0) Do Begin
 
          k:=Deque();
          
          for i:=1 to  CurrN Do
              if (Chk[i]=0) And (isBound(i,k)) Then Begin
                 writeln(k,' - ',i);
                 Enque(i);
              End;
          
    End;
 
End;
 
Begin
 
    for i:=1 to MAX_VERT Do Begin
        Chk[i]:=0;
        Que[i]:=0;
        for j:=1 to MAX_VERT Do
            Lsts[i,j]:=0;
    end;
 
    ptrQ:=0;
 
    assign(finp,'graph.txt');
    reset(finp);
 
    readln(finp,CurrN);
 
    for i:=1 to CurrN Do Begin
        readln(finp,Stri);
        Stri:=Stri+',';
        l:=length(Stri);
        tmp:='';
        k:=1;
        for j:=1 to l Do Begin
            s:=Stri[j];
            if s <> ' ' then
               if s = ',' then Begin
                  if tmp <> '' then Begin
                     Lsts[i,k]:=strToint(tmp);
                     tmp:='';
                     k:=k+1;
                  End;
                End
               Else
                  tmp:=tmp+s;
        End;
    End;
 
    Close(finp);
 
    BFS(1);
 
    writeln;
 
End.

Объяснение кода листинга программы

Программа написана на языке Pascal ABC и предназначена для обхода графа в ширину (BFS). Она использует массив LstS для хранения ребер графа, где LstS[i,j] равно 1, если существует ребро между вершинами i и j, и 0 в противном случае. Константа MAX_VERT определяет максимальное количество вершин в графе. Массивы Chk, Que и ptrQ используются для реализации очереди и указателя на вершину в графе. Функция Enque добавляет новую вершину в очередь. Функция Deque извлекает и удаляет первую вершину из очереди. Функция isBound проверяет, является ли текущая вершина соседней для заданной вершины. Процесс BFS начинается с вершины n и продолжается до тех пор, пока в очереди остаются вершины. Он извлекает вершину из очереди, проверяет, является ли она соседней для текущей вершины, и если да, то печатает их индексы и добавляет текущую вершину в очередь. В начале программы все вершины и ребра графа инициализируются. Затем программа считывает из файла информацию о количестве вершин и сохраняет ее в переменной CurrN. Затем программа считывает имена вершин из файла и сохраняет их в массиве Stri. Она затем обрабатывает каждую вершину, считывая ее координаты и добавляя их в массив LstS. В конце программы выполняется BFS, начиная с вершины 1.