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

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

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

> Эйлеров цикл в графе, Графически изобразить
FENIX
сообщение 15.05.2005 18:13
Сообщение #1


Новичок
*

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

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


Задание: построение Эйлерова цикла в неориентированном графе, заданном матрицей инцидентности.
Проблема: процедуру Эйлерова цикла нам дали готовую (она перечисляет вершины), вот только не могу графически на экране изобразить преобразованный граф.

Program Lab;

Uses Crt,Graph;

const Qt = 20;

var st : string;
k1 : integer;
{-------------------------- Begin Stack -------------------------------}

const NL = 1000;

Type Number = 0..NL;
Type Stack = object
Elements: array [1..NL] of integer;
Last: Number;
Constructor Init;
Function Push (Dn : integer) : boolean;
Function Empty : boolean;
Function Pop (var Dn:integer): boolean;
Procedure Print;
end;

Constructor Stack.Init;
begin
Last:=0;
end;

Function Stack.Push(Dn : integer): boolean;
begin
If Last < NL then
begin
Inc(Last);
Elements[Last] := Dn;
Push := true;
end
else Push := false;
end;

Function Stack.Empty : boolean;
begin
If Last = 0
then Empty := TRuE
else Empty := false;
end;

Function Stack.Pop (var Dn : integer): boolean;
var I : Number;
begin
If Empty then Pop := false
else
begin
Dn := Elements[Last];
Dec(Last);
Pop := true;
end;
end;

Procedure Stack.Print;
var I : Number;
begin
For I := 1 to Last do write(Elements[I]:3);
writeln;
end;


{----------------------------- Begin Graf -----------------------------}

const MaxVertex = 100;
MaxEdges = 500;
x0 = 320;
y0 = 240;
R = 200;

Type
Edge = record
From, Into : integer;
end;

Graf = object
KolVertex : 0..MaxVertex;
KolEdges : 0..MaxEdges;
Edges:array [1..MaxEdges] of Edge;
Used: array [1..MaxVertex] of boolean;
Numbers: array [1..MaxVertex] of integer;
coordX: array [1..MaxVertex] of integer;
coordY: array [1..MaxVertex] of integer;
Constructor Init(KV, KE : integer);
Function Get(var s : string) : string;
Procedure Print; {VbIvod grafa na ekran}
end;

Constructor Graf.Init(KV, KE : integer);
var i : integer;
begin
KolVertex := KV;
KolEdges := KE;
For i := 1 to KolVertex do
begin
Used[i] := false;
Numbers[i] := MaxInt;
coordX[i] := round(x0 + R*cos(2*pi*(i-1)/KolVertex));
coordY[i] := round(y0 - R*sin(2*pi*(i-1)/KolVertex));
end;
end;

Function Graf.Get(var s : string) : string;
begin
Get := s;
end;

Procedure Graf.Print;
var i, j, rad, rad1, vert,
x1, y1,
grDriver, grMode : integer;
f : boolean;
s : string;

const x0 = 460;
y0 = 80;
dins = 20;

begin
rad := 5;
rad1 := 8;
grDriver := Detect;
InitGraph(grDriver, grMode, '');
SetColor(15);
For i := 1 to KolVertex do
begin
Circle(coordX[i], coordY[i], rad);
str(i, s);
SetColor(Yellow);
OutTextXY(coordX[i] + round(13*cos(2*pi*(i-1)/KolVertex)),
coordY[i] - round(13*sin(2*pi*(i-1)/KolVertex)), s);
SetColor(15);
end;
For i := 1 to KolEdges do
For j := 1 to KolVertex do
begin
f := true;
If Edges[i].From = j
then vert := Edges[i].Into
else
If Edges[i].Into = j
then vert := Edges[i].From
else f := false;
If f then
begin
SetColor(9);
Line(coordX[j], coordY[j], coordX[vert], coordY[vert]);
end;
SetColor(15);
end;
readln;
CloseGraph;
end;

{--------------------------------------------------------------------------}
var Gra : Graf;

Function Another(NE, First : integer; var Second : integer) : boolean;
begin
Another := true;
with Gra.Edges[NE] do
begin
If From = First then Second := Into
else
If Into = First then Second := From
else Another := false;
end;
end;

Procedure DeleteEdge(Number : integer);
var i : integer;
begin
with Gra do
begin
dec(KolEdges);
For i := Number to KolEdges do Edges[i] := Edges[i + 1];
end;
end;

Function Euler(var Sta : Stack) : boolean;

Function SearchEdge(var Vertex, NumberEdge : integer) : boolean;
var I : integer;
begin
with Gra do
begin
SearchEdge := true;
For I := 1 to KolEdges do
If Another(I, Vertex, Vertex) then
begin
NumberEdge := I;
exit;
end;
SearchEdge := false;
end;
end;

var Sta1 : Stack;
Vertex, NumberEdge: integer;
s : string;

begin
Euler := false;
Sta.Init;
Sta1.Init;
Vertex := Gra.Edges[1].From;
write(Gra.Edges[1].Into);
While Gra.KolEdges > 0 do
If SearchEdge(Vertex, NumberEdge) then
begin
Sta.Push(Vertex);
DeleteEdge(NumberEdge);
end
else
If Sta.Pop(Vertex)
then Sta1.Push(Vertex)
else exit;
While Sta1.Pop(Vertex) do Sta.Push(Vertex);
Euler := true;
end;

const

Root = 4;

MS1 : array[1..6,1..6] of integer=
((1,0,1,0,0,1),
(0,1,0,0,0,0),
(0,0,1,0,0,0),
(0,1,0,1,0,1),
(0,0,0,1,1,0),
(1,0,0,0,1,0));



var i, j, k, t : integer;
sta1 : Stack;

BEGIN

with Gra do {Вот здесь рисую граф ДО преобразования}
begin
Init(6, 6);
k := 1;
for i := 1 to 6 do
for j := 1 to 5 do
for t := j + 1 to 6 do
begin
if (MS1[j,i] = 1) and (MS1[t,i] = 1)
then
begin
Edges[i].From := j;
Edges[i].Into := t;
Used[j] := true;
Used[t] := true;
Inc(k);
break;
end;
end;
Print;
end;

{Gra.Init(6, 6); Здесь надо нарисовать граф ПОСЛЕ построения ЭЦ}
sta1.Pop(i);
t := 1;
while not sta1.Empty do
begin
sta1.Pop(j);
with Gra do
begin
Edges[t].From := i;
Edges[t].Into := j;
writeln(i, ' ',j);
readln;
Used[i] := true;
Used[j] := true;
end;
i := j;
inc(t);
end;}
write('Euler cycle: '); {Отладочная инфа - простой вывод списка вершин}
Euler(sta1);
sta1.print;
readln;
{Gra.Print;}
END.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



- Текстовая версия 18.07.2025 5:37
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"