R：“R-ify”三重循环，条件基于行位置答案

【问题标题】：R: "R-ify' triple loop with conditions based on row positionR：“R-ify”三重循环，条件基于行位置
【发布时间】：2014-05-21 09:23:37
【问题描述】：

我设法编写了一段相当笨重的代码，它在很大程度上可以满足我的需求，但问题是它速度慢而且我的数据库太大，这意味着基本上不行。我制作了一个可重现的数据集，我会尽量解释我需要做什么：

Y <-structure(list(X1 = structure(c(2L, 2L, 2L, 3L, 3L, 6L, 6L, 4L, 4L, 4L, 4L, 4L,4L, 4L, 5L, 5L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("23", "2636","15B","2637", "2638", "2639"), class = "factor"), X2 = structure(c(16L, 16L, 18L, 8L, 10L, 16L, 17L, 8L, 11L, 13L, 15L, 15L, 17L, 17L, 8L, 10L, 1L, 1L, 2L, 3L, 3L, 4L, 4L, 5L, 6L, 6L, 7L, 7L, 7L, 7L, 9L, 9L, 10L, 12L, 13L, 13L, 14L, 14L, 14L, 14L), .Label = c("1980", "1981", "1982", "1983", "1984", "1986", "1987", "1988", "1989", "1990", "1991", "1992", "1993", "1994", "1995", "1996", "1997", "1998"), class = "factor"), X3 = structure(c(4L, 11L, 4L, 3L, 14L, 5L, 5L, 12L, 12L, 8L, 8L, 12L, 5L, 8L, 4L, 4L, 3L, 4L, 3L, 3L, 13L, 8L, 10L, 15L, 3L, 14L, 3L, 4L, 8L, 14L, 1L, 3L, 3L, 14L, 3L, 6L, 1L, 2L, 7L, 9L), .Label = c("ABT", "AZN", "BAX", "BAY", "BMS", "GET", "GSK", "JNJ", "LIL", "MER", "NOV", "PFI", "S.A", "SAG", "SHI"), class = "factor"), X4 = structure(c(3L, 3L, 3L, 2L, 2L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("1980", "1988", "1996"), class = "factor"), X5 = structure(c(5L, 5L, 5L, 2L, 2L, 4L, 4L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("1981", "1990", "1991", "1997", "1998"), class = "factor")), .Names = c("X1", "X2", "X3", "X4", "X5"), row.names = c(NA, 40L), class = "data.frame")    

Y<-data.frame(Y)
colnames(Y)<-c("s","y","f","pb","pbs")
Y[,"pbc"]<-NA
Y<-Y[order(Y$s, decreasing =F),]
Y$s<-as.character(Y$s)
Y$y<-as.numeric(as.character(Y$y))
Y$pb<-as.numeric(as.character(Y$pb))
Y$pbs<-as.numeric(as.character(Y$pbs))

在此数据框中 s = 符号，y = 年份，f = 公司，pb = 第一个符号的年份，如果符号出现在第一个符号的 3 年内，pbs = 第二个符号的年份，pbc 指的是新变量“符号”确认”。 pb 和 pbs 已在行业级别进行编码，现在我想找出具有第一个符号 (pb) 的公司是否也具有第二个符号 (pbs)。如果是这种情况，pbc 的值应该取 pbs 的值。 ff 是所有公司的列表。

这是我目前的代码：

for (j in 1:length(ff)){
a<-as.vector(table(Y[Y$f ==ff[j],][,"s"]))
for (k in 1:(length(levels(as.factor(Y[Y$f ==ff[j],][,"s"]))))) {
  for (i in 1:(nrow(Y[Y$f ==ff[j],])-1)) {
    Y[Y$f ==ff[j],][,"pbc"][i] <-
      if ((a[k] >  1) && 
            (Y[Y$f ==ff[j],][,"y"][i] == Y[Y$f ==ff[j],][,"pb"][i]) 
          && 
            (Y[Y$f ==ff[j],][,"y"][i+1] == Y[Y$f ==ff[j],][,"pbs"][i+1]))
      {Y[Y$f ==ff[j],][,"pbs"][i]}
    else {0} 
  }}}

它看起来很复杂，但它的作用如下：

我将一个特定的公司 j 隔离到一个 subdata.frame Y[Y$f ==ff[j],]
我检查“s”有多少个不同的值（通过表格）
如果至少有两行重复“s”值(a[k] > 1) 检查是否满足其他两个条件。如果是，添加“pbs”的值

现在这个结果有效，但包含两个问题。

首先，总是有一些值保留NA。我不认为它们会造成任何问题，但立即摆脱这些 NA 会很棒（就我而言）
效率不高，我认为我的简单计算机无法处理整个数据集（具有 > 2500 个标志、> 30 年、> 35 家公司）

当前代码的预期结果（注意理想情况下不应出现 NA 值）

pbc = c(0,0,1981,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,NA,NA,0,NA,,0,0,0,1998,0,0,1991,0,0,0,NA,0,NA,1(90,NA,1997,NA)

为了进一步阐明我建议的代码应该如何工作，我运行了其中的一部分，希望能更清楚地一次性显示我想要做什么。

bayY<-Y[Y$f == "BAY",]
for (i in 1:nrow(bayY)-1){
  bayY$pbc[i+1] <- 
    if ((bayY$s[i] == bayY$s[i+1]) && (bayY$y[i] == bayY$pb[i]) && (bayY$y[i+1] == bayY$pbs[i+1])) {bayY$pbs[i+1]}
  else {0}
}

因此，我在隔离该公司后测试该公司的条件。结果给了我所有正确的值。我可以为每家公司执行此操作，然后将它们全部合并到一个新的 df 中，但必须有一种方法可以更有效地执行此操作...

【问题讨论】：

你的例子给了我以下错误：Error in Ops.factor(Y[Y$f == ff[j], ][, "y"][i], Y[Y$f == ff[j], ][, "pb"][i]) : level sets of factors are different
一般代码建议：每次写Y[Y$f ==ff[j],][,"s"]这样的索引表达式，就写Y[Y$f ==ff[j],"s"]即可。不需要两组括号。
你的例子也有问题（上面的错误），因为试图比较不同水平的因素。您需要将所有内容转换为字符或数字，以便在整个代码中进行 == 比较。
谢谢Thomas，我忘了把那些“as.character()”命令和昨天一样。我在编辑中添加了它们。感谢您的格式建议，看起来会更好。

标签： r loops if-statement for-loop

【解决方案1】：

@Christian Borck 和@Thomas，

非常感谢您的帮助。我想我用一个简单的技巧解决了这个问题。一家公司的解决方案效果很好，所以我先为一家公司解决它，然后对所有其他公司重复同样的事情，同时包括rbind以确保结果存储在单独的数据框中。

tmp<-Y[Y$f == ff[1],]
for (i in 1:(nrow(tmp)-1)){
  tmp$pbc[i+1] <- 
    if ((tmp$s[i] == tmp$s[i+1]) && (tmp$y[i] == tmp$pb[i]) && (tmp$y[i+1] == tmp$pbs[i+1])) {tmp$pbs[i+1]}
  else {0}
}
PBC<-tmp

for (j in 2:15) {
  tmp<-Y[Y$f == ff[j],]
  for (i in 1:(nrow(tmp)-1)){
    tmp$pbc[i+1] <- 
      if ((tmp$s[i] == tmp$s[i+1]) && (tmp$y[i] == tmp$pb[i]) && (tmp$y[i+1] == tmp$pbs[i+1])) {tmp$pbs[i+1]}
    else {0}
  }
  PBC<-rbind(PBC,tmp)
}

【讨论】：

【解决方案2】：

您能否发布预期结果的示例？正如 Thomas 所说，您的代码会出错。

以下代码至少为您提供了具有两个或多个符号的公司以及修改后的 pbc 值。在下一步中，您可以继续...

require(data.table)
dt <- data.table(Y)    # your data.frame

dt[, list(unique_signs = length(unique(s)),
          pbc          = max(unique(pbs))),
   by=list(f)][unique_signs>1]

【讨论】：

好的，应该这样做：dt[, list(pbc = ifelse(length(unique(s)) > 1, max(unique(pbs)), 0 )), by=list( f)]
嗨，Christian，我认为这很有潜力，但目前它的作用是为每个公司提供一个价值。这不是我需要的，因为我需要为每个标志检查同一家公司是否面临一次或两次。你的结果给了我所有公司，独特标志的数量，以及我无法解释的 pbc 的一些年份。对于每个单独的标志，我都需要这个。我的代码（在我的计算机上）适用于一个小样本，甚至高达 1,500，但高于此，Rstudio 中的红色图标会一直站在那里，如果我设置 j = 3 甚至 4 小时......
对不起，我仍然不完全清楚您要做什么...对于每个公司，对于每个至少出现两次的 SIGN，检查 YEAR 是否等于 PB 和 PBS减去 PB 小于 4。如果是，将 PBC 设置为 PBS？
好的，如果 year[i] == pb[i] 和 year[i+1]，对于每个至少出现两次符号的公司（比如第 i 行和第 i+1 行） == pbs[i+1] 然后设置 pbc[i] = pbs[i] （或理想情况下设置 pbc[i+1] = pbs[i+1]）。因此，在有序 Y 数据帧中，第 27 行和第 29 行具有相同的符号 (2636) 和相同的公司 BAY 并满足条件，因此理想情况下 pbc[29] 将设置为 pbs[29]。对于第 3 行和第 5 行，同样适用于 BAX 和符号 23。但是，查看第 4 行和第 14 行的符号 23 和公司 BAY，我们看到第一个条件成立，但 pbs[14] 不等于 y[14]所以结果应该是零......
不需要测试 pbs - pb