Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача с графами
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Ольга
Пожалуйста, очень нужно!
Задаем количество вершин, какая с какой соединяется(каждой присваивается номер) и главную вершину.Необходимо вывести кол-во достижимых и недостижимых от главной вершины и граф:вершины(с номером внутри) соединены стрелками(как задали), главная вершина-красного цвета,достижимые-синего,недостижимые-зеленого.(решить с использованием матрицы смежности).
Altair
Для решения этой задачи используют модифицированный алгоритм Флойда, носящий название "транзитивное замыкание матрицы" или Улгоритм Уоршала.

вот процедура...
type
graph=array[1..n,1..n] of boolean;

procedure warshall (var a: graph; c:graph);
var i,j,k:integer;
begin
for i:=1 to n do for j:=1 to n do a[i,j]:=c[i,j];

for k:=1 to n do
for i:=1 to n do
for j:=1 to n do
if a[i,j]=false then a[i,j]:=a[i,k] and a[k,j]
end;


Здесь
С- матрица стоимостей совпадает с матрицей смежности.
Т.е. c[i,j]=1 только если есть дуга i-j
в матрице а получим где есть 1 там есть путь от одной вершины к другой.
Матрица А как раз и будет транзитивным замыканием матрицы смежности.

Про Алгоритм Флойда, прочтешь здесь:
http://forum.pascal.net.ru/index.php?showt...indpost&p=40473

А вот графическая реализация если нужна, то стоит у Вольво попросить модуль для рисования наклонных стрелок smile.gif
Altair
Вот я тут поразвлекся, и к чему пришел.

граф взял этот,
но вершину 19 изолировал.

Матрицу смежности занес в файл g.txt - Нажмите для просмотра прикрепленного файла

Программа: (компилятор FPC)

{$apptype console}
{$mode delphi}
uses graph,wincrt;
const nn=100;
Var N,main_n:integer;
type
tgraph=array[1..nn,1..nn] of longint;

procedure warshall (var a: tgraph; c:tgraph);
var i,j,k:integer;
beginНажмите для просмотра прикрепленного файла
for i:=1 to n do for j:=1 to n do a[i,j]:=c[i,j];

for k:=1 to n do
for i:=1 to n do
for j:=1 to n do
If (a[i,k]+a[k,j]<a[i,j]) then a[i,j]:=a[i,k] + a[k,j]
end;

procedure ReadFileGraph(var a:tgraph);
var
i,j:integer; filename:string; f:text;
begin
Write('Enter file name:'); readln(filename);
writeln(' main N= '); readln(main_N);
Assign (f,filename); reset(f);
Readln(f,N);
For i:=1 to n do for j:=1 to n do
read(f,a[i,j]);
close(f);
end;

procedure ReadGraph(var a:tgraph);
var
i,j:integer;
begin
writeln('matriza smezhnosti');
write('n= ');readln(n);
writeln(' main N= '); readln(main_N);
For i:=1 to n do for j:=1 to n do
begin
write('G',i,',',j,'= ');
readln(a[i,j]);
end;
writeln;
end;

var
a,c:tgraph;
i,j,v:integer;
gd,gm:smallint;
k_sqrt:integer;
outstr_:string;
coord:array[1..nn] of record xc,yc:longint end;
const
x0=20; y0=20; size_:integer=80;
begin
ReadFileGraph( c );
warshall(a,c);
gd:=d8bit;
gm:=m800x600;
initgraph(gd,gm,'');
k_sqrt:=round(sqrt(n));
I:=1; j:=1;
for v:=1 to n do begin
if (v<>main_n) and (a[v,main_n]=10000) then setcolor(green) else setcolor(blue);
if v=main_n then setcolor(red);
circle(x0+i*size_,y0+j*size_,5);
coord[v].xc:=x0+i*size_; coord[v].yc:=y0+j*size_;
str(v,outstr_);
outtextxy(x0+i*size_,y0+j*size_-10,outstr_);
if i=k_sqrt then inc(j);
if i<k_sqrt then inc(i) else i:=1;
end;
setcolor(15);
for i:=1 to n do for j:=1 to n do begin
if (c[i,j]<10000) and (i<>j) then
line(coord[i].xc,coord[i].yc,coord[j].xc,coord[j].yc);
end;

readln;
end.


EXE и исходник в архиве - Нажмите для просмотра прикрепленного файла

В результате получилось для данного графа:
Нажмите для просмотра прикрепленного файла

Единственно чего нет - стрелок... доработайте... и посмотрите, возможны какие-то глюки, я только на этом грфе тестировал.
Но главное алгоритмы...

p.s. если надо для TP, можно удет переделать...
p..s на скрине возможно цвета не различимы, но все как надо, это при сжатии рисунка исказилось

Добавил позже.
насчет вывод графа на экран.
я выодил по сетке.. может быть будет красивее если сделать по рандому от размера экрана.. тогда распределение будет всегда равномерным....
volvo
Ольга,
в присоединенном файле - адаптация программы Altair-а для Турбо-Паскаля. Обрати внимание: значение константы nn уменьшено до 50, иначе будет ошибка компилятора "Слишком много данных". Кроме этого, первой строкой программы должно быть:
{$n+}
, иначе моя процедура не будет работать...
Ольга
Когда я пытаюсь запустить программу выдается Error 200: Division by zero.
Ольга
Я не то запускала. А как сделать, чтобы вершины шли по кругу, запрашивалось кол-во вершин и как они соединяются?
volvo
Ольга, для этого надо было все это указывать СРАЗУ в задании. Сколько раз можно повторять? Сделать программу сложно, ПЕРЕДЕЛЫВАТЬ - еще сложнее.
Altair
Цитата
Когда я пытаюсь запустить программу выдается Error 200: Division by zero.

Модуль CRT пропатчите.
Цитата
Сделать программу сложно, ПЕРЕДЕЛЫВАТЬ - еще сложнее.

Дейтсвительно, ну что такое ? mad.gif :sad:
what are the risks of taking gab
Precio De Levitra En Farmacias
where can i buy prednisone witho
Canadian Pharmacies Nexium
hydroxychloroquine for sale onli
Cialis For Sale From Canada
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.