1

我正在尝试修改 R 包 spdep 的 stsls 函数。该函数使用两阶段最小二乘法计算空间自回归函数。对于这两个阶段，该函数使用相同的空间矩阵。我想要的是创建一个新函数，比如 stslsm，它使用两个不同的空间矩阵，一个用于第一阶段（inlistw），一个用于第二阶段（listw）。

为此，我使用了 stsls 函数，我添加了一个新条目 inlistw，并相应地修改了脚本。对于那些感兴趣的人，代码在这篇文章的底部，但请注意这只是第一次试用。

现在的问题是我不知道如何在 spdep 包中插入这个新功能。我阅读了关于这个问题的不同帖子。最常见的建议是：

unlockBinding("spdep", loadNamespace("spdep"));
assignInNamespace("stslsm", stslsm, ns=asNamespace("spdep"), envir=loadNamespace("spdep"));
assign("stslsm", stslsm, envir=env);
lockBinding(stslsm, loadNamespace("spdep"));

但是在第二行代码之后，我得到以下内容

Error in bindingIsLocked(x, ns) : no binding for "stslsm"

我被困在这里。你有什么建议吗？

function (formula, data = list(), listw, inlistw,zero.policy = NULL, 
      na.action = na.fail, robust = FALSE, HC = NULL, legacy = FALSE, 
      W2X = TRUE) {
if (!inherits(listw, "listw")) 
stop("No neighbourhood list")
if (is.null(zero.policy)) 
zero.policy <- get("zeroPolicy", envir = .spdepOptions)
stopifnot(is.logical(zero.policy))
if (class(formula) != "formula") 
formula <- as.formula(formula)
mt <- terms(formula, data = data)
mf <- lm(formula, data, na.action = na.action, method = "model.frame")
na.act <- attr(mf, "na.action")
if (!is.null(na.act)) {
subset <- !(1:length(listw$neighbours) %in% na.act)
listw <- subset(listw, subset, zero.policy = zero.policy)
}
y <- model.extract(mf, "response")
if (any(is.na(y))) 
stop("NAs in dependent variable")
X <- model.matrix(mt, mf)
if (any(is.na(X))) 
stop("NAs in independent variable")
if (robust) {
if (is.null(HC)) 
  HC <- "HC0"
if (!any(HC %in% c("HC0", "HC1"))) 
  stop("HC must be one of HC0, HC1")
}
Wy <- lag.listw(listw, y, zero.policy = zero.policy)
dim(Wy) <- c(nrow(X), 1)
colnames(Wy) <- c("Rho")
n <- NROW(X)
m <- NCOL(X)
xcolnames <- colnames(X)
K <- ifelse(xcolnames[1] == "(Intercept)", 2, 1)
 if (m > 1) {
 WX <- matrix(nrow = n, ncol = (m - (K - 1)))
if (W2X) 
  WWX <- matrix(nrow = n, ncol = ncol(WX))
for (k in K:m) {
  wx <- lag.listw(inlistw, X[, k], zero.policy = zero.policy)
  if (W2X) 
    wwx <- lag.listw(inlistw, wx, zero.policy = zero.policy)
  if (any(is.na(wx))) 
    stop("NAs in lagged independent variable")
  WX[, (k - (K - 1))] <- wx
  if (W2X) 
    WWX[, (k - (K - 1))] <- wwx
}
if (W2X) 
  inst <- cbind(WX, WWX)
 else inst <- WX
}
if (K == 2 && listw$style != "W") {
wx1 <- as.double(rep(1, n))
wx <- lag.listw(inlistw, wx1, zero.policy = zero.policy)
if (W2X) 
  wwx <- lag.listw(inlistw, wx, zero.policy = zero.policy)
if (m > 1) {
  inst <- cbind(wx, inst)
  if (W2X) 
    inst <- cbind(wwx, inst)
}
else {
  inst <- matrix(wx, nrow = n, ncol = 1)
  if (W2X) 
    inst <- cbind(inst, wwx)
}
}
result <- tsls(y = y, yend = Wy, X = X, Zinst = inst, robust = robust, 
             HC = HC, legacy = legacy)
result$zero.policy <- zero.policy
result$robust <- robust
if (robust) 
result$HC <- HC
result$legacy <- legacy
result$listw_style <- listw$style
result$call <- match.call()
class(result) <- "stsls"
result
}
4

0 回答 0