Написала программу по псевдокоду...Но результат работы процедур не выдается....Не пойму в чем проблема...Пседокод прилагаю..заранее благодарю за помощь))

uses crt;
const
  max=50;
type
    TMatrix = array [1..max,1..max] of byte;
    TArray  = array [1..max] of integer;

var
    i,j,m,k,z : integer;
    num,ftr,masQ: TArray;
    Matrix : TMatrix; {матрица смежности}
    n ,nz: integer; {количество вершин графа}

procedure save(i,j,nz:integer);
begin
     z:=i;
        while z<>j do
                begin
                     masQ[nz]:=z;
                     z:=ftr[z];
                     masQ[nz]:=j;
                     masq[nz]:=i;
                end;
end;
procedure cicle(i:integer);
var
  j:integer;

begin
     k:=k+1;
     num[i]:=k;
  for j:=1 to n do
  begin
    if (Matrix[i, j]<>0) and (num[j]=0) then
       begin
            ftr[j]:=i;
            cicle(j);
       end
          else if ftr[i]<>j then
               begin
                    nz:=nz+1;
                    save(i,j,nz);
               end;
end;
end;

begin
  clrscr;

  writeln('=======Фундаментальная система циклов связного графа====');

  write('Введите количество вершин графа:');
  readln(n);
  writeln('Заполнение матрицы смежности');
  for i:=1 to n do
    for j:=1 to n do
    begin
      Write('(',i,',',j,')=');
      read(Matrix[i,j]);
      if Matrix[i,j] <> 0 then Matrix[i,j]:=1;
    end;
{$endif}
  //вывод матрицы смежностиж;
  writeln('Матрица смежности');
  for i:=1 to n do
  begin
    for j:=1 to n do
      write(Matrix[i,j],' ');
    writeln;
  end;
  writeln;


  writeln('Результат :');
  n:=0; m:=0;
  for i:=1 to n do
  begin
    num[i]:=0; {ни одна вершина не посещалась}
    ftr[i]:=0;
    n:=n+1;
    m:=m+(n*n);
    m:= round(m / 2);
    k:=1;
  end;
  for i:=1 to m-n+1 do
  begin
  masQ[i]:=0;
  k:=0;
  nz:=0;
  cicle(i);

  //вывод массивов  num ftr;
  write('num: ');
  for i:=1 to n do
    write(num[i]:3);
  writeln;
  write('ftr: ');
  for i:=1 to n do
    write(ftr[i]:3);
  writeln;
  write('masQ:  ');
  for i:=1 to n do
    write(masQ[i]:3);
  writeln;
  write('nz:  ');
    write(nz);
  writeln;
  readln;
end;
end.
 

Нажмите для просмотра прикрепленного файла

1. Обрати внимание, что в этой задаче граф предлагается задавать не матрицей смежности, а списками смежности. Соответственно при инициализации в цикле m:=m+n*n; - совсем ахинея, не считая ввода матрицы смежностей. Хотя подойдёт и матрица, но в методичке предлагается научиться работать со списками.
2. Кроме того, masQ - это не массив чисел, а массив стеков. И в процедуре SAVE операция masQ[nZ]<=i означает занесение числа i в вершину стека (стека под номером nZ в массиве стеков masQ), а не примитивное присвоение. Соответственно и вывод на экран из стека и массива стеков будет иным.
3. В SAVE строка с номером 5 вне тела цикла.

Внимательно прочти теорию.

Нечестно манипулировать форумчанами выдавая механический перевод псевдокода за попытку разобраться в теме. Хотя несомненно много лучше постановки задачи с последующим "разрешением" сделать всё "под ключ".

Предвидя вопрос о стеке...
Стек можно реализовать в виде массива [0..max]. В [0] элементе будет храниться глубина стека, а начиная с 1-го элемента будет располагаться сам стек. Соответственно, массив стеков становится двумерным массивом. Занесение в стек номер nZ числа i будет

Inc(masQ[nZ][0]);
x:=masQ[nZ][0];
masQ[nZ][x]:=i;

И лучше всего эти строки оформить процедурой.

Или же стек можно реализовать в виде динамической структуры.

спасибо большое за помощь,просто мне преподаватель дал книгу эту и сказала следовать тупо коду,а на деле оказалось не все так просто

Если непонятно - задавай вопросы. Конечно, если возможно - преподавателю, он увидит твою работу. Если в методичке слишком заумно, задай поиск в сети.
вот ссылки навскидку
"http://rain.ifmo.ru/cat/view.php/theory/graph-circuits-cuts/euler-2004",
"http://www.intuit.ru/department/algorithms/gaa/7/3.html"

Если быть честной непонятно мне вообще в процедуре Save c 3-5 строчку как оформить это...

Я вижу так:

procedure Save(i, j, nZ : integer);
var
  z : integer;
begin
  z:=i;                          {1}
  while (z<>j) and (z<>0) do     {2}
  begin
    StackPush(masQ[nZ], z);      {3}
    z:=ftr[z];                   {4}
  end;
  StackPush(masQ[nZ], j);        {5}
  StackPush(masQ[nZ], i);        {5}
