R 等效于 Stata 对存根名称的本地宏列表的 for 循环答案

【问题标题】：R equivalent of Stata's for-loop over local macro list of stubnamesR 等效于 Stata 对存根名称的本地宏列表的 for 循环
【发布时间】：2014-11-10 02:16:14
【问题描述】：

我是一名正在过渡到 R 的 Stata 用户，我发现我很难放弃一个 Stata 拐杖。这是因为我不知道如何用 R 的“应用”函数来做等效的事情。

在 Stata 中，我经常生成存根名称的本地宏列表，然后循环遍历该列表，调用名称由这些存根名称构建的变量。

举个简单的例子，假设我有以下数据集：

study_id year varX06 varX07 varX08 varY06 varY07 varY08
   1       6   50     40     30     20.5  19.8   17.4
   1       7   50     40     30     20.5  19.8   17.4
   1       8   50     40     30     20.5  19.8   17.4
   2       6   60     55     44     25.1  25.2   25.3
   2       7   60     55     44     25.1  25.2   25.3
   2       8   60     55     44     25.1  25.2   25.3 
   and so on...

我想生成两个新变量，varX 和 varY，它们在年份为 6 时分别采用 varX06 和 varY06 的值，在年份为 7 时分别采用 varX07 和 varY07，和varX08 和varY08 在年份为8 时。

最终的数据集应如下所示：

study_id year varX06 varX07 varX08 varY06 varY07 varY08 varX varY
   1       6   50     40     30     20.5  19.8   17.4    50  20.5
   1       7   50     40     30     20.5  19.8   17.4    40  19.8
   1       8   50     40     30     20.5  19.8   17.4    30  17.4 
   2       6   60     55     44     25.1  25.2   25.3    60  25.1
   2       7   60     55     44     25.1  25.2   25.3    55  25.2
   2       8   60     55     44     25.1  25.2   25.3    44  25.3 
   and so on...

澄清一下，我知道我可以使用melt 和reshape 命令来做到这一点——本质上是将这些数据从宽格式转换为长格式，但我不想诉诸于此。这不是我的问题的意图。

我的问题是关于如何在 R 中循环存根名称的本地宏列表，我只是使用这个简单的示例来说明一个更通用的困境。

在 Stata 中，我可以生成存根名称的本地宏列表：

local stub varX varY

然后循环遍历宏列表。我可以生成一个新变量 varX 或 varY 并用 varX06 或 varY06 的值（分别）替换新变量值，如果年份是 6 等等。

foreach i of local stub {
    display "`i'"  
    gen `i'=.      
    replace `i'=`i'06 if year==6  
    replace `i'=`i'07 if year==7
    replace `i'=`i'08 if year==8
}

最后一部分是我发现在 R 中最难复制的部分。当我写 'x'06 时，Stata 将字符串“varX”与字符串“06”连接起来，然后返回变量 varX06 的值.此外，当我写'i' 时，Stata 返回字符串“varX”而不是字符串“'i'”。

我如何用 R 做这些事情？

我搜索了 Muenchen 的“Stata 用户的 R”，用 Google 搜索了网络，并在 StackOverflow 上搜索了以前的帖子，但找不到 R 解决方案。

如果这个问题很简单，我深表歉意。如果之前已经回答过，请引导我到回复。

提前致谢，
度母

【问题讨论】：

标签： r for-loop stata local stata-macros

【解决方案1】：

嗯，这是一种方法。 R 数据框中的列可以使用它们的字符名称来访问，所以这将起作用：

# create sample dataset
set.seed(1)    # for reproducible example
df <- data.frame(year=as.factor(rep(6:8,each=100)),   #categorical variable
                 varX06 = rnorm(300), varX07=rnorm(300), varX08=rnorm(100),
                 varY06 = rnorm(300), varY07=rnorm(300), varY08=rnorm(100))

# you start here...
years   <- unique(df$year)
df$varX <- unlist(lapply(years,function(yr)df[df$year==yr,paste0("varX0",yr)]))
df$varY <- unlist(lapply(years,function(yr)df[df$year==yr,paste0("varY0",yr)]))

print(head(df),digits=4)
#   year  varX06  varX07  varX08   varY06  varY07  varY08    varX     varY
# 1    6 -0.6265  0.8937 -0.3411 -0.70757  1.1350  0.3412 -0.6265 -0.70757
# 2    6  0.1836 -1.0473  1.5024  1.97157  1.1119  1.3162  0.1836  1.97157
# 3    6 -0.8356  1.9713  0.5283 -0.09000 -0.8708 -0.9598 -0.8356 -0.09000
# 4    6  1.5953 -0.3836  0.5422 -0.01402  0.2107 -1.2056  1.5953 -0.01402
# 5    6  0.3295  1.6541 -0.1367 -1.12346  0.0694  1.5676  0.3295 -1.12346
# 6    6 -0.8205  1.5122 -1.1367 -1.34413 -1.6626  0.2253 -0.8205 -1.34413

