Question

我是Stata用户，正在过渡到R，而且有一个我很难放弃的Stata拐杖。这是因为我不知道如何使用R的“apply”函数进行等效。

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

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

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分别为varX07和varY07 varX08当年份为7时分别为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

为了澄清，我知道我可以使用local stub varX varY和varX命令执行此操作 - 实际上将此数据从宽格式转换为长格式，但我不想诉诸于此。这不是我的问题的意图。

我的问题是如何循环R中的本地宏名单列表，我只是用这个简单的例子来说明更普遍的困境。

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

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 }或'x'06（分别），依此类推。

'i'

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

我如何用R做这些事？

我搜索了Muenchen的“St for Stata用户”，用Google搜索了网页，并在StackOverflow搜索了之前的帖子，但未能找到R解决方案。

如果这个问题很简单，我道歉。如果之前已经回答过，请指导我回复。

提前致谢，
塔拉

Answer 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(...)＆＃34;每年适用＆＃34;此功能，unlist(...)将返回的列表转换为矢量。

Answer 2

此方法重新排序您的数据，但涉及单行，可能会或可能不会更好（假设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)))
}

Answer 3

这是另一种选择。

根据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

Answer 4

也许是一种更透明的方式：

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]])
}

R等价于Stata的for-loop over local name of stubnames

4 个答案: