Algoritmo de Ford & Fulkerson

Teoría de redes

Problema

Supongamos que tenemos un bien, o cierta cantidad de un bien el cual deseamos transportar del nodo fuente o nodo origen \(s\) a un nodo destino \(t\). A este problema se le asocia la red:

\(R=[X,A,q]\)

\(X=\{\text{poblados}\}\)

\(A=\{\text{Tramos de ductos que existen en la red}\}\)

\(q:A\rightarrow \mathbb{R}\).

Los nodos intermedios no generan oferta ni demanda, es decir, la cantidad del flujo que llega a cada nodo debe ser igual a la cantidad de flujo que sale de éste.

Pseudocódigo

Iniciar cualquier con flujo factible f.
Etiquetar el origen con \([s,\infty]\).
Elegir un vértice etiquetado no examinado; sea \(j\) este vértice y sea \([k,f(j)]\) su etiqueta.
A todo \(i\in \Gamma^{+}(j)\) que no esta etiquetado y que \(f_{ij}<q_{ij}\) asignar la etiqueta \([+j,f(i)]\) donde \[ f(i)=min\{f(j), q_{ij}-f_{ij}\} \]
A todo \(i\in \Gamma^{-}(j)\) que no este etiquetado y que \(f_{ij}>0\) asignar la etiqueta \([-j,f(i)]\) donde: \[ f_{ij}=min{f(j),f_{ij}} \]
Repertir hasta:

El nodo destino es etiquetado y se obtiene una cadena aumentante. Se actualiza el flujo e ir a paso 3.
El nodo destino no tiene etiqueta y todos los vértices con etiqueta ya estan examinados.

Ejemplo

Para ver con mas claridad como funciona el código paso a paso, explicaremos por partes el código aplicado a una red. Para ello, tomaremos una red con cotas inferiores iguales a cero y con un flujo factible de cero. Generamos la gráfica con: los arcos correspondientes, el flujo maximo y el flujo mínimo en cada arco, el nodo origen y el nodo destino.

Generamos una lista ordenada con los arcos que tiene la red, junto a la misma, colocamos las capacidades superiores y flujo por los arcos correspondientes.

Predecesor	Sucesor	q inicial
A	B	15
B	C	4
B	D	5
B	E	7
B	G	1
C	A	3
C	E	1
D	A	5
D	G	3
E	F	7
G	E	1
G	F	9

Actualizamos el flujo obtenido en la busqueda de cadenas aumentantes Generamos la matriz \(E\) iniciando en el nodo origen que nos indica:

Nodo predecesor.
Nodo que se está examinando.
Flujo que puede pasar actualmente.
Dirección del arco: 1 si se envia flujo y -1 si se regresa flujo.
Si el arco está o no examinado (1 ó 0 respectivamente).

Actualizamos el indicador de cadenas aumentantes. Iniciamos el contador de arcos examinados en cero.

código

f0<-f 
    E<-matrix(c(s,s,Inf,1,0),ncol = 5)
    colnames(E)<-c("Nodo","Pred","Disp","Direc","Perm")
    Aumentante<-0
    contador<-0
    E

##      Nodo Pred Disp  Direc Perm
## [1,] "A"  "A"  "Inf" "1"   "0"

Aumentamos el contador en uno. \(\texttt{I}\) nos arroja que nodo no ha sido examinado de acuerdo al orden de la lista \(\texttt{E}\)

\(\texttt{nodo}\) nos da el nodo que se va a examinar

\(\texttt{f.nodo}\) nos indica cuanto flujo se puede mandar a ese nodo.

código

contador<-contador+1
      I<-which(E[,5]==0) %>% unname() %>% as.numeric()
      I

## [1] 1

      nodo<-E[I[1],1] %>% unname()
      nodo

## [1] "A"

      f.nodo<-E[I[1],3] %>% unname() %>% as.numeric()
      f.nodo

## [1] Inf

Generamos dos conjuntos:

\(\texttt{G.1}\) Nodos que son sucesores del nodo que se esta examinando.
\(\texttt{G.2}\) Nodos que son predecesores del nodo que se esta examinando.

