Версия для печати темы

Автор: Ольга 27.10.2005 19:58

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

Автор: Altair 27.10.2005 20:06

Для решения этой задачи используют модифицированный алгоритм Флойда, носящий название "транзитивное замыкание матрицы" или Улгоритм Уоршала.

вот процедура...

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?showtopic=4030&view=findpost&p=40473

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

Автор: Altair 28.10.2005 0:14

Вот я тут поразвлекся, и к чему пришел.

граф взял http://forum.pascal.net.ru/index.php?act=Attach&type=post&id=878,
но вершину 19 изолировал.

Матрицу смежности занес в файл g.txt -  g.txt ( 2.11 килобайт ) Кол-во скачиваний: 617


Программа: (компилятор 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[attachmentid=1574]
 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 и исходник в архиве -  Bin.rar ( 24.97 килобайт ) Кол-во скачиваний: 481


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


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

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

Добавил позже.
насчет вывод графа на экран.
я выодил по сетке.. может быть будет красивее если сделать по рандому от размера экрана.. тогда распределение будет всегда равномерным....

Автор: volvo 28.10.2005 5:08

Ольга,
в присоединенном файле - адаптация программы Altair-а для Турбо-Паскаля. Обрати внимание: значение константы nn уменьшено до 50, иначе будет ошибка компилятора "Слишком много данных". Кроме этого, первой строкой программы должно быть:

{$n+}

, иначе моя процедура не будет работать...


Прикрепленные файлы
 GRAPHOUT.PAS ( 3.54 килобайт ) Кол-во скачиваний: 345

Автор: Ольга 31.10.2005 19:52

Когда я пытаюсь запустить программу выдается Error 200: Division by zero.

Автор: Ольга 31.10.2005 20:05

Я не то запускала. А как сделать, чтобы вершины шли по кругу, запрашивалось кол-во вершин и как они соединяются?

Автор: volvo 31.10.2005 20:09

Ольга, для этого надо было все это указывать СРАЗУ в задании. Сколько раз можно повторять? Сделать программу сложно, ПЕРЕДЕЛЫВАТЬ - еще сложнее.

Автор: Altair 31.10.2005 20:13

Модуль CRT пропатчите.

Дейтсвительно, ну что такое ? :sad:

Автор: what are the risks of taking gab 11.10.2021 22:53

Precio De Levitra En Farmacias

Автор: where can i buy prednisone witho 14.11.2021 8:36

Canadian Pharmacies Nexium

Автор: hydroxychloroquine for sale onli 6.12.2021 12:11

Cialis For Sale From Canada