end;

Массив стеков я организовал по-детски - по принципу массива строк String. Каждый стек это массив, у которого в элементе с индексом [0] находится глубина стека (его длина):

type
{TStack - тип для хранения стека фундаментальных циклов.
         Его размер равен цикломатическому числу связанного графа,
         т.е. m-n+1 или в максимальном виде (max*max-max+1)
}
    TListX  = array [0..max] of integer;
    TStack  = array [1..max*max-max+1] of TListX;
var
    masQ : TStack;   {массив стеков}

{помещение элемента Elem в стек Stack}
procedure StackPush( var Stack : TListX; Elem : Byte);
var
  i : integer;
begin
  i:=Stack[0];
  inc(i);
  Stack[i]:=Elem;
  Stack[0]:=i;
end;

Это не самый лучший способ, но для упрощения реализации сойдёт.

спасибо за помощь...как отблагодарить не знаю...

Недорого - 3 месяца активной помощи (ответов) страждущим на форуме (по согласованию с администрацией можно и без кандалов) или старушку через дорогу перевести

Ой этим я и так занимаюсь....помогаю бедным и обездоленным....

 
uses crt;
const
  max=50;

type
  TMatrix = array [1..max,1..max] of byte;
  TArray  = array [1..max] of integer;
  TList = array[0..max]of integer;
  Tstack = array[1..max*max-max+1]of TList;
var
  i,j,m,k,z : integer;
  num,ftr      : TArray;
  Matrix : TMatrix; {матрица смежности}
  n ,nz     : integer; {количество вершин графа}
  masQ:TStack;
  
procedure StackPush(Stack:TList;Elem:byte);
var
  i:integer;
  begin
  i:=Stack[0];
  inc(i);
  Stack[i]:=Elem;
  Stack[0]:=i;
  end;
procedure save(i,j,nz:integer);
var
z:integer;
begin
  z:=i;
    while (z<>j) and (z<>0) do
      begin
           StackPush(masQ[nz],z);
           z:=ftr[z];
      end;
  StackPush(masQ[nz],j);
  StackPush(masq[nz],i)
end;
procedure cicle(i:integer);
var
  j:integer;

begin
  k:=k+1;
  num[i]:=k;

  for j:=1 to n do
  begin
    if (Matrix[i, j]<>0) and (num[j]=0) then
    begin
      ftr[j]:=i;
      cicle(j);
    end
    else if ftr[i]<>j then
    begin
         nz:=nz+1;
         save(i,j,nz);
    end;
  end;
end;

begin
  clrscr;

  writeln('=======Фундаментальная система циклов связного графа====');

  write('Введите количество вершин графа:');
  readln(n);
  writeln('Заполнение матрицы смежности');
  for i:=1 to n do
    for j:=1 to n do
    begin
      Write('(',i,',',j,')=');
      read(Matrix[i,j]);
      if Matrix[i,j] <> 0 then Matrix[i,j]:=1;
    end;
{$endif}
  //вывод матрицы смежностиж;
  writeln('Матрица смежности');
  for i:=1 to n do
  begin
    for j:=1 to n do
      write(Matrix[i,j],' ');
    writeln;
  end;
  writeln;

  //процедура dfs;
  writeln('Результат dfs');
  n:=0; m:=0;
  for i:=1 to n do
  begin
    num[i]:=0; {ни одна вершина не посещалась}
    ftr[i]:=0;
    n:=n+1;
    m:=m+(n*n);
    m:= m div 2;
    k:=1;
  end;
  for i:=1 to m-n+1 do
  begin
  StackPush(masQ[i],0);
  k:=0;
  nz:=0;
  cicle(i);


  write('num: ');
  for i:=1 to n do
    write(num[i]:3);
  writeln;
  write('ftr: ');
  for i:=1 to n do
    write(ftr[i]:3);
  writeln;
  write('masQ:  ');

  writeln;
  write('nz:  ');
    write(nz);
  writeln;
  readln;
end;
end.

Прошу прощения за мою тупость ...но есть проблема теперь и с выводом результата,хотя ошибок в процедурах вроде нет

masQ? Он представляет из себя массив от 1 до nZ - первый (внешний цикл от 1 до nZ), каждый стек представляет из себя массив переменной длины, в котором элемент с нулевым индексом содержит длину стека (внутренний цикл от 1 до masQ[i][0]):

  writeln('nZ:  ', nZ);
  writeln('masQ:  ');
  for i:=1 to nZ do
  begin
    write(i, '. ');
    for j:=1 to masQ[i][0] do
      write(masQ[i][j]:3);
    writeln;
  end;

А можно замечания к коду?
- переменная n вводится, а чуть ниже ей присваивается 0.
- переменной m присваивается не то значение. смотри внимательно псевдокод
- стек странно инициализируется. достаточно обнулить длины каждого стека for i:=1 to m-n+1 do masQ[i][0]:=0;
- из основной программы cicle вызывается один раз с параметром 1 (см. псевдокод)
Это из того, что бросается в глаза.