对于给定的yr，匿名函数提取具有该yr 的行和名为"varX0" + yr 的列（paste0(...) 的结果。然后lapply(...) 每年“应用”此函数，并且@ 987654327@将返回的列表转换成向量。

【讨论】：

你也可以把它做成一个循环来轻松处理许多存根： stub
谢谢，jlhoward 和 davep。我在我的数据上尝试了这种方法（使用 davep 建议的 for 循环），如果我先按年份排序，它就可以工作。出于教育目的，如果我不先按年份排序，还有其他方法吗？

【解决方案2】：

也许是更透明的方式：

sub <- c("varX", "varY")
for (i in sub) {
 df[[i]] <- NA
 df[[i]] <- ifelse(df[["year"]] == 6, df[[paste0(i, "06")]], df[[i]])
 df[[i]] <- ifelse(df[["year"]] == 7, df[[paste0(i, "07")]], df[[i]])
 df[[i]] <- ifelse(df[["year"]] == 8, df[[paste0(i, "08")]], df[[i]])
}

【讨论】：

【解决方案3】：

此方法会重新排序您的数据，但涉及单行，这可能对您更好，也可能不会更好（假设 d 是您的数据框）：

> do.call(rbind, by(d, d$year, function(x) { within(x, { varX <- x[, paste0('varX0',x$year[1])]; varY <- x[, paste0('varY0',x$year[1])] }) } ))
    study_id year varX06 varX07 varX08 varY06 varY07 varY08 varY varX
6.1        1    6     50     40     30   20.5   19.8   17.4 20.5   50
6.4        2    6     60     55     44   25.1   25.2   25.3 25.1   60
7.2        1    7     50     40     30   20.5   19.8   17.4 19.8   40
7.5        2    7     60     55     44   25.1   25.2   25.3 25.2   55
8.3        1    8     50     40     30   20.5   19.8   17.4 17.4   30
8.6        2    8     60     55     44   25.1   25.2   25.3 25.3   44

本质上，它基于year 拆分数据，然后使用within 在每个子集中创建varX 和varY 变量，然后rbind 将子集重新组合在一起。

但是，您的 Stata 代码的直接翻译将类似于以下内容：

u <- unique(d$year)
for(i in seq_along(u)){
    d$varX <- ifelse(d$year == 6, d$varX06, ifelse(d$year == 7, d$varX07, ifelse(d$year == 8, d$varX08, NA)))
    d$varY <- ifelse(d$year == 6, d$varY06, ifelse(d$year == 7, d$varY07, ifelse(d$year == 8, d$varY08, NA)))
}

【讨论】：

【解决方案4】：

这是另一种选择。

根据year 创建一个“列选择矩阵”，然后使用它从任何列块中获取您想要的值。

# indexing matrix based on the 'year' column
col_select_mat <- 
    t(sapply(your_df$year, function(x) unique(your_df$year) == x))

# make selections from col groups by stub name
sapply(c('varX', 'varY'), 
    function(x) your_df[, grep(x, names(your_df))][col_select_mat])

这给出了想要的结果（如果你愿意，你可以将它绑定到your_df）

    varX varY
[1,]   50 20.5
[2,]   60 25.1
[3,]   40 19.8
[4,]   55 25.2
[5,]   30 17.4
[6,]   44 25.3

OP的数据集：

your_df <- read.table(header=T, text=
'study_id year varX06 varX07 varX08 varY06 varY07 varY08
   1       6   50     40     30     20.5  19.8   17.4
   1       7   50     40     30     20.5  19.8   17.4
   1       8   50     40     30     20.5  19.8   17.4
   2       6   60     55     44     25.1  25.2   25.3
   2       7   60     55     44     25.1  25.2   25.3
   2       8   60     55     44     25.1  25.2   25.3')

基准测试：查看已发布的三个解决方案，这似乎是平均最快的，但差异非常小。

df <- your_df
d <- your_df

arvi1000 <- function() {
  col_select_mat <- t(sapply(your_df$year, function(x) unique(your_df$year) == x))
  # make selections from col groups by stub name
  cbind(your_df, 
        sapply(c('varX', 'varY'), 
               function(x) your_df[, grep(x, names(your_df))][col_select_mat]))
}

jlhoward <- function() {
  years   <- unique(df$year)
  df$varX <- unlist(lapply(years,function(yr)df[df$year==yr,paste0("varX0",yr)]))
  df$varY <- unlist(lapply(years,function(yr)df[df$year==yr,paste0("varY0",yr)]))
}

Thomas <- function() {
  do.call(rbind, by(d, d$year, function(x) { within(x, { varX <- x[, paste0('varX0',x$year[1])]; varY <- x[, paste0('varY0',x$year[1])] }) } ))
}

> microbenchmark(arvi1000, jlhoward, Thomas)
Unit: nanoseconds
     expr min lq  mean median uq  max neval
 arvi1000  37 39 43.73     40 42  380   100
 jlhoward  38 40 46.35     41 42  377   100
   Thomas  37 40 56.99     41 42 1590   100

【讨论】：