Если не сложно, проверьте правильность написания программы..., Это не должно занять много времени. Заранее благодарна. Опции

[Shymoda]

Ориентированный граф задан матрицей инцидентности. По заданной матрице сформировать список окрестностей вершин графа. По сформированному списку окрестностей вершин определить степени захода всех вершин графа и вершину с максимальной степенью захода. Удалить вершину с максимальной степенью захода вместе со смежными ей вершинами из списка окрестностей.

Program EinZweinDrein;
Type
EU=^Elem;
Elem=Record
nv:integer;
adres:EU;
end;
Var M:array[1..10,1..20] of integer;
Kver,kdur,maxver,imax,kdel:integer;
BegSpis,St,Sp:EU;
Procedure OpenFileForRead;
Var F_in:Text;
i,j:integer;
Begin
Assign(F_in,'Matr.txt');
Reset(F_in);
Kver:=0; Kdur:=0; i:=0;
While not Eof(F_in) do
Begin
Inc(i); j:=0;
While not Eoln(F_in) do
Begin
Inc(j);
Read(F_in,M[i,j]);
End;
Readln(F_in);
Kdur:=j;
End;
Kver:=i;
End;
Procedure VivodMatric;
Var i,j:integer;
Begin
For i:=1 to kver do
Begin
For j:=1 to kdur do
Write(M[i,j]:3);
End;
End;
Procedure Formirovanie;
Var i,j,k:integer;
Begin
New(St);
BegSpis:=St;
For i:=1 to kver do
Begin
St^.nv:=-i;
Sp:=St;
New(St);
Sp^.adres:=St;
For j:=1 to kdur do
If M[i,j]=1 then
For k:=1 to kver do
If M[k,j]=-1 then
St^.nv:=k;
End;
Sp^.adres:=nil;
End;
Procedure VivodSpis;
Begin
St:=BegSpis;
While St<>Nil do
Begin
Write(St^.nv,' ');
St:=St^.adres;
End;
End;
Procedure StepZah;
Var A:array[1..10] of integer;
i:integer;
Begin
For i:=1 to kver do
A[i]:=0;
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv>0 then
A[st^.nv]:=A[st^.nv]+1;
St:=St^.adres;
End;
Writeln('Stepeni zahoda');
For i:=1 to kver do
Writeln(i,' ',A[i]);
Maxver:=A[1];
Imax:=1;
For i:=2 to kdur do
If Maxver<A[i] then
Begin
Maxver:=A[i];
Imax:=i;
End;
Maxver:=Imax;
Writeln('Maxver=',Maxver);
End;
Procedure DeleteElem;
Var K:array[1..10] of integer;
i:integer;
Begin
St:=BegSpis;
Kdel:=0;
While St<>Nil do
Begin
If St^.nv=-maxver then
Kdel:=Kdel+1;
K[kdel]:=maxver;
St:=St^.adres;
If (St<>Nil) and (st^.nv>0) then
Begin
K[kdel]:=St^.nv;
St:=St^.adres;
End;
Break;
End;
For i:=1 to kdel do
Begin
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv=-K[i] then
Begin
If St=BegSpis then
BegSpis:=St^.adres
Else
Begin
Sp^.adres:=St^.adres;
St:=Sp;
End;
St:=St^.adres;
While (St<>Nil) and (St^.nv>0) do
Begin
If St=BegSpis then
BegSpis:=St^.adres
Else
Begin
Sp^.adres:=St^.adres;
Sp:=St;
End;
Sp:=St;
St:=St^.adres;
End;
End
Else if Sp^.adres=St^.adres then
Begin
Sp^.adres:=St^.adres;
St:=Sp;
End;
Sp:=St;
St:=St^.adres;
End;
End;
End;
Begin
OpenFileForRead;
VivodMatric;
Formirovanie;
VivodSpis;
StepZah;
DeleteElem;
VivodSpis;
End.

М

Просьба использовать тэги кода при публикации программного текста. Lapp

[volvo]

Shymoda, погоди... Что твоя программа делает вообще? Ты ее хотя бы запускала? Она ж у тебя вылетает при выполнении DeleteElem. А выводит вообще непонятно что. Ну, допустим, единственное, что она делает правильно - это вводит исходную матрицу инцидентности (если добавить Writeln куда нужно). Вот лог работы твоей программы с произвольной матрицей инцидентности (нарисовал граф "с потолка" и заполнил значения матрицы):

 -1  0  0  0 -1  0  0  0
  1 -1 -1  0  0  0  0  0
  0  1  0  1  0  0  0  0
  0  0  1  1  0 -1 -1  0
  0  0  0  0  1  1  0 -1
  0  0  0  0  0  0  1  1
