Practica Grafos

Problema 1

M <- matrix(c(0,0,1,0,1,0,0,0,1,1,0,1,1,1,0,1,1,0,0,1,1,0,1,0,1,0,1,1,0,0,0,1,0,0,0,0), 6, dimnames= list(c('A','B','C','D','E','F'),c('A','B','C','D','E','F')))
M

##   A B C D E F
## A 0 0 1 0 1 0
## B 0 0 1 1 0 1
## C 1 1 0 1 1 0
## D 0 1 1 0 1 0
## E 1 0 1 1 0 0
## F 0 1 0 0 0 0

Como la matriz de adyacencia es simetrica tienen sentido los cálculos siguientes:

Vertices adyacentes a B:

names(which(M['B',]==1))

## [1] "C" "D" "F"

Vertices adyacentes a D:

names(which(M['D',]==1))

## [1] "B" "C" "E"

Grado de cada vertice:

grV <- colSums(M)

Numero de aristas:

m <- sum(M[upper.tri(M)==1])

Comprobación de la igualdad:

sum(grV)==2*m

## [1] TRUE

Problema 2

Matriz de adyacencia del dígrafo:

M <- matrix(c(0,0,1,0,0,0,1,0,0,0,0,0,1,0,0,1,1,0,0,1,0,0,0,1,0,0,1,0,0,1,0,0,0,1,0,0), 6, dimnames= list(c('A','B','C','D','E','F'),c('A','B','C','D','E','F')))
M

##   A B C D E F
## A 0 1 1 0 0 0
## B 0 0 0 1 0 0
## C 1 0 0 0 1 0
## D 0 0 1 0 0 1
## E 0 0 1 0 0 0
## F 0 0 0 1 1 0

Hallar la traspuesta y comprobar que es distinta de M:

t(M)

##   A B C D E F
## A 0 0 1 0 0 0
## B 1 0 0 0 0 0
## C 1 0 0 1 1 0
## D 0 1 0 0 0 1
## E 0 0 1 0 0 1
## F 0 0 0 1 0 0

M==t(M)

##       A     B     C     D     E     F
## A  TRUE FALSE  TRUE  TRUE  TRUE  TRUE
## B FALSE  TRUE  TRUE FALSE  TRUE  TRUE
## C  TRUE  TRUE  TRUE FALSE  TRUE  TRUE
## D  TRUE FALSE FALSE  TRUE  TRUE  TRUE
## E  TRUE  TRUE  TRUE  TRUE  TRUE FALSE
## F  TRUE  TRUE  TRUE  TRUE FALSE  TRUE

Como en la comparación hay valores false quiere decir que la traspuesta es distinta de M.

Función matriz cuadrada:

cuadrada <- function (M) {
  if (dim(M)[1]==dim(M)[2]) {cuad=TRUE}
  else {cuad=FALSE}
  return(cuad)
}

La función para simetría ya esta implementada en R y es: isSymetric.matrix(M)

Comprobación de igualdad

#Sumatorio de grados de salida
sum(colSums(M))

## [1] 10

#Sumatorio de grados de entrada
sum(rowSums(M))

## [1] 10

#Aristas
sum(M)

## [1] 10

data.frame(Vertice=colnames(M), G_Entrada=colSums(M), G_Salida=rowSums(M), row.names = 1:6)

##   Vertice G_Entrada G_Salida
## 1       A         1        2
## 2       B         1        1
## 3       C         3        2
## 4       D         2        2
## 5       E         2        1
## 6       F         1        2

Cerrar la plaza B al tráfico:

M1 <- M
M1['B',]=0
M1[,'B']=0
M1

##   A B C D E F
## A 0 0 1 0 0 0
## B 0 0 0 0 0 0
## C 1 0 0 0 1 0
## D 0 0 1 0 0 1
## E 0 0 1 0 0 0
## F 0 0 0 1 1 0

Todas las calles de doble sentido:

A <- M
A[A!=t(A)]=1
A

##   A B C D E F
## A 0 1 1 0 0 0
## B 1 0 0 1 0 0
## C 1 0 0 1 1 0
## D 0 1 1 0 0 1
## E 0 0 1 0 0 1
## F 0 0 0 1 1 0

Arcos de M siguen estando en A:

sum(M)==sum(A[(M==1)])

## [1] TRUE

Problema 3

Algoritmo de Warsall:

N <- matrix(c(0,1,0,1,0,1,0,1,1,0,0,1,0,1,1,1,1,1,0,1,0,0,1,1,0),5)
N

##      [,1] [,2] [,3] [,4] [,5]
## [1,]    0    1    0    1    0
## [2,]    1    0    1    1    0
## [3,]    0    1    0    1    1
## [4,]    1    1    1    0    1
## [5,]    0    0    1    1    0

W <- N
n <- dim(N)[1]
v <- matrix(1,n)
for(k in 1:n){   
  W  <-  W |( W[ , k * v] & W[k* v,  ])
  print(W)
}

