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

Popular posts from this blog

sublimetext3 - what keyboard shortcut is to comment/uncomment for this script tag in sublime -

java - No use of nillable="0" in SOAP Webservice -

ubuntu - Laravel 5.2 quickstart guide gives Not Found Error -