Правила форума
Прочтите прежде чем задавать вопрос!
Сделал вот прогу, но она почему-то не работает. Помогите в решении проблемы.
Вот условие:
1) Написать процедуру удаления из графа всех вершин с заданным значением информационного поля.
2) Написать процедуру «стягивания» в одну вершину всех вершин, информационное поле которых содержит заданное значение. При «стягивании» в графе остается только одна вершина, содержащая заданное значение, остальные вершины удаляются, но все исходящие из них и входящие в них дуги «передаются» оставшейся вершине. При этом петли, связывающие вершину с собой, не создаются. Не создаются также и параллельные дуги.
Вот код:
Program G4;
Uses
Crt;
Type
RefNode = ^Node;
RefArc = ^Arc;
Node = Record
ID : Integer;
InfNode : Integer;
Next : RefNode;
ArcList : RefArc;
END;
Arc = Record
InfArc : Integer;
Next : RefArc;
Adj : RefNode;
END;
Procedure Browse(Graph : RefNode);
Var
A : RefArc;
CountNode, CountArc : Integer;
BEGIN
CountNode := 0;
CountArc := 0;
While Graph <> NIL Do
BEGIN
WriteLn(' Top ',Graph^.ID,' with weight ',Graph^.InfNode);
Write(' ArcList: ');
A := Graph^.ArcList;
If A = NIL Then
Write('Empty');
While A <> NIL Do
BEGIN
WriteLn(' Arc to Top ',(A^.Adj)^.ID,' weight of Arc ', A^.InfArc);
CountArc := CountArc + 1;
A := A^.Next;
END;
CountNode := CountNode + 1;
Graph := Graph^.Next;
END;
WriteLn;
WriteLn(' In Graph: ',CountNode,' Top and ',CountArc,' Arc ');
END;
Procedure Destroy(Graph : RefNode);
Var
A, P : RefArc;
Q : RefNode;
BEGIN
While Graph <> NIL Do
BEGIN
A := Graph^.ArcList;
While A <> NIL Do
BEGIN
P := A^.Next;
Dispose(A);
A := P;
END;
Q := Graph^.Next;
Dispose(Graph);
Graph := Q;
END;
END;
Procedure AddNode(Var Graph : RefNode; NumberID, Weight : Integer);
Var
P : RefNode;
BEGIN
New(P);
With P^ Do
BEGIN
ID := NumberID;
InfNode := Weight;
ArcList := NIL;
Next := Graph;
END;
Graph := P;
END;
Procedure AddArc(U, V : RefNode; Weight : Integer);
Var
A : RefArc;
BEGIN
If (U = NIL) OR (V = NIL) Then
WriteLn(' Error : Top is not ')
Else
BEGIN
New(A);
With A^ Do
BEGIN
InfArc := Weight;
Adj := V;
Next := U^.ArcList;
END;
U^.ArcList := A;
END;
END;
Procedure DeleteArc(U, V : RefNode);
Var
A, Before : RefArc;
Run : Boolean;
BEGIN
If U <> NIL Then
BEGIN
A := U^.ArcList;
Run := True;
While (A <> NIL) AND Run Do
If A^.Adj = V Then
Run := False
Else
BEGIN
Before := A;
A := A^.Next;
END;
If A <> NIL Then
BEGIN
If A = U^.ArcList Then
U^.ArcList := A^.Next
Else
Before^.Next := A^.Next;
Dispose(A);
END;
END;
END;
Procedure DeleteNode(Var Graph : RefNode; V : RefNode);
Var
P, Q : RefNode;
A, After : RefArc;
BEGIN
P := Graph;
While P <> NIL Do
BEGIN
Q := P^.Next;
If P <> V Then
DeleteArc(P, V)
Else
BEGIN
If P = Graph Then
Graph := Q;
A := P^.ArcList;
While A <> NIL Do
BEGIN
After := A^.Next;
Dispose(A);
A := After;
END;
Dispose(P);
END;
P := Q;
END;
END;
Procedure Tightener(Var Graph : RefNode; V : RefNode);
Var
P, Q, R : RefNode;
A, After : RefArc;
BEGIN
P := Graph;
While P <> V Do
P := P^.Next;
R := P;
While P <> NIL Do
BEGIN
Q := P^.Next;
If P = V Then
BEGIN
If P = Graph Then
Graph := Q;
A := P^.ArcList;
While A <> NIL Do
BEGIN
After := A^.Next;
Dispose(A);
A := After;
END;
Dispose(P);
END;
P := Q;
END;
END;
Procedure Menu;
BEGIN
ClrScr;
WriteLn(' 1) Add element in Graph ');
WriteLn(' 2) Add Arc in Graph ');
WriteLn(' 3) Browse Graph ');
WriteLn(' 4) Delete element from Graph ');
WriteLn(' 5) Tightener of Graph ');
WriteLn(' 6) Destroy Graph ');
WriteLn(' 7) Exit ');
WriteLn;
Write(' Your choose: ');
END;
{=======MAIN PROGRAM=======}
Var
Graph, U, V : RefNode;
Selector, NumberID, Weight : Integer;
BEGIN
Repeat
Menu;
Read(Selector);
WriteLn;
Case Selector Of
1 : BEGIN
Write(' Enter ID of element: ');
ReadLn(NumberID);
Write(' Enter weight: ');
ReadLn(Weight);
AddNode(Graph, NumberID, Weight);
END;
2 : BEGIN
Write(' One to Two: ');
WriteLn;
Write('Enter weight of Arc: ');
ReadLn(Weight);
AddArc(Graph^.ID, Graph, Weight);
Write(' Two to One: ');
WriteLn;
Write('Enter weight of Arc: ');
ReadLn(Weight);
AddArc(Graph, Graph^.ID, Weight);
END;
3 : BEGIN
Browse(Graph);
ReadLn;
ReadLn;
END;
4 : BEGIN
Write(' Enter meaning of element: ');
ReadLn(V^.InfNode);
DeleteNode(Graph, V);
END;
5 : BEGIN
Write(' Enter meaning of element: ');
ReadLn(V^.InfNode);
Tightener(Graph, V);
END;
6 : Destroy(Graph);
7 : ClrScr;
END;
Until Selector = 7;
END.
Заранее благодарю за помощь.
