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

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

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

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

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

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

граф взял этот,
но вершину 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 на скрине возможно цвета не различимы, но все как надо, это при сжатии рисунка исказилось

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

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

{$n+}

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

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

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

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

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

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

Precio De Levitra En Farmacias

Canadian Pharmacies Nexium

Cialis For Sale From Canada