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.

Monday, 4 April 2016

Graphs that are betweenness and/or degree-regular

All connected graphs on between 3 and 8 vertices that have identical betweenness values for all vertices:

is.generic.regular <- function(g, centrality.func, tol = 1E-10){
  centrals <- centrality.func(g)
  diffs <- abs(centrals - centrals[1])
  sum(diffs) < tol
  }

is.beta.regular <- function(g, tol = 1E-10){
  # checks if all the betweenness values for a graph
  # are equal (that is, less than a specified tolerance)
  is.generic.regular(g, betweenness, tol)
  }

is.delta.regular <- function(g, tol = 1E-10){
  # checks if all the degree values for a graph are equal
  # - tolerance should be irrelevant since degrees are integers
  is.generic.regular(g, degree, tol)
  }

##############################################

# All non-isomorphic connected graphs on up to 8 vertices
all.graphs <- lapply(1:8, function(i){
  Filter(is.connected, make_all_graphs(i))
  })

##############################################

# The subset of graphs that are betweenness-regular
beta.regs <- lapply(all.graphs,
  function(G.list){
    Filter(is.beta.regular, G.list)
    })
sapply(beta.regs, length)
#[1] 1 1 1 2 2 5 3 8

# The subset of graphs that are regular (ie, degree-regular)
delta.regs <- lapply(all.graphs,
  function(G.list){
    Filter(is.delta.regular, G.list)
    })
sapply(delta.regs, length)
# [1]  1  1  1  2  2  4  4 13

# The subset of graphs that are regular for both centralities
beta.and.delta.regs <- lapply(beta.regs, function(G.list){
  Filter(is.delta.regular, G.list)
  })
sapply(beta.and.delta.regs, length)
# [1] 1 1 1 2 2 4 3 7
par(mfrow = c(2, 4))
lapply(beta.and.delta.regs[[8]], plot)
# Some examples on 8 vertices:


# The subset of graphs that are betweeness-regular but not degree regular
beta.not.delta.regs <- lapply(beta.regs, function(G.list){
  Filter(function(g) !is.delta.regular(g), G.list)
  })
# [1] 0 0 0 0 0 1 0 1
par(mfrow = c(1, 2))
plot(beta.not.delta.regs[[6]][[1]])
plot(beta.not.delta.regs[[8]][[1]])


# The subset of graphs that are degree- but not betweenness-regular
delta.not.beta.regs <- lapply(delta.regs, function(G.list){
  Filter(function(g) !is.beta.regular(g), G.list)
  })
sapply(delta.not.beta.regs, length)

#[1] 0 0 0 0 0 0 1 6
par(mfrow = c(2, 4))
plot(delta.not.beta.regs[[7]][[1]])
lapply(delta.not.beta.regs[[8]], plot)