IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Графы, Графы
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Доброго времени суток.
Сделал вот прогу, но она почему-то не работает. Помогите в решении проблемы.

Вот условие:
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.



Заранее благодарю за помощь.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


У меня проблема с процедурой создания дуги, а именно я сам хочу выбирать вершины графа между которыми буду создавать дугу.
Также у меня есть сомнения в работе процедуры удаления вершины графа: почемуто не удаляется вершина с заланным значением.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 18.01.2021 7:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name