r - Modify SPDEP package - insert new function -
i trying modify stsls function of r package spdep. function compute spatial autoregressive function using 2 stage least square. both stages, function uses same spatial matrix. want create new function, stslsm, uses 2 different spatial matrices, 1 first stage (inlistw), 1 second stage (listw).
for reason, took stsls function, added new entry, inlistw, , modified accordingly script. interested, code @ bottom of post, please consider first trial.
now problem don't know how insert new function in spdep package. read different posts on issue. recurrent suggestion is:
unlockbinding("spdep", loadnamespace("spdep")); assigninnamespace("stslsm", stslsm, ns=asnamespace("spdep"), envir=loadnamespace("spdep")); assign("stslsm", stslsm, envir=env); lockbinding(stslsm, loadnamespace("spdep"));
but after second line of code following
error in bindingislocked(x, ns) : no binding "stslsm"
i got stuck here. have suggestion?
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 1 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)) (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 }
Comments
Post a Comment