如何优化平方矩阵乘法的求迹?

时间:2018-07-15 14:45:16

标签: r matrix spatial spdep

我正在尝试针对我的用例优化R的spdep函数,因为它对于大型数据库而言非常慢。我的表现基本上还不错,但是我停留在某一点,试图在此找到我的权重矩阵以进行LM错误测试。我认为公式为tr [(W'+ W)W](Anselin,L.,Bera,AK,Florax,R.和Yoon,MJ的第82页,1996年,空间依赖性的简单诊断测试。区域科学与城市经济学, 26,77–104。)W是一个平方权重矩阵,保持每个观测值与另一个观测值的空间关系。 tr()操作是对角线的总和。

在我的情况下,权重矩阵是对称的,对角线为零。因此,我认为公式tr [(W'+ W)W]等于2 * sumsq(W),这非常快。但是显然我在某个地方弄错了,因为结果与spdep库的结果不匹配,这很可能是正确的。

这里是spdep库的相关部分。谁能帮我以下函数的结果与2 * sumsq(W)不同或如何使其更快?对于大型数据集,此函数是lm.LMtests函数被阻塞的地方。

tracew <- function (listw) {
    dlmtr <- 0
    n <- length(listw$neighbours)
    if (n < 1) stop("non-positive n")
    ndij <- card(listw$neighbours)
    dlmtr <- 0
    for (i in 1:n) {
        dij <- listw$neighbours[[i]]
        wdij <- listw$weights[[i]]
        for (j in seq(length=ndij[i])) {
            k <- dij[j]
# Luc Anselin 2006-11-11 problem with asymmetric listw
                dk <- which(listw$neighbours[[k]] == i)
                if (length(dk) > 0L && dk > 0L &&
                dk <= length(listw$neighbours[[k]]))
                wdk <- listw$weights[[k]][dk]
                else wdk <- 0
                dlmtr <- dlmtr + (wdij[j]*wdij[j]) + (wdij[j]*wdk)
        }
    }
    dlmtr
}

对那些不熟悉R的spdep库的人的补充说明: 函数listw的输入包含具有两个列表列表的权重矩阵的“图形”实现。 listw $ neighbors是一个列表,其中每个列表项都是与观察值相关的观察值索引的列表。 listw $会加权与邻居具有相同结构的列表,只是它保留关系的权重。

提前感谢您的任何评论和指示。

# example code

# initiliaze
library(spdep)
library(multiway)
# load the tracew function above
data(columbus)
columbus = columbus[rep(row.names(columbus), 20), ] # the difference becomes dramatic when n is high. try not replicating at first to see the results.

# manual calculation, using sumsq
w = distm(cbind(columbus$X, columbus$Y))
w[w > 1000000] = Inf # remove some relations acc. to pre-defined rule
w = 1/(1+w)
diag(w) = 0
w = w / (sum(w) / length(columbus$X)) #"C style" standardization
2*sumsq(w)

# spdep calculation
neighs.band = dnearneigh(cbind(columbus$X, columbus$Y), 0, 1000, longlat = TRUE)
w.spdep = lapply(nbdists(neighs.band, cbind(columbus$X, columbus$Y), longlat = TRUE), function(x) 1/(0.001+x))
my.listw = nb2listw(neighs.band, glist = w.spdep, style="C")
tracew(my.listw)

0 个答案:

没有答案