使用自定义centrality函数计算矩阵节点中心度触发条件长度错误

问题重现 #

编写了用于计算网络/矩阵节点中心度的centrality函数：

library(igraph) #load package igraph
centrality <- function (networks, type = c("indegree", "outdegree", "freeman", 
    "betweenness", "flow", "closeness", "eigenvector", "information", 
    "load", "bonpow"), directed = TRUE, lag = 0, rescale = FALSE, 
    center = FALSE, coefname = NULL, ...) 
{
    if (is.null(directed) || !is.logical(directed)) {
        stop("'directed' must be TRUE or FALSE.")
    }
    else if (length(directed) != 1) {
        stop("The 'directed' argument must contain a single logical value only.")
    }
    else if (directed == FALSE) {
        gmode <- "graph"
    }
    else {
        gmode <- "digraph"
    }
    objects <- checkDataTypes(y = NULL, networks = networks, 
        lag = lag)
    centlist <- list()
    for (i in 1:objects$time.steps) {
        if (type[1] == "indegree") {
            cent <- degree(objects$networks[[i]], gmode = gmode, 
                cmode = "indegree", rescale = rescale, ...)
        }
        else if (type[1] == "outdegree") {
            cent <- degree(objects$networks[[i]], gmode = gmode, 
                cmode = "outdegree", rescale = rescale, ...)
        }
        else if (type[1] == "freeman") {
            cent <- degree(objects$networks[[i]], gmode = gmode, 
                cmode = "freeman", rescale = rescale, ...)
        }
        else if (type[1] == "betweenness") {
            cent <- betweenness(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "flow") {
            cent <- flowbet(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "closeness") {
            cent <- closeness(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "eigenvector") {
            cent <- evcent(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "information") {
            cent <- infocent(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "load") {
            cent <- loadcent(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "bonpow") {
            cent <- bonpow(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, tol = 1e-20, ...)
        }
        else {
            stop("'type' argument was not recognized.")
        }
        centlist[[i]] <- cent
    }
    time <- numeric()
    y <- numeric()
    for (i in 1:objects$time.steps) {
        time <- c(time, rep(i, objects$n[[i]]))
        if (is.null(centlist[[i]])) {
            y <- c(y, rep(NA, objects$n[[i]]))
        }
        else {
            if (center == TRUE) {
                centlist[[i]] <- centlist[[i]] - mean(centlist[[i]], 
                  na.rm = TRUE)
            }
            y <- c(y, centlist[[i]])
        }
    }
    if (is.null(coefname) || !is.character(coefname) || length(coefname) > 
        1) {
        coeflabel <- ""
    }
    else {
        coeflabel <- paste0(".", coefname)
    }
    if (lag == 0) {
        laglabel <- ""
    }
    else {
        laglabel <- paste0(".lag", paste(lag, collapse = "."))
    }
    label <- paste0(type[1], coeflabel, laglabel)
    dat <- data.frame(y, time = time, node = objects$nodelabels)
    dat$node <- as.character(dat$node)
    colnames(dat)[1] <- label
    attributes(dat)$lag <- lag
    return(dat)
}

通过以下代码生成邻接矩阵datmat：

dat <- read.table(text="A B #this is edgelist
1 2
1 3
1 2
2 1
2 3
3 1
3 2
3 1", header=TRUE)
datmat <- as.matrix(get.adjacency(graph.edgelist(as.matrix(dat), directed=TRUE))) #this is the matrix
colnames(datmat) <- c("1", "2", "3") #rename the columns

调用centrality(datmat,type="flow",center=TRUE)时触发错误：

Error in if (class(networks) == "matrix") { : 
  the condition has length > 1 

错误原因 #

错误根源在checkDataTypes函数的判断逻辑：矩阵的class属性是c("matrix", "array")，直接用class(networks) == "matrix"会返回一个长度为2的布尔向量，而if条件只能接受单个布尔值，因此触发报错。

解决方案 #

方案1：调整传入参数的格式 #

将单个邻接矩阵包装成列表传入，适配checkDataTypes的预期输入格式：

centrality(list(datmat), type="flow", center=TRUE)

方案2：修改centrality函数，兼容单个矩阵输入 #

在centrality函数开头添加一段逻辑，自动将单个矩阵转为单元素列表，无需手动调整输入：

library(igraph) #load package igraph
centrality <- function (networks, type = c("indegree", "outdegree", "freeman", 
    "betweenness", "flow", "closeness", "eigenvector", "information", 
    "load", "bonpow"), directed = TRUE, lag = 0, rescale = FALSE, 
    center = FALSE, coefname = NULL, ...) 
{
    # 新增：自动将单个矩阵转为单元素列表
    if (is.matrix(networks)) {
        networks <- list(networks)
    }
    # 原函数剩余代码保持不变
    if (is.null(directed) || !is.logical(directed)) {
        stop("'directed' must be TRUE or FALSE.")
    }
    else if (length(directed) != 1) {
        stop("The 'directed' argument must contain a single logical value only.")
    }
    else if (directed == FALSE) {
        gmode <- "graph"
    }
    else {
        gmode <- "digraph"
    }
    objects <- checkDataTypes(y = NULL, networks = networks, 
        lag = lag)
    centlist <- list()
    for (i in 1:objects$time.steps) {
        if (type[1] == "indegree") {
            cent <- degree(objects$networks[[i]], gmode = gmode, 
                cmode = "indegree", rescale = rescale, ...)
        }
        else if (type[1] == "outdegree") {
            cent <- degree(objects$networks[[i]], gmode = gmode, 
                cmode = "outdegree", rescale = rescale, ...)
        }
        else if (type[1] == "freeman") {
            cent <- degree(objects$networks[[i]], gmode = gmode, 
                cmode = "freeman", rescale = rescale, ...)
        }
        else if (type[1] == "betweenness") {
            cent <- betweenness(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "flow") {
            cent <- flowbet(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "closeness") {
            cent <- closeness(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "eigenvector") {
            cent <- evcent(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "information") {
            cent <- infocent(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "load") {
            cent <- loadcent(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, ...)
        }
        else if (type[1] == "bonpow") {
            cent <- bonpow(objects$networks[[i]], gmode = gmode, 
                rescale = rescale, tol = 1e-20, ...)
        }
        else {
            stop("'type' argument was not recognized.")
        }
        centlist[[i]] <- cent
    }
    time <- numeric()
    y <- numeric()
    for (i in 1:objects$time.steps) {
        time <- c(time, rep(i, objects$n[[i]]))
        if (is.null(centlist[[i]])) {
            y <- c(y, rep(NA, objects$n[[i]]))
        }
        else {
            if (center == TRUE) {
                centlist[[i]] <- centlist[[i]] - mean(centlist[[i]], 
                  na.rm = TRUE)
            }
            y <- c(y, centlist[[i]])
        }
    }
    if (is.null(coefname) || !is.character(coefname) || length(coefname) > 
        1) {
        coeflabel <- ""
    }
    else {
        coeflabel <- paste0(".", coefname)
    }
    if (lag == 0) {
        laglabel <- ""
    }
    else {
        laglabel <- paste0(".lag", paste(lag, collapse = "."))
    }
    label <- paste0(type[1], coeflabel, laglabel)
    dat <- data.frame(y, time = time, node = objects$nodelabels)
    dat$node <- as.character(dat$node)
    colnames(dat)[1] <- label
    attributes(dat)$lag <- lag
    return(dat)
}

修改后直接调用centrality(datmat,type="flow",center=TRUE)即可正常运行。

方案3：修复checkDataTypes函数的判断逻辑 #

如果有权限修改checkDataTypes函数，将其中判断矩阵的代码从class(networks) == "matrix"改为is.matrix(networks)或inherits(networks, "matrix")，这两个函数都会返回单个布尔值，避免条件长度错误。

内容的提问来源于stack exchange，提问作者cliu