Задача с графами Опции

[Ольга]

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

[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.pascalnet.ru/index.php?showt...indpost&p=40473

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

[Altair]

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

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

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


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


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


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

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

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

[volvo]

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

{$n+}

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

[Ольга]

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

[Ольга]

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

[volvo]

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

[Altair]

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

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

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

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