código

G.1<-which(E.list[,1]==nodo)
      G.1

## [1] 1

      G.2<-which(E.list[,2]==nodo)
      G.2

## [1] 6 8

      E.list

##       [,1] [,2]
##  [1,] "A"  "B" 
##  [2,] "B"  "C" 
##  [3,] "B"  "D" 
##  [4,] "B"  "E" 
##  [5,] "B"  "G" 
##  [6,] "C"  "A" 
##  [7,] "C"  "E" 
##  [8,] "D"  "A" 
##  [9,] "D"  "G" 
## [10,] "E"  "F" 
## [11,] "G"  "E" 
## [12,] "G"  "F"

Si el conjunto \(\texttt{G.1}\) no es vacio, procedemos a analizar los arcos que ya estan en su cota de flujo maximo y los eliminamos de la lista \(\texttt{G.1}\).

código

if(G.1 %>% length() >0){
        elim<-c()
        for(i in 1:length(G.1)){
          
          if(!f[G.1[i]]<q[G.1[i]]){
            elim<-append(elim,i)
          }
        }
        if(length(elim)>0){
          G.1<-G.1[-elim] 
        }
    }
      G.1

## [1] 1

Análogamente, si el conjunto \(\texttt{G.2}\) no es vacio procedemos a analizar los arcos que estan en su cota inferior, es decir, ya no se puede enviar mas flujo y estos los eliminamos de la lista.

código

if(G.2 %>% length() >0){
        elim<-c()
        for(i in 1:length(G.2)){
          if(!f[G.2[i]]>r[G.2[i]]){
            elim<-append(elim,i)
          }
        }
        if(length(elim)>0){
          G.2<-G.2[-elim] 
        }
      }
      G.2

## integer(0)

Sacamos la cantidad de elementos que hay en \(\texttt{G.1}\) y en \(\texttt{G.2}\).

código

      I1<-length(G.1)
      I1

## [1] 1

      I2<-length(G.2)
      I2

## [1] 0

Si hay elementos en \(\texttt{G.1}\), el nuevo flujo sera el mínimo del flujo actual y la cota superior de los arcos que tienen como predecesor al nodo que se esta examinando.

código

 if(I1>0){
        for (i in 1:I1) {
          e.0<-E.list[G.1[i],2]
          new.f<-min(c(q[G.1[i]]-f[G.1[i]],as.numeric(E[I[1],3])))
          E<-rbind(E,c(e.0,nodo,new.f,1,0))
        }
      }
      new.f

## [1] 15

##      Nodo Pred Disp  Direc Perm
## [1,] "A"  "A"  "Inf" "1"   "0" 
## [2,] "B"  "A"  "15"  "1"   "0"

Si el conjunto \(\texttt{G.2}\) no es vacio el flujo que se va a poder regresar sera el minino entre el flujo actual menos la cota inferior dde los arcos que tienen como sucesor al arco que se esta examinando.

código

if(I2>0){
        for (i in 1:I2) {
          e.0<-E.list[G.2[i],1]
          new.f<-min(c(f[G.2[i]]-r[G.2[i]],as.numeric(E[I[1],3])))
          E<-rbind(E,c(nodo,e.0,new.f,-1,0))
        }
      }
      new.f

## [1] 15

##      Nodo Pred Disp  Direc Perm
## [1,] "A"  "A"  "Inf" "1"   "0" 
## [2,] "B"  "A"  "15"  "1"   "0"

Ponemos etiqueta permanente en el nodo examinado. Si algun nodo es \(t\) se encontro una cadena aumentante. Sacamos el incremento que tiene el flujo. Paramos la busqueda de cadena aumentante.

código

E[I[1],5]<-1
      
      for(i in 1:nrow(E)){
        if(E[i,2]==t|E[i,1]==t){
          Aumentante<-1
          Aumentante
          signo<-ifelse(E[i,2]==t,-1,1)
          signo
          incremento<-E[i,3] %>% as.numeric()
          incremento
          break
        }
      }

