Monday, 25 April 2016

Graphs with the same diameter but differing lambda_2

The second smallest Laplacian eigenvalue constrains the diameter of a graph on n vertices since $$d\geq4/n \lambda_2$$
We pull out a bunch of connected graphs on n vertices, group them by diameter and compare the graphs with the most extreme values of lambda_2.
Not shown, however, my restricted searches were'nt able to find any graphs where the inequality is tight.

lam2 <- function(g){
  # returns the second smallest Laplacian eigenvalue for a graph
  eig <- eigen(laplacian_matrix(g))$values
  eig[length(eig)-1]
  }

g8 <- Filter(is.connected, make_all_graphs(8))

g8.dsplit <- lapply(1:7, function(i){
  # But, no need to consider 1 or 7, the path and complete graph are the only such graphs
  Filter(function(g){diameter(g) == i}, g8)
  })

g8.dsplit.l2sort <- lapply(g8.dsplit, function(glist){
  ord <- order(sapply(glist, lam2))
  glist[ord]
  })

g8.min.max.l2 <- lapply(g8.dsplit.l2sort, function(glist){
  list(glist[[1]],
        rev(glist)[[1]]
        )
  })

par(mfrow = c(2, 2))
lapply(c(3,5), function(i){
  glist <- g8.min.max.l2[[i]]
  print(c("4/nd", 4 / (8 * i)))
  plot(glist[[1]]); print(lam2(glist[[1]]))
  plot(glist[[2]]); print(lam2(glist[[2]]))
  NULL
  })

# diam 3
[1] "4/nd"              "0.166666666666667"
[1] 0.3542487
[1] 2.354249

# diam 5
[1] "4/nd" "0.1" 
[1] 0.2022567
[1] 0.5107114


Since $$d \geq 2$$ for any connected non-complete graph, we have $$d \geq \max\{2, 4/n\lambda_2\}$$ for any non-trivial graph. The eigenvalue-based constraint only kicks in when $$4/n\lambda_2 > 2$$ or $$\lambda_2 < 2/n$$.
If we compute $$\lambda_2$$ and the diameter for each connected graph on 7, 8 and 9 vertices we can try and find those graphs for which this bound is strongest or weakest.
We define the residual to be $$(d - 4/n\lambda_2) / d$$ so that we have a non-negative score that is comparable between graphs with distinct diameters.

f <- function(g, n){
  # returns the lower bound on the diameter provided by the eigenvalue
  ev <- rev(eigen(graph.laplacian(g))$values)[2]
  ev2 <- 4 / (n * ev)
  ev2
  }

resid.func <- function(g){
  stopifnot(is.connected(g))
  n <- length(V(g))
  d <- diameter(g)
  return( (d - f(g, n)) / d)
  }

g7 <- Filter(is.connected, make_all_graphs(7))
# g8 above
g9 <- Filter(is.connected, make_all_graphs(9)) # takes a while

Note that the fraction of graphs where the eigevalue bound kicks in is pretty small:
length(Filter(function(g){f(g, 7) > 2}, g7)) / length(g7)
# [1] 0.01145038
length(Filter(function(g){f(g, 8) > 2}, g8)) / length(g8)
# [1] 0.005293551
length(Filter(function(g){f(g, 9) > 2}, g9)) / length(g9)
# [1] 0.001629274

residual7 <- sapply(g7, resid.func)
residual8 <- sapply(g8, resid.func)
residual9 <- sapply(g9, resid.func)

par(mfrow = c(3, 2))
plot(g7[[which.min(residual7)]]); plot(g7[[which.max(residual7)]])
plot(g8[[which.min(residual8)]]); plot(g8[[which.max(residual8)]])
plot(g9[[which.min(residual9)]]); plot(g9[[which.max(residual9)]])


Which is pretty neat, the graphs with the lowest (scaled) discrepancy between the eigenvalue bound and the diameter were long spindly beasts and those with the highest discrepancy were n-2 regular.

No comments:

Post a Comment