Algoritmo de Floyd
Amílcar José Escobedo Pérez
Renata Monsiváis Salas
Ixchel Sampayo Gutiérrez
Sergio Roberto Hernández Gallardo
15 marzo 2019
La función
Nuestro equipo programó una función de R que realiza el algoritmo de Floyd para hallar las rutas más cortas en una red.
Código R
El código se muestra a continuación:
FloydRapido<-function(A){
# Esto es para instalar paquetes nadamás:
if(!"dplyr"%in%rownames(installed.packages())){
install.packages("dplyr")
}
require(dplyr)
# Extraemos el número de nodos de la red:
n<-ncol(A)
# Construimos la matriz C para iterar:
C<-A
C[C==0]<-Inf;diag(C)<-0
# Definimos la matriz Z de recuperación de rutas:
Z<-1:n;Z<-rep(Z,n)
Z<-matrix(Z,ncol = n)
# Definimos la variable que indica si el proceso terminó
# en las n iteraciones o antes.
exited<-FALSE
# Un nodo que está en un circuito de longitud negativa:
neg.length<-NULL
# Corremos las n iteraciones que exige el algoritmo.
for(i in 1:n){
# Aquí sólo estamos extrayendo los índices de los
# elementos de la columna i distintos de infinito e i.
Reng<-C[,i]%>%is.finite%>%which
Reng<-Reng[Reng%>%(function(x) x!=i)%>%which] %>% unname()
# Misma cosa sólu que con los índices del renglón i.
Colu<-C[i,]%>%is.finite%>%which
Colu<-Colu[Colu%>%(function(x) x!=i)%>%which] %>% unname()
if(length(Colu)>0&length(Reng)>0){
# AUX es una matriz auxiliar que tiene las entradas
# por analizar.
AUX<-C[Reng,Colu] %>% unname() %>% matrix(nrow=length(Reng),ncol=length(Colu))
# Sumas contiene las C_{ki}+C_{il}
Sumas<-outer(C[Reng,i],C[i,Colu],FUN = function(x,y)x+y) %>% unname()
# Comparamos entrada a entrada ambas matrices y
# actualizamos las entradas de C que haya que
# actualizar.
C[Reng,Colu]<-pmin(Sumas,AUX)
# Si hubo cambio se actualizan las entradas correspondientes
# de Z.
Z[Reng,Colu]<-Z[Reng,Colu]*(Sumas>=AUX)+Z[rep(i,length(Reng)),Colu]*(Sumas<AUX)
# Revisamos que no haya negativos en la diagonal:
if(any(diag(C)<0)){
exited<-TRUE
neg.length<-C%>%diag%>%(function(x) which(x<0))
break()
}
}else{
next()
}
}
# Juntamos las matrices de distancias y recuperación de
# rutas finales, el estatus de salida, el # de iteraciones
# y el nodo en el C de long. negativa si lo hay.
respuesta<-list(
C=C,
Z=Z,
exited=exited,
neg.length=neg.length,
iter=i
)
# Regresamos la lista con las salidas deseadas.
return(respuesta)
}Correr con un ejemplo
Vamos a descomponer en pasos y correr sobre una red concreta.
Considere la siguiente red: 
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 0 1 0 0 0 0 0 0 0
## [2,] 0 0 1 0 0 1 0 0 0
## [3,] 0 0 0 0 0 0 0 0 0
## [4,] 0 0 0 0 0 0 0 0 0
## [5,] 0 0 0 1 0 0 1 1 0
## [6,] 0 0 0 0 1 0 0 0 1
## [7,] 0 0 0 0 0 0 0 0 0
## [8,] 0 0 0 0 0 0 0 0 0
## [9,] 0 0 0 0 0 0 0 0 0Paso 1
Definir la C y Z iniciales.
if (!"dplyr" %in% rownames(installed.packages())) {
install.packages("dplyr")
}
require(dplyr)
n <- ncol(A)
C <- A
C[C == 0] <- Inf
diag(C) <- 0
Z <- 1:n
Z <- rep(Z, n)
Z <- matrix(Z, ncol = n)
exited <- FALSE
neg.length <- NULL
C;Z## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 0 1 Inf Inf Inf Inf Inf Inf Inf
## [2,] Inf 0 1 Inf Inf 1 Inf Inf Inf
## [3,] Inf Inf 0 Inf Inf Inf Inf Inf Inf
## [4,] Inf Inf Inf 0 Inf Inf Inf Inf Inf
## [5,] Inf Inf Inf 1 0 Inf 1 1 Inf
## [6,] Inf Inf Inf Inf 1 0 Inf Inf 1
## [7,] Inf Inf Inf Inf Inf Inf 0 Inf Inf
## [8,] Inf Inf Inf Inf Inf Inf Inf 0 Inf
## [9,] Inf Inf Inf Inf Inf Inf Inf Inf 0## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 1 1 1 1 1 1 1 1 1
## [2,] 2 2 2 2 2 2 2 2 2
## [3,] 3 3 3 3 3 3 3 3 3
## [4,] 4 4 4 4 4 4 4 4 4
## [5,] 5 5 5 5 5 5 5 5 5
## [6,] 6 6 6 6 6 6 6 6 6
## [7,] 7 7 7 7 7 7 7 7 7
## [8,] 8 8 8 8 8 8 8 8 8
## [9,] 9 9 9 9 9 9 9 9 9Paso 2
Correr las n iteraciones, aquí sólo haremos la segunda para convencernos de que el algoritmo hace lo que se quiere.
La matriz C tras la primera iteración es:
C## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 0 1 Inf Inf Inf Inf Inf Inf Inf
## [2,] Inf 0 1 Inf Inf 1 Inf Inf Inf
## [3,] Inf Inf 0 Inf Inf Inf Inf Inf Inf
## [4,] Inf Inf Inf 0 Inf Inf Inf Inf Inf
## [5,] Inf Inf Inf 1 0 Inf 1 1 Inf
## [6,] Inf Inf Inf Inf 1 0 Inf Inf 1
## [7,] Inf Inf Inf Inf Inf Inf 0 Inf Inf
## [8,] Inf Inf Inf Inf Inf Inf Inf 0 Inf
## [9,] Inf Inf Inf Inf Inf Inf Inf Inf 0Comenzamos la iteración 2.
i<-2
# Aquí sólo estamos extrayendo los índices de los
# elementos de la columna i distintos de infinito e i.
Reng<-C[,i]%>%is.finite%>%which
Reng<-Reng[Reng%>%(function(x) x!=i)%>%which] %>% unname()
Reng## [1] 1 # Misma cosa sólu que con los índices del renglón i.
Colu<-C[i,]%>%is.finite%>%which
Colu<-Colu[Colu%>%(function(x) x!=i)%>%which] %>% unname()
Colu## [1] 3 6 # Condición para ver si podemos modificar algo:
length(Colu)>0&length(Reng)>0## [1] TRUE if(length(Colu)>0&length(Reng)>0){
# AUX es una matriz auxiliar que tiene las entradas
# por analizar.
AUX<-C[Reng,Colu] %>% unname() %>%
matrix(nrow=length(Reng),ncol=length(Colu))
# Sumas contiene las C_{ki}+C_{il}
Sumas<-outer(C[Reng,i],C[i,Colu],FUN = function(x,y)x+y) %>% unname()
# Comparamos entrada a entrada ambas matrices y
# actualizamos las entradas de C que haya que
# actualizar.
C[Reng,Colu]<-pmin(Sumas,AUX)
# Si hubo cambio se actualizan las entradas correspondientes
# de Z.
Z[Reng,Colu]<-Z[Reng,Colu]*(Sumas>=AUX)+Z[rep(i,length(Reng)),Colu]*(Sumas<AUX)
# Revisamos que no haya negativos en la diagonal:
if(any(diag(C)<0)){
exited<-TRUE
neg.length<-C%>%diag%>%(function(x) which(x<0))
# break()
}
}else{
# next()
}
AUX;Sumas## [,1] [,2]
## [1,] Inf Inf## [,1] [,2]
## [1,] 2 2 C;Z## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 0 1 2 Inf Inf 2 Inf Inf Inf
## [2,] Inf 0 1 Inf Inf 1 Inf Inf Inf
## [3,] Inf Inf 0 Inf Inf Inf Inf Inf Inf
## [4,] Inf Inf Inf 0 Inf Inf Inf Inf Inf
## [5,] Inf Inf Inf 1 0 Inf 1 1 Inf
## [6,] Inf Inf Inf Inf 1 0 Inf Inf 1
## [7,] Inf Inf Inf Inf Inf Inf 0 Inf Inf
## [8,] Inf Inf Inf Inf Inf Inf Inf 0 Inf
## [9,] Inf Inf Inf Inf Inf Inf Inf Inf 0## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 1 1 2 1 1 2 1 1 1
## [2,] 2 2 2 2 2 2 2 2 2
## [3,] 3 3 3 3 3 3 3 3 3
## [4,] 4 4 4 4 4 4 4 4 4
## [5,] 5 5 5 5 5 5 5 5 5
## [6,] 6 6 6 6 6 6 6 6 6
## [7,] 7 7 7 7 7 7 7 7 7
## [8,] 8 8 8 8 8 8 8 8 8
## [9,] 9 9 9 9 9 9 9 9 9Resultado
FloydRapido(A)$C## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 0 1 2 4 3 2 4 4 3
## [2,] Inf 0 1 3 2 1 3 3 2
## [3,] Inf Inf 0 Inf Inf Inf Inf Inf Inf
## [4,] Inf Inf Inf 0 Inf Inf Inf Inf Inf
## [5,] Inf Inf Inf 1 0 Inf 1 1 Inf
## [6,] Inf Inf Inf 2 1 0 2 2 1
## [7,] Inf Inf Inf Inf Inf Inf 0 Inf Inf
## [8,] Inf Inf Inf Inf Inf Inf Inf 0 Inf
## [9,] Inf Inf Inf Inf Inf Inf Inf Inf 0FloydRapido(A)$C %>% lattice::levelplot()
FloydRapido(A)$C %>% graph_from_adjacency_matrix() %>%
plot(edge.arrow.size=0.4)