Si encontramos una cadena aumentante, procedemos a recuperar la cadena y actualizamos el flujo actual en los arcos que estan dentro de la cadena aumentante.

código

if(Aumentante){
        ultimo<-t
        cadena<-c(ultimo)
        direcciones<-c()
        while(1){#RECUPERAMOS LA CADENA AUMENTANTE
          direcciones<-c(signo,direcciones)
          if(signo==1){
            indi<-which(E[,1]==ultimo)
            nuevo<-E[indi[1],2]
          }else{
            indi<-which(E[,2]==ultimo)
            nuevo<-E[indi[1],1]
          }
          cadena<-c(nuevo,cadena)
          if(nuevo==s){
            break()
          }
          ultimo<-nuevo
          for(i in 1:nrow(E)){
            if(E[i,2]==ultimo|E[i,1]==ultimo){
              signo<-ifelse(E[i,2]==ultimo,-1,1)
              break
            }
          }
          
        }
        cadena<-unname(cadena)
        cadena
        
        Actualizar<-cbind(cadena[-length(cadena)],cadena[-1])
        Actualizar
        
        for (i in 1:length(direcciones)) {
          if(direcciones[i]==-1){
            Actualizar[i,]=Actualizar[i,2:1]
          }
          for(j in 1:nrow(E.list)){
            if(prod(E.list[j,]==Actualizar[i,])){
              f[j]<-f[j]+incremento*as.numeric(direcciones[i])
              f[j]
            }
            
          }
        }
        
      }

Si no hay cambios en el flujo, no hay mas cadenas aumentantes y paramos el algoritmo.

Código

Corremos todo el código para ver los resultados obtenidos.

código

library(igraph)
library(dplyr)

#GENERAMOS LA RED
Grafica<-graph_from_literal("A"-+"B","C"-+"A","D"-+"A","B"-+"C",
                            "B"-+"D","B"-+"E","B"-+"G","E"-+"F",
                            "G"-+"F","G"-+"E","D"-+"G","C"-+"E")
#DATOS
q<-c(15,4,5,7,1,3,1,5,3,7,1,9) #CAPACIDAD MAXIMA
f<-rep(0,12)#FLUJO ACTUAL EN LOS ARCOS
r<- rep(0,12)#CAPACIDAD MINIMA
s<-"A" #NODO ORIGEN
t<-"F" #NODO DESTINO

#GRAFICAMOS LA RED
plot(Grafica,arrow.size=0.2)

código muy largo

