2017-10-08 8 views
2

수식을 대체하는 방법에 대한 answer을 받았습니다. 데이터 목록을 일치시키는 데 필요합니다. 프레임.MatchIt에서 (예를 들어) 인식되지 않는 대체 공식을 다루는 방법?

MatchIt::matchit()과 일치시킬 때 먼저 결과를 matchit.full/matchit 클래스로 저장해야합니다. 둘째, match.data() data.frames와 일치하는 관찰 만 작성해야합니다.

평소와 같이 수식을 사용하면 잘 작동하는 두 번째 단계에서 문제가 발생합니다. 지금은 대체를 위해 match.data()은 수식을 어떻게 든 인식해야하지만 그렇지는 않습니다.

은 (경고는 무시 될 수있다) 예를 들어이 있다면 :

# example list 
library(car) 
WeightLoss1 <- WeightLoss 
WeightLoss1$group <- as.integer(ifelse(WeightLoss1$group == "Control", 0, 1)) 

WL = list(WeightLoss1, WeightLoss1, WeightLoss1) # doesn't make much sense, but suffices for example 

# substitute formula 
wl.cov <- c("wl1", "se1") 
WL.FM <- reformulate(wl.cov, response = "group") 

# matching w/o substitution 
m.match.0 <- lapply(1:length(WL), function(mark) { 
    require(MatchIt) 
    matchit(group ~ wl1 + se1, data = WL[[mark]]) 
}) 

# matching w/ substitution 
m.match.1 <- lapply(1:length(WL), function(mark) { 
    require(MatchIt) 
    matchit(WL.FM, data = WL[[mark]]) 
}) 

# now compare both attempts to create list of data.frames 
# w/o 
match <- lapply(1:length(m.match.0), function(i){ 
    require(MatchIt) 
    match.data(m.match.0[[i]]) 
}) 

# w/ 
match <- lapply(1:length(m.match.1), function(i){ 
    require(MatchIt) 
    match.data(m.match.1[[i]]) 
}) 

그대로/교체 오류 Error in eval(object$call$data, envir = env) : object 'mark' not found 생산 승 미세한 시도를 작동/O 교체 w 시도를 알 수있다.

어떻게 패치 할 수 있습니까?

-

주 :

> match.data 
function (object, group = "all", distance = "distance", weights = "weights", 
    subclass = "subclass") 
{ 
    if (!is.null(object$model)) { 
     env <- attributes(terms(object$model))$.Environment 
    } 
    else { 
     env <- parent.frame() 
    } 
    data <- eval(object$call$data, envir = env) 
    treat <- object$treat 
    wt <- object$weights 
    vars <- names(data) 
    if (distance %in% vars) 
     stop("invalid input for distance. choose a different name.") 
    else if (!is.null(object$distance)) { 
     dta <- data.frame(cbind(data, object$distance)) 
     names(dta) <- c(names(data), distance) 
     data <- dta 
    } 
    if (weights %in% vars) 
     stop("invalid input for weights. choose a different name.") 
    else if (!is.null(object$weights)) { 
     dta <- data.frame(cbind(data, object$weights)) 
     names(dta) <- c(names(data), weights) 
     data <- dta 
    } 
    if (subclass %in% vars) 
     stop("invalid input for subclass. choose a different name.") 
    else if (!is.null(object$subclass)) { 
     dta <- data.frame(cbind(data, object$subclass)) 
     names(dta) <- c(names(data), subclass) 
     data <- dta 
    } 
    if (group == "all") 
     return(data[wt > 0, ]) 
    else if (group == "treat") 
     return(data[wt > 0 & treat == 1, ]) 
    else if (group == "control") 
     return(data[wt > 0 & treat == 0, ]) 
    else stop("error: invalid input for group.") 
} 
<bytecode: 0x00000000866125e0> 
<environment: namespace:MatchIt> 

 