##       [,1]  [,2]  [,3] [,4]  [,5]
## [1,] FALSE  TRUE FALSE TRUE FALSE
## [2,]  TRUE  TRUE  TRUE TRUE FALSE
## [3,] FALSE  TRUE FALSE TRUE  TRUE
## [4,]  TRUE  TRUE  TRUE TRUE  TRUE
## [5,] FALSE FALSE  TRUE TRUE FALSE
##       [,1]  [,2] [,3] [,4]  [,5]
## [1,]  TRUE  TRUE TRUE TRUE FALSE
## [2,]  TRUE  TRUE TRUE TRUE FALSE
## [3,]  TRUE  TRUE TRUE TRUE  TRUE
## [4,]  TRUE  TRUE TRUE TRUE  TRUE
## [5,] FALSE FALSE TRUE TRUE FALSE
##      [,1] [,2] [,3] [,4] [,5]
## [1,] TRUE TRUE TRUE TRUE TRUE
## [2,] TRUE TRUE TRUE TRUE TRUE
## [3,] TRUE TRUE TRUE TRUE TRUE
## [4,] TRUE TRUE TRUE TRUE TRUE
## [5,] TRUE TRUE TRUE TRUE TRUE
##      [,1] [,2] [,3] [,4] [,5]
## [1,] TRUE TRUE TRUE TRUE TRUE
## [2,] TRUE TRUE TRUE TRUE TRUE
## [3,] TRUE TRUE TRUE TRUE TRUE
## [4,] TRUE TRUE TRUE TRUE TRUE
## [5,] TRUE TRUE TRUE TRUE TRUE
##      [,1] [,2] [,3] [,4] [,5]
## [1,] TRUE TRUE TRUE TRUE TRUE
## [2,] TRUE TRUE TRUE TRUE TRUE
## [3,] TRUE TRUE TRUE TRUE TRUE
## [4,] TRUE TRUE TRUE TRUE TRUE
## [5,] TRUE TRUE TRUE TRUE TRUE

Algoritmo con parada en la matriz toda de unos:

W <- N
n <- dim(N)[1]
v <- matrix(1,n)
k <-1
parada <- FALSE
while (k<=n && !parada){   
  W  <-  W |( W[ , k * v] & W[k* v,  ])
  print(W)
  parada <- n==colSums(W)
  k <- k+1
}

##       [,1]  [,2]  [,3] [,4]  [,5]
## [1,] FALSE  TRUE FALSE TRUE FALSE
## [2,]  TRUE  TRUE  TRUE TRUE FALSE
## [3,] FALSE  TRUE FALSE TRUE  TRUE
## [4,]  TRUE  TRUE  TRUE TRUE  TRUE
## [5,] FALSE FALSE  TRUE TRUE FALSE
##       [,1]  [,2] [,3] [,4]  [,5]
## [1,]  TRUE  TRUE TRUE TRUE FALSE
## [2,]  TRUE  TRUE TRUE TRUE FALSE
## [3,]  TRUE  TRUE TRUE TRUE  TRUE
## [4,]  TRUE  TRUE TRUE TRUE  TRUE
## [5,] FALSE FALSE TRUE TRUE FALSE
##      [,1] [,2] [,3] [,4] [,5]
## [1,] TRUE TRUE TRUE TRUE TRUE
## [2,] TRUE TRUE TRUE TRUE TRUE
## [3,] TRUE TRUE TRUE TRUE TRUE
## [4,] TRUE TRUE TRUE TRUE TRUE
## [5,] TRUE TRUE TRUE TRUE TRUE

Condición de parada con una columna toda de unos:

W <- N
n <- dim(N)[1]
v <- matrix(1,n)
k <-1
parada <- FALSE
while (k<=n && !parada){   
  W  <-  W |( W[ , k * v] & W[k* v,  ])
  print(W)
  parada <- (sum(n==colSums(W)))==1
  k <- k+1
}

##       [,1]  [,2]  [,3] [,4]  [,5]
## [1,] FALSE  TRUE FALSE TRUE FALSE
## [2,]  TRUE  TRUE  TRUE TRUE FALSE
## [3,] FALSE  TRUE FALSE TRUE  TRUE
## [4,]  TRUE  TRUE  TRUE TRUE  TRUE
## [5,] FALSE FALSE  TRUE TRUE FALSE

Comprobación de fichero conexo:

datos <- scan('C:\\Users\\Artiel\\Desktop\\mediumEWD.txt')
datos <- datos[-c(1,2)]
Ari <-data.frame(Entrada=datos[seq(1,2546, by=3)], Salida=datos[seq(2,2546, by=3)])

M<-matrix(0,250,250)
for (i in 1:dim(Ari)[1]){
  M[Ari[i,1]+1,Ari[i,2]+1] <- 1  
}

Método 1 (Sumando potencias):

sum(M)

## [1] 849

N <- M
Suma <- M
for (k in 2:(dim(M)[1]-1)){
  N <- N%*%M
  Suma <- Suma + N
}
sum(Suma==0)==0

## [1] FALSE

Como da false quiere decir que no es conexa.

Tiempo de ejecución del primer método:

##    user  system elapsed 
##    4.00    0.08    4.16

Algoritmo de Warsall:

W <- M
n <- dim(M)[1]
v <- matrix(1,n)
k <-1
parada <- FALSE
while (k<=n && !parada){   
  W  <-  W |( W[ , k * v] & W[k* v,  ])
  parada <- n==colSums(W)
  k <- k+1
}
sum(W==0)==0

## [1] FALSE

Como da false quiere decir que no es conexa.

Tiempo de ejecución algoritmo de Warsall:

##    user  system elapsed 
##    1.22    0.00    1.22

Podemos ver que el método de Warsall es más eficiente, en este caso funcionó casi 4 veces más rápido.

Practica Grafos

Artiel Palomar Coll

16 de Abril de 2016