# ALGORITMO ---------------------------------------------------------------
#FUNCION QUE BUSCA CADENAS AUMENTANTES
FordFulkerson<-function(Grafica,q,f,r,s,t){
  
  library(igraph)
  library(dplyr)
  #CREAMOS LA LISTA DE ARCOS QUE HAY EN LA RED
  E.list<- Grafica  %>% as_edgelist() 
  while(1){
    f0<-f #ACTUALIZAMOS EL FLUJO
    #GENERAMOS UNA MATRIZ CON EL NODO QUE SE VA A ANALIZAR, 
    #SU PREDECESOR, EL FLUJO QUE SE PEUDE TRANSPORTAR POR EL ARCO,
    #LA DIRECCION Y UN INDICADOR DE ETIQUETA PERMANENTE
    E<-matrix(c(s,s,Inf,1,0),ncol = 5) #INICIAMOS CON EL NODO S
    colnames(E)<-c("Nodo","Pred","Disp","Direc","Perm")
    Aumentante<-0 #NO HAY CADENAS AUMENTANTES
    contador<-0 #INICIALIZAMOS EL CONTADOR
    #MIENTRAS HAYA UN NODO SIN ETIQUETA PERMANENTE O 
    #NO SE ENCUENTRE UNA CADENA AUMENTANTE
    while(any(E[,5]==0)&Aumentante==0&contador<nrow(E.list)){
      contador<-contador+1 #AUMENTAMOS EN 1 EL CONTADOR
      #I= NODO EN E QUE NO HA SIDO EXAMINADO
      I<-which(E[,5]==0) %>% unname() %>% as.numeric()
      #NODO=NODO QUE SE VA A EXAMINAR
      nodo<-E[I[1],1] %>% unname()
      #F.NODO=FLUJO QUE SE PUEDE ENVIAR 
      f.nodo<-E[I[1],3] %>% unname() %>% as.numeric()
      
      G.1<-which(E.list[,1]==nodo)
      #G.1= NODOS QUE PUEDEN ENVIAR FLUJO
      G.2<-which(E.list[,2]==nodo)
      #G.2= NODOS QUE PUEDEN REGRESAR FLUJO
      
      if(G.1 %>% length() >0){#SI HAY ELEMENTOS EN G.1
        elim<-c()
        for(i in 1:length(G.1)){ #DESDE 1 HASTA LA LONGITUD DE G.1
          
          if(!f[G.1[i]]<q[G.1[i]]){
            #SI EL FLUJO NO ES MENOR A LA CAPACIDAD MAXIMA
            elim<-append(elim,i) #ELIMINAR EL ARCO
          }
        }
        if(length(elim)>0){ #SI LA LONGITUD DE ELIMINAR ES MAYOR A 0
          G.1<-G.1[-elim] #G.1 SE ACTUALIZA
        }
      }
      
      if(G.2 %>% length() >0){#SI HAY ELEMENTOS EN G.2
        elim<-c()
        for(i in 1:length(G.2)){ #DESDE UNO HASTA LA LONGITUD DE G.2
          if(!f[G.2[i]]>r[G.2[i]]){
            #SI EL FLUJO NO ES MAYOR QUE LA CAPACIDAD MINIMA
            elim<-append(elim,i)
            #EL ARCO SE AGREGA A LA LISTA ELIM
          }
        }
        if(length(elim)>0){#SI LA LISTA ELIM ES MAYOR A CERO
          G.2<-G.2[-elim]
          #ACTUALIZAMOS G.2 ELIMINANDO LOS ARCOS EN ELIM
        }
      }
      
      I1<-length(G.1)#I1 ARROJA LA CANTIDAD DE ARCOS EN G.1
      I2<-length(G.2)#I2 ARROJA LA CANTIDAD DE ARCOS EN G.2
      
      
      if(I1>0){#SI I1 ES MAYOR A 0
        for (i in 1:I1) {# DESDE I=1 HASTA I1
          e.0<-E.list[G.1[i],2] #HACEMOS UNA LISTA DE G.1
          new.f<-min(c(q[G.1[i]]-f[G.1[i]],as.numeric(E[I[1],3])))
          #EL NUEVO FLUJO ES EL MINIMO DE LA CAPACIDAD MAXIMA MENOS
          #EL FLUJO ACTUAL EN CADA ARCO
          E<-rbind(E,c(e.0,nodo,new.f,1,0))#AGREGAMOS A E LOS ARCOS
          #CON EL FLUJO ACTUALIZADO
        }
      }
      
      
      if(I2>0){ #SI I2 ES MAYOR A CERO 
        for (i in 1:I2) { #DESDE i=1 HASTA I2
          e.0<-E.list[G.2[i],1] #LLAMAMOS A LOS DATOS DE G.2
          new.f<-min(c(f[G.2[i]]-r[G.2[i]],as.numeric(E[I[1],3])))
          #EL NUEVO FLUJO ES EL FLUJO ACTUAL EN EL ARCO MENOS LA
          #CAPACIDAD MINIMA
          E<-rbind(E,c(nodo,e.0,new.f,-1,0)) #AGREGAMOS A E LOS
          #ARCOS CON EL FLUJO ACTUALIZADO
        }
      }
      
      
      E[I[1],5]<-1 #PONEMOS ETIQUETA PERMANENTE AL NODO EXAMINADO 
      
      for(i in 1:nrow(E)){ #DESDE i=1 HASTA 
        if(E[i,2]==t|E[i,1]==t){ #SI EN LOS ARCOS EXAMINADOS YA 
          #ESTA EL NODO FINAL
          Aumentante<-1 #ENONTRAMOS UNA CADENA AUMENTANTE
          signo<-ifelse(E[i,2]==t,-1,1)
          incremento<-E[i,3] %>% as.numeric()
          #INCREMENTO= FLUJO EN LA CADENA AUMENTANTE ENCONTRADA
          break
        }
      }
      
      if(Aumentante){#SI SE ENCONTRO UNA CADENA AUMENTANTE
        ultimo<-t #ultimo=t
        cadena<-c(ultimo)#OBTENEMOS LA CADENA AUMENTANTE
        direcciones<-c() #OBTENEMOS LA DIRECCION DE OS ARCOS EN LA CADENA
        while(1){
          direcciones<-c(signo,direcciones)
          #NOS INIDCA LA DIRECCION DE LA CADENA
          if(signo==1){#SI EL SIGNO ES 1
            indi<-which(E[,1]==ultimo)
            #INDI=CUAL NODO ES EL NODO ORIGEN
            nuevo<-E[indi[1],2]#CULA NODO ES EL DESTINO
          }else{#SI EL SIGNO ES NEGATIVO
            indi<-which(E[,2]==ultimo) #QUE NODO ES EL NODO ORIGEN
            nuevo<-E[indi[1],1] #CUAL ES EL NODO DESTINO
          }
          cadena<-c(nuevo,cadena)
          #AGREGAMOS A LA CADENA EL NODO ORIGEN DEL ARCO ANALIZADO
          if(nuevo==s){# SI EL NODO ES s
            break() #ACABAMOSO DE CONSTRUIR LA CADENA
          }
          ultimo<-nuevo#EL NODO NUEVO ES f PARA CONSTRUIR LA SIGUENTE CADENA
          for(i in 1:nrow(E)){ #DESDE i=0 HASTA EL NUMERO DE ARCOS
            if(E[i,2]==ultimo|E[i,1]==ultimo){
              signo<-ifelse(E[i,2]==ultimo,-1,1)
              break
            }
          }
          
        }
        cadena<-unname(cadena) #ACTUALIZAMOS LA CADENA
        
        Actualizar<-cbind(cadena[-length(cadena)],cadena[-1])
        #HACEMOS UNA LISTA DE LOS ARCOS A ACTUALIZAR EL FLUJO
        
        for (i in 1:length(direcciones)) {
          if(direcciones[i]==-1){ 
            Actualizar[i,]=Actualizar[i,2:1]
          }
          for(j in 1:nrow(E.list)){
            if(prod(E.list[j,]==Actualizar[i,])){
              #PARA LOS ARCOS QUE SE VA A ACTUALIZAR EL FLUJO
              f[j]<-f[j]+incremento*as.numeric(direcciones[i])
              #ACTUALIZAMOS EL FLUJO, TOMANDO EL ACTUAL 
              #MAS EL FLUJO ENCONTRADO EN LA CADENA AUMENTANTE
            }
          }
        }
        
      }
    }
    
    if(!any(f0!=f)){#SI NO HAY UN CAMBIO EN EL FLUJO
      break()#PARAMOS, YA NO HAY CADENAS AUMENTANTES
    }
  }
  return(f)#DEVUELVE EL FLUJO ACTUAL
}

código

# CORREMOS LA FUNCIÓN CON NUESTRA GRAFICA EJEMPLO:
f.final<-FordFulkerson(Grafica = Grafica,q=q,f=f,r=r,s=s,t=t)
knitr::kable(cbind(E.list,q,f.final),format = "markdown",col.names = c("Predecesor","Sucesor","Capacidad superior","Flujo final"))

Predecesor	Sucesor	Capacidad superior	Flujo final
A	B	15	11
B	C	4	0
B	D	5	3
B	E	7	7
B	G	1	1
C	A	3	0
C	E	1	0
D	A	5	0
D	G	3	3
E	F	7	7
G	E	1	0
G	F	9	4

FIN.

Algoritmo de Ford & Fulkerson

Amílcar José Escobedo Pérez

Renata Monsiváis Salas

Ixchel Sampayo Gutiérrez

Sergio Roberto Hernández Gallardo

6 de mayo de 2019

Teoría de redes

Problema

Pseudocódigo

Ejemplo

Código