첫째
> matchit 
function (formula, data, method = "nearest", distance = "logit", 
    distance.options = list(), discard = "none", reestimate = FALSE, 
    ...) 
{ 
    mcall <- match.call() 
    if (is.null(data)) 
     stop("Dataframe must be specified", call. = FALSE) 
    if (!is.data.frame(data)) { 
     stop("Data must be a dataframe", call. = FALSE) 
    } 
    if (sum(is.na(data)) > 0) 
     stop("Missing values exist in the data") 
    ischar <- rep(0, dim(data)[2]) 
    for (i in 1:dim(data)[2]) if (is.character(data[, i])) 
     data[, i] <- as.factor(data[, i]) 
    if (!is.numeric(distance)) { 
     fn1 <- paste("distance2", distance, sep = "") 
     if (!exists(fn1)) 
      stop(distance, "not supported.") 
    } 
    if (is.numeric(distance)) { 
     fn1 <- "distance2user" 
    } 
    fn2 <- paste("matchit2", method, sep = "") 
    if (!exists(fn2)) 
     stop(method, "not supported.") 
    tryerror <- try(model.frame(formula), TRUE) 
    if (distance %in% c("GAMlogit", "GAMprobit", "GAMcloglog", 
     "GAMlog", "GAMcauchit")) { 
     requireNamespace("mgcv") 
     tt <- terms(mgcv::interpret.gam(formula)$fake.formula) 
    } 
    else { 
     tt <- terms(formula) 
    } 
    attr(tt, "intercept") <- 0 
    mf <- model.frame(tt, data) 
    treat <- model.response(mf) 
    X <- model.matrix(tt, data = mf) 
    if (method == "exact") { 
     distance <- out1 <- discarded <- NULL 
     if (!is.null(distance)) 
      warning("distance is set to `NULL' when exact matching is used.") 
    } 
    else if (is.numeric(distance)) { 
     out1 <- NULL 
     discarded <- discard(treat, distance, discard, X) 
    } 
    else { 
     if (is.null(distance.options$formula)) 
      distance.options$formula <- formula 
     if (is.null(distance.options$data)) 
      distance.options$data <- data 
     out1 <- do.call(fn1, distance.options) 
     discarded <- discard(treat, out1$distance, discard, X) 
     if (reestimate) { 
      distance.options$data <- data[!discarded, ] 
      distance.options$weights <- distance.options$weights[!discarded] 
      tmp <- out1 
      out1 <- do.call(fn1, distance.options) 
      tmp$distance[!discarded] <- out1$distance 
      out1$distance <- tmp$distance 
     } 
     distance <- out1$distance 
    } 
    if (fn1 == "distance2mahalanobis") { 
     is.full.mahalanobis <- TRUE 
    } 
    else { 
     is.full.mahalanobis <- FALSE 
    } 
    out2 <- do.call(fn2, list(treat, X, data, distance = distance, 
     discarded, is.full.mahalanobis = is.full.mahalanobis, 
     ...)) 
    if (fn1 == "distance2mahalanobis") { 
     distance[1:length(distance)] <- NA 
     class(out2) <- c("matchit.mahalanobis", "matchit") 
    } 
    out2$call <- mcall 
    out2$model <- out1$model 
    out2$formula <- formula 
    out2$treat <- treat 
    if (is.null(out2$X)) { 
     out2$X <- X 
    } 
    out2$distance <- distance 
    out2$discarded <- discarded 
    nn <- matrix(0, ncol = 2, nrow = 4) 
    nn[1, ] <- c(sum(out2$treat == 0), sum(out2$treat == 1)) 
    nn[2, ] <- c(sum(out2$treat == 0 & out2$weights > 0), sum(out2$treat == 
     1 & out2$weights > 0)) 
    nn[3, ] <- c(sum(out2$treat == 0 & out2$weights == 0 & out2$discarded == 
     0), sum(out2$treat == 1 & out2$weights == 0 & out2$discarded == 
     0)) 
    nn[4, ] <- c(sum(out2$treat == 0 & out2$weights == 0 & out2$discarded == 
     1), sum(out2$treat == 1 & out2$weights == 0 & out2$discarded == 
     1)) 
    dimnames(nn) <- list(c("All", "Matched", "Unmatched", "Discarded"), 
     c("Control", "Treated")) 
    out2$nn <- nn 
    return(out2) 
} 
<bytecode: 0x0000000086d6e158> 
<environment: namespace:MatchIt> 

답변

3

는이 두 가지 시나리오하지만 사실 그 사이의 키 차이가있는 subsittution이 아닌 점에 유의 대체가 아닌 경우 코드는 matchit을 호출하는 함수에서 수식을 정의하지만 반면에 이 함수는 함수 외부의 수식을 정의합니다. 두 경우 모두 수식이 함수 외부에서 정의되고 두 수식 모두에서 수식이 함수 내부에 정의 된 경우 작동하지 않으면 실패합니다. 우리가 익명 함수의 로컬 환경이어야 할 반면

문제는 수식 예에서 함수 외부 화학식 1의 환경을 정의하기 때문에, 지구 환경

environment(WL.FM) 
## <environment: R_GlobalEnv> 

임을 여기서 그것을 사용. 당신이 다른 시도 기능에 수식을 정의하지 않으려면

m.match.1 <- lapply(WL, function(x) { 
    WL.FM <- reformulate(wl.cov, response = "group") 
    matchit(WL.FM, data = x) 
}) 
match <- lapply(m.match.1, match.data) 

2) 또는 :

WL.FM <- reformulate(wl.cov, response = "group") 
m.match.1 <- lapply(WL, function(x) { 
    environment(WL.FM) <- environment() 
    matchit(WL.FM, data = x) 
}) 
match <- lapply(m.match.1, match.data) 

2A)를

1)이 시도 환경을 다시 설정하는 또 다른 방법은 수식을 문자로 변환 한 다음 수식으로 다시 변환하는 것입니다.

WL.FM <- reformulate(wl.cov, response = "group") 
m.match.1 <- lapply(WL, function(x) { 
    WL.FM <- formula(format(WL.FM)) 
    matchit(WL.FM, data = x) 
}) 
match <- lapply(m.match.1, match.data) 

3) 또 다른 권장 사항은 WL.FM을 수식 객체가 아닌 문자열로 정의하는 것입니다. 그런 다음 환경이 없습니다.

WL.FM <- format(reformulate(wl.cov, response = "group")) # character 
m.match.1 <- lapply(WL, function(x) matchit(formula(WL.FM), data = x)) 
match <- lapply(m.match.1, match.data) 

참고 :보기의 스타일 시점에서, 키 문제와 ​​관련되지는 않지만은, 위의 우리가 제거한의 enviornment가 기본값으로하는 경우에 익명 함수에서 수식으로 변환 require 문 코드 상단에 단일 library 문을 사용하고 if 문 내에 있지 않으면 require을 사용하지 마십시오. - if (require(...)) ...로드 할 패키지를 사용할 수없는 경우 코드를 가능한 한 빨리 실패 시키길 원합니다.

또한 lapply 코드를 각 경우 첨자를 반복하지 않고 WLm.match.1을 반복하도록 변경했습니다.