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

[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

[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