-1 -2 -3 -4 -5 -6 Stepeni zahoda
1 0
2 0
3 0
4 0
5 0
6 0
Maxver=7

И что здесь означает этот список? Что значат полученные степени захода? Это надо понимать так, что ни одна вершина вообще в графе не присутствует? С чего тогда вывод о том, что максимальная степень захода именно у седьмой вершины? В представленном графе, кстати, вершин с макс. степенью захода сразу три: №4, №5 и №6, а седьмой вершины в графе нет совсем...

Дальше: Почему ты все пишешь в один список окрестностей? Список окрестностей, если я не ошибаюсь, строится для каждой вершины отдельно...

[Shymoda]

А-а... сорри...был косяк в процедуре формирования списка. Уже нашла, спс.
Щас попробую с остальным разобраться.
Там весь фокус в том, что тут по заданию список окрестностей для всех вершин составить надо.

[Shymoda]

Все, разобралась). Исправила).
Все процедуры выполняются верно.
Но все равно вылетает на DeleteElem.
Честно говоря, как-то не соображу так сразу почему...

[volvo]

Честно говоря, как-то не соображу так сразу почему...

Ну, ты бы показала новую процедуру формирования списка, может вместе и разберемся, почему DeleteElem глючит...

Добавлено через 6 мин.
Старая версия вылетала, потому что у тебя не хватало begin/end, как я понимаю:

Procedure DeleteElem;
Var K:array[1..10] of integer;
i:integer;
Begin
  St:=BegSpis;
  Kdel:=0;
  While St<>Nil do Begin
    If St^.nv=-maxver then BEGIN { <--- }
      Kdel:=Kdel+1;
      K[kdel]:=maxver;
    END; { <--- }
  St:=St^.adres;
  If (St<>Nil) and (st^.nv>0) then Begin
    K[kdel]:=St^.nv;
    St:=St^.adres;
  End;
  Break;
End;
...

А теперь подумай, что у тебя происходило, когда этих begin/end не было? На первой же итерации обращение к 0-му элементу массива (а массив-то описан с индексами 1 .. 10) - давало тебе вылет...

[Shymoda]

Ага... все исправлено... терь работает).
Благодарю).

[Shymoda]

И еще такое дело...
В текстовом режиме программа работает. Тут вопросов нет.
Есть вопросы по реализации данного алгоритма в графическом режиме.
Конкретно - создание меню.
Какой способ был бы наиболее быстрым и простым?
И как будет выглядеть в графическом режиме, допустим, вывод матрицы на экран?
Мне просто не доводилось пока что изучать модуль GRAPH, поэтому представление о его возможностях имею весьма слабое...

[volvo]

Какой способ был бы наиболее быстрым и простым?

Организация меню в программах
Зайди и посмотри...

[Shymoda]

И... вот процедура как бы самого графа рисования.
Ну как бы по списку окрестностей.
В целом рисует, но в самом конце спотыкается.
Никак не пойму, в чем проблема.
В принципе, у меня загвоздка только в ней.
Буду благодарна, если поможете разобраться.

Procedure RisGraph(xc,yc:integer);
Var UG,R,R1:real;
i,k,g,j:integer;
Xk,Yk,xkv,ykv,k,g:array[1..5] of integer;
Sn:string;
Begin
UG:=(2*Pi)/kver;
R:=50;
R1:=70;
For i:=1 to kver do
Begin
Xk[i]:=Round(R*cos(UG*i) + xc);
Yk[i]:=Round(R*sin(UG*i) + yc);
Xkv[i]:=Round(R1*cos(UG*i) + xc);
Ykv[i]:=Round(R1*sin(UG*i) + yc);
Setcolor(Black);
Circle(xk[i],yk[i],4);
Str(i,sn);
Setcolor(Cyan);
Outtextxy(xkv[i],ykv[i],sn);
End;
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv<0 then
K:=abs(St^.nv);
St:=St^.adres;
If St^.nv>0 then
Begin
While St^.nv>0 do
Begin
G:=St^.nv;
SetLineStyle(0,0,1);
SetColor(Red);
Line(xk[k],yk[k],xk[g],yk[g]);
St:=St^.adres;
End;
End;
End;
End;

М

Просьба использовать тэги code=pas, а не цитату. Сколько можно просить об одолжении выполнять Правила? Lapp

[Shymoda]

А, кстати, уже не надо, разобралась...