r-来自调查包的svydesign中的动态变量名称

Question

我想将列添加到使用调查包创建的调查中。设计，可以按如下方式完成：

library(survey)
data(api)
dclus1 <- svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc)
dclus2 <- transform(dclus1, 
api00_b = api00 + 1)
svymean(~ api00, design = dclus2)
#>         mean     SE
#> api00 644.17 23.542
svymean(~ api00_b, design = dclus2)
#>           mean     SE
#> api00_b 645.17 23.542

对于更复杂的任务，我需要从外部向量动态创建这些变量名。以下产生了一个错误，但我认为这说明了我想要实现的目标：

vars <- c("api00_a", "api00_b")
dclus2 <- transform(dclus1, 
vars[[2]] = api00 + 1)

如何实现新列的动态名称？

Answer 1

我不认为你可以在R中等号的左侧使用这样的向量。不过，你不必使用transform，它调用survey:::update.survey.design。你可以直接添加你的新变量：

dclus2 <- dclus1
dclus2$variables[ ,vars[[1]]] <- dclus2$variables[,"api00"] + 1

这与在转换为survey.design对象之前创建新变量相同，只要您不使用任何调查函数来创建新变量即可。只是使用安东尼的评论：

apiclus2 <- apiclus1
apiclus2[ , vars[[1]]] <- apiclus2[ , "api00" ] + 1
dclus_prep_2 <- svydesign(id = ~dnum, weights = ~pw, data = apiclus2, fpc = ~fpc)

您可能更喜欢使用srvyr，它允许使用dplyr的!!和:=:进行编程

library(srvyr)
dclus_srvyr_1 <- as_survey_design(.data = apiclus1, 
ids = dnum, 
weights = pw, 
fpc = fpc)
dclus_srvyr_2 <- mutate(dclus_srvyr_1, 
!!vars[[1]] := api00 + 1)

所有版本都有相同的结果：

lapply(list(dclus2, dclus_prep_2, dclus_srvyr_2), 
function(design) svymean(~api00_a, design=design))
[[1]]
mean     SE
api00_a 645.17 23.542
[[2]]
mean     SE
api00_a 645.17 23.542
[[3]]
mean     SE
api00_a 645.17 23.542

Answer 2

以下是使用purrr:的可能解决方案

library(purrr)
vars <- c("api00_a", "api00_b")
transform_func <- function(data, vars) {
transform(data, vars = api00 + 1)
}
map(vars, ~transform_func(dclus1, .))

这给了我们以下列表：

[[1]]
1 - level Cluster Sampling design
With (15) clusters.
update(`_data`, ...)
[[2]]
1 - level Cluster Sampling design
With (15) clusters.
update(`_data`, ...)

Answer 3

您可以使用bquote执行此操作。例如

vars <- c("api00_plus_1", "api00_plus_2")
exprs<-list(quote(api00+1),quote(api00+2))
names(exprs)<-vars
bquote(update(dclus1,..(exprs)), splice=TRUE)
eval(bquote(update(dclus1,..(exprs)), splice=TRUE))

这里是survey包中的另一个块，它将公式中提到的任何字符串变量转换为因子

strings_to_factors<-function(formula,  design){
allv<-intersect(all.vars(formula), colnames(design))
vclass<-sapply(model.frame(design)[,allv,drop=FALSE], class)
if (!any(vclass=="character")) return(design)
vfix<-names(vclass)[vclass=="character"]
l<-as.list(vfix)
names(l)<-vfix
fl<-lapply(l, function(li) bquote(factor(.(as.name(li)))))
expr<-bquote(update(design, ..(fl)), splice=TRUE)
eval(expr)
}