6

我是一名正在过渡到 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...

我想生成两个新变量,它们分别在年为 6时、年为 7 时和年为8 时分别取varXvarY的值。varX06varY06varX07varY07varX08varY08

最终数据集应如下所示:

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...

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

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

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

local stub varX varY

然后遍历宏列表。如果年份为 6,我可以生成一个新变量varX或用orvarY的值(分别)替换新变量值,依此类推。varX06varY06

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”,搜索了网络,并在 StackOverflow 上搜索了以前的帖子,但找不到 R 解决方案。

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

提前致谢,
塔拉

4

4 回答 4

2

好吧,这是一种方法。可以使用它们的字符名称访问 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(...)每年“应用”此函数,unlist(...)并将返回的列表转换为向量。

于 2014-11-10T06:29:54.917 回答
1

也许更透明的方式:

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]])
}
于 2015-06-06T16:35:47.643 回答
0

此方法对您的数据进行重新排序,但涉及单行,这可能对您更好也可能不会更好(假设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创建varXvarY变量,然后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)))
}
于 2014-11-13T19:49:20.143 回答
0

这是另一种选择。

创建一个基于 的“列选择矩阵” 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如果你愿意,你可以 cbind 到)

    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
于 2014-11-13T20:04:51.497 回答