Olá amigos, estou tentando ainda criar o algorítimo de Floyd para o problema
do menor caminho, e consegui um arquivo feito em VB, porém não sei nada de
VB, alguém que saiba poderia "traduzir" para delphi?
Desde já agradeço a todos....
Segue o Module:
Attribute VB_Name = "Module1"
Public dist() As Single 'Array bidimensional para armazenar a matriz
de distancia
Public adj() As Integer 'Array bidimensional para armazenar a matriz
de adjacencia
Public adjprod() As Integer 'Array bidimensional para armazenar a
matriz de caminhos
Public num_vert As Integer 'Numero de vertices do grafo
Public i, j As Integer 'indices para as matrizes
Public allcells As String
Public Fnum, num_linhas As Integer
Public TxtBoxGotFocus As Boolean 'flag para controlar o foco na
apresentação de FormDados
Public Shortest() As Single 'Array bidimensional para armazenar as
distancias calculadas
'pelo algoritmo de Floyd
Public Caminho As String 'String para armazenar o caminho
Public para() As Single 'Array para armazenar o caminho temporario de
um vertice i ate um
'vertice j
Public lim_inferior As Integer
Public lim_superior As Integer
'Funcao para determinar a existencia de caminho entre os vertices do
grafo
'Não foi necessária neste contexto
Function Determina_Caminho(n As Integer) As Integer
Dim k As Integer
'Redimensionamento da matriz de adjacencia
ReDim adjprod(n, n)
'Inicialização das matrizes
For i = 1 To n
For j = 1 To n
adjprod(i, j) = adj(i, j)
Next j
Next i
'Multiplicação boolena
For k = 1 To n
For i = 1 To n
For j = 1 To n
adjprod(i, j) = adjprod(i, j) Or (adjprod(i, k) And
adjprod(k, j))
Next j
Next i
Next k
End Function
'Sub-rotina para inicialização da matriz de distancia
Sub init_mtDistancia(n As Integer)
'Redimensionamento da matriz de distancia
ReDim dist(n, n)
For i = 1 To n
For j = 1 To n
dist(i, j) = 3.402823E+38
Next j
Next i
End Sub
'Sub-rotina para inicialização da matriz de adjacencia
'Sub init_mtAdjacencia(n As Integer)
'Redimensionamento da matriz de adjacencia
' ReDim adj(n, n)
' For i = 1 To n
' For j = 1 To n
' adj(i, j) = 0
' Next j
' Next i
'End Sub
'Sub-rotina para desalocação de memória
Sub destrutor()
Erase dist
Erase adj
End Sub
'Sub-rotina para acrescimo de um arco.
Sub Add_Arco(d As Single, nodo_1 As Integer, nodo_2 As Integer)
'Ao ser acrescentado um arco, sera atribuido o valor 1 na matriz de
adjacencia
'para indicar que existe um caminho entre os dois arcos e o valor
deste arco na
'matriz de distancias
'adj(nodo_1, nodo_2) = 1 'nao foi necessaria neste contexto
dist(nodo_1, nodo_2) = d
End Sub
'Sub-rotina para remocao de um arco
Sub Rem_Arco(nodo_1 As Integer, nodo_2 As Integer)
'Ao ser removido...
'adj(nodo_1, nodo_2) = 0
dist(nodo_1, nodo_2) = 3.402823E+38 'flag para distancia infinita
End Sub
'Funcao para determinar o menor caminho pelo algoritmo de Floyd
Function Floyd(n As Integer) As Single
Dim u, v, w As Integer
Dim changed As Integer
'array bidimensional auxiliar
changed = 1
Max = num_vert
ReDim Shortest(n, n)
ReDim para(n, n)
For v = 1 To n
For w = 1 To n
Shortest(v, w) = dist(v, w)
para(v, w) = w
Next w
Next v
While changed 'Testa o valor de changed
changed = 0
For u = 1 To n
For v = 1 To n
For w = 1 To n
If Shortest(v, u) + Shortest(u, w) < Shortest(v, w) Then
Shortest(v, w) = Shortest(v, u) + Shortest(u, w)
para(v, w) = para(v, u)
changed = 1
End If
Next w
Next v
Next u
Wend
End Function
'Funcao para imprimir a rota
Function print_shortest(a As Integer, b As Integer) As String
Dim rota As String
Dim aux As String
While a <> b
rota = "->" + CStr(para(a, b))
aux = aux + rota
a = para(a, b)
Wend
print_shortest = aux
End Function
--
_________________________________
Fellipe Henrique
[EMAIL PROTECTED]
"Venham até a borda, ele disse.
Eles disseram: Nós temos medo.
Venham até a borda, ele insistiu.
Eles foram, Ele os empurrou...
E eles voaram."
(Guillaume Apollinaire)
[As partes desta mensagem que não continham texto foram removidas]
