Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.141.2.96] |
|
Сообщ.
#1
,
|
|
|
Есть у кого готовые реализации на Pascal? )
http://alglib.sources.ru/graphs/ - тут сами алгоритмы |
Сообщ.
#2
,
|
|
|
Алгоритм Йена я не знаю. другие могу реальзовать. Начнем с самого простого. Флойда.
Пусть у тебя есть матрица смежности графа a[i,j] и n-кол-во ребер. тогда: ... for k := 1 to n do for i := 1 to n do for j := 1 to n do if a[i,j]>a[i,k]+a[k,j] then a[i,j]:=a[i,k]+a[k,j]; ... Теперь форд беллман type trebro=record a,b,r:longint; var a:array[1..m] of trebro; //список ребер графа d:array[1..n] of longint; //расстояние до n-й вершины. //m-кол-во ребер; n-кол-во вершин. ... fillchar(d,sizeof(d),бесконечность); //:) d[q]:=0;//расстояние до начальной вершины for i := 1 to n-1 do for j := 1 to m do if d[a[j].b]>d[a[j].a]+a[j].r then d[a[j].b]:=d[a[j].a]+a[j].r; ... теперь дейкстра. var a:array[1..n,1..n] of longint;//матрица смежности (-1 нет ребра) b:array[1..100,a..100]of boolean;//список просмотренных вершин d:array[1..n] of longint;//расстояния ... fillchar(b,sizeof(b),0); fillchar(d,sizeof(d),бесконечность); //:) d[q]=0;//расстояние до начальной вершины for i:=1 to n do begin m:=1000; for j:=1 to n do if ((d[j]<=m)and(not b[j])) then begin m:=d[j]; v:=j; end; b[v]:=true; for j:=1 to n do if ((a[v,j]<>-1)and(not b[j])and (d[v]+a[v,j]<d[j])) then d[j]:=d[v]+a[v,j]; end; если надо могу еще выложить хип дейкстру. |
Сообщ.
#3
,
|
|
|
Я дико извиняюсь что поднимаю эту тему, но в правилах я не видел что можно поднимать старые темы )
У меня таже проблема, нужно найти кратчайшие пути между всеми вершинами графа. Применил алгоритм Флойда в своем проекте. procedure TMain.N19Click(Sender: TObject); var k,i,j,n:integer; begin n:=0; for I := 0 to length(CGYMatrix)-1 do for j := 0 to length(CGYMatrix)-1 do begin if CGYMatrix[i,j]<>0 then inc(n); end; n:=round(n/2); form3.memo1.Clear; form3.Memo1.Lines.Add('Кратчайший путь по алгоритму Флойда:'); for k := 1 to n do for i := 1 to n do for j := 1 to n do if CGYMatrix[i,j]>CGYMatrix[i,k]+CGYMatrix[k,j] then memo1.Lines.Add(inttostr(CGYMatrix[i,k]+CGYMatrix[k,j])); end; CGYMatrix - Матрица смежности n:=round(n/2); - нахожу количество ребер в графе. При выполнение кода, в memo выходится куча 0 в столбик (( |
Сообщ.
#4
,
|
|
|
В первых циклах нумерация с нуля, а во вторых- с единицы?
И почему циклы до n, если это не размер матрицы, а количество ненулевых элементов? |
Сообщ.
#5
,
|
|
|
И это
for k := 1 to n do for i := 1 to n do for j := 1 to n do if CGYMatrix[i,j]>CGYMatrix[i,k]+CGYMatrix[k,j] then memo1.Lines.Add(inttostr(CGYMatrix[i,k]+CGYMatrix[k,j])); Одно из многочисленных описаний алгоритма. |
Сообщ.
#6
,
|
|
|
Цитата Федосеев Павел @ И это for k := 1 to n do for i := 1 to n do for j := 1 to n do if CGYMatrix[i,j]>CGYMatrix[i,k]+CGYMatrix[k,j] then memo1.Lines.Add(inttostr(CGYMatrix[i,k]+CGYMatrix[k,j])); Одно из многочисленных описаний алгоритма. Спасибо за ссылочку. По ссылки приведенные примеры на C. А по мимо того что я плохо знаю этот язык так там еще все через вектора... нет ли ссылки на эти же алгоритмы в delphi? ) |
Сообщ.
#7
,
|
|
|
На другом форуме полгода назад в вашей теме я приводил реализацию на Pascal алгоритма Флойда-Уоршелла.
{Реализация алгоритма Флойда-Уоршелла} program FloydWarshall; const n = 5; {количество вершин графа} INFINITY = MaxInt; type TRow = array [0..n - 1] of integer; TVertex = array [0..n - 1] of TRow; const Vertex1: TVertex = ( (0, 0, 5, 0, 0), (7, 0, 0, 0, 10), (0, 7, 0, 0, 0), (0, 0, 6, 0, 4), (0, 0, 1, 0, 0) ); Vertex2: TVertex = ( (0, 3, 2, 0, 0), (0, 0, 0, 4, 0), (0, 0, 0, 6, 0), (0, 0, 0, 0, 2), (0, 0, 0, 0, 0) ); procedure FloydWarshall(v: TVertex; n: integer; var d, p: TVertex); var i, j, k: integer; begin { матрицу веса дуги преобразуем в требуемый для алгоритма вид - если i=j, то d[i, j]:=0 - если из i в j нет ребра, то d[i, j]:=INFINITY (бесконечности) - иначе d[i, j] равно весу ребра из i в j подготовим матрицу для восстановления пути p } d := v; for i := 0 to pred(n) do for j := 0 to pred(n) do begin if d[i, j] = 0 then d[i, j] := INFINITY; if i = j then d[i, j] := 0; p[i, j] := j; end; for k := 0 to pred(n) do begin for i := 0 to pred(n) do begin for j := 0 to pred(n) do begin if (d[i, k] <> INFINITY) and (d[k, j] <> INFINITY) then begin if (d[i, j] > d[i, k] + d[k, j]) then begin d[i, j] := d[i, k] + d[k, j]; p[i, j] := p[i, k]; end; end; end; end; end; end; procedure RestorePath(const D, P: TVertex; n: integer; A, B: integer); var k: integer; begin if A >= n then begin writeln('The vertex A is out of range.'); exit; end; if B >= n then begin writeln('The vertex B is out of range.'); exit; end; if D[A, B] = INFINITY then begin writeln('There is not a path from vertex ', A, ' to vertex ', B, '.'); exit; end; Write('The path from vertex ', A, ' to vertex ', B, ' is: <'); Write(A: 4); k := A; while k <> B do begin k := p[k, B]; Write(k: 4); end; writeln('>'); end; procedure ShowMatrix(const M: TVertex; n: integer); var i, j: integer; begin for i := 0 to pred(n) do begin for j := 0 to pred(n) do begin if M[i, j] <> INFINITY then Write(M[i, j]: 4) else Write('inf': 4); end; writeln; end; end; procedure TestAlgoFW(const Vertex: TVertex; n: integer); var D, P: TVertex; begin FloydWarshall(Vertex, n, D, P); writeln('Vertex matrix:'); ShowMatrix(Vertex, n); writeln('Distance matrix:'); ShowMatrix(D, n); writeln('Path matrix:'); ShowMatrix(P, n); RestorePath(D, P, n, 3, 1); RestorePath(D, P, n, 0, 3); RestorePath(D, P, n, 3, 3); end; begin TestAlgoFW(Vertex1, n); TestAlgoFW(Vertex2, n); end. |