Далее, когда я попытался несколько дней назад отладить собственный вариант псевдокода, по ходу выполнения программы возникали исключения вида "полез в чужую память". Пришлось дополнить условия в save. Это увидишь отладчиком включив опци проверки диапазонов {$R+, Q+}.

Плюс к этому, в circle формировалась пара-тройка "левых" циклов. Также лечится усложнением условия сохранения вновь найденного цикла.

Павел это снова я с вопросами...))))Почему n потом обнуляется??сначала я ее ввожу для заполнения матрицы смежности....а остальное по псевдокоду...вот с оформлением m я сама не очень уверена....,но в 7 строке...получается что если m-нечетное,то идет присваение целому ,десятичного числа..А так оно все работает запускается,но процедуры не выводят никаких результатов,а теория никак не помогает((((

uses crt;
const
  max=50;
type
  TMatrix = array [1..max,1..max] of byte;
  TArray  = array [1..max] of integer;
  TList = array[0..max]of integer;
  Tstack = array[1..max*max-max+1]of TList;
var
  i,j,m,k,z : integer;
  num,ftr      : TArray;
  Matrix : TMatrix; {матрица смежности}
  n ,nz     : integer; {количество вершин графа}
  masQ:TStack;
procedure StackPush(Stack:TList;Elem:byte);
var
  i:integer;
begin
  i:=Stack[0];
  inc(i);
  Stack[i]:=Elem;
  Stack[0]:=i;
end;
procedure Save(i, j, nZ : integer);
var
  z : integer;
begin
  z:=i;
  while (z<>j) and (z<>0) do
        begin
             StackPush(masQ[nZ], z);
             z:=ftr[z];
        end;
  StackPush(masQ[nZ], j);
  StackPush(masQ[nZ], i);
end;
procedure cicle(i:integer);
var
  j:integer;

begin
   k:=k+1;
  num[i]:=k;
  for j:=1 to n do
  begin
    if (Matrix[i, j]<>0) and (num[j]=0) then
       begin
            ftr[j]:=i;
            cicle(j);
       end
    else if ftr[i]<>j then
         begin
              nz:=nz+1;
              save(i,j,nz);
         end;
end;
end;

begin
  clrscr;

  writeln('=======Фундаментальная система циклов связного графа====');

  write('Введите количество вершин графа:');
  readln(n);
  writeln('Заполнение матрицы смежности');
  for i:=1 to n do
    for j:=1 to n do
    begin
      Write('(',i,',',j,')=');
      read(Matrix[i,j]);
      if Matrix[i,j] <> 0 then Matrix[i,j]:=1;
    end;
{$endif}
  //вывод матрицы смежностиж;
  writeln('Матрица смежности');
  for i:=1 to n do
  begin
    for j:=1 to n do
      write(Matrix[i,j],' ');
    writeln;
  end;
  writeln;

  //процедура dfs;
  writeln('Результат dfs');
  n:=0; m:=0;
  for i:=1 to n do
  begin
    num[i]:=0; {ни одна вершина не посещалась}
    ftr[i]:=0;
    n:=n+1;
    m:=m+(n*n);
  end;
    m:= m div 2;


for i:=1 to m-n+1 do
      begin
           masQ[i][0]:=0;
           k:=0;
           nz:=0;
           cicle(1);
      end;

  //вывод массивов  num ftr;
  write('num: ');
  for i:=1 to n do
    write(num[i]:3);
  writeln;
  write('ftr: ');
  for i:=1 to n do
    write(ftr[i]:3);
  writeln;
  writeln('nZ:  ', nZ);
  writeln('masQ:  ');
  for i:=1 to nZ do
  begin
    write(i, '. ');
    for j:=1 to masQ[i][0] do
      write(masQ[i][j]:3);
    writeln;
  end;
end.

Юль, ты делаешь все механически, не вникая.
Мне проще отдать тебе готовый код, чем объяснять.

В архиве две папки. В одной работающий код по псевдокоду, с учётом примечания, найденного в книге Окулова о том, что к сохранению цикла переходим не только когда j вершина не предыдущая для i, но и когда при построении дерева поиска в глубину i вершина встретилась после j (т.е. найдено обратное ребро - ведущее вверх).

Во второй папке программа с аналогичной функциональностью, встретившаяся мне на одном из форумов. Топикстартер утверждал, что она из книги Иванов Б.Н. "Дискретная математика. Алгоритмы и программы." Она мне просто понравилась.

В обоих случаях я использовал пример из твоей методички. Кстати, в интернете она встречается в pdf и с внесёнными исправленями.

Спасибо тебе большое,но я вникала я перерыла все учебники по этой теме...просто сложно когда препод по практике ничего толком на твои вопросы не отвечает...мне самой легче не тупо сделать а понять,а чтобы понять надо чтобы тебе на примере показали хотя бы что -то...чего у нас нет...