【问题标题】：Loop function in r to compare values of different data framesr中的循环函数来比较不同数据帧的值
【发布时间】：2021-09-20 12:32:05
【问题描述】：

简介

大家好，

对于一个小项目，我尝试获取一个函数来比较数据帧 1 的值与数据帧 2 的值。此后，数据帧 3 和 4 应该打印比较的信息。

数据框 1：

ID	x1i	x2i	x3i
a	1	2	4
b	1	4	1

数据框 2：

Data_Frame_2 <- c(1:4)

读取 x1a 并与数据框 2 比较。值 1 在数据框 2 中。在数据框 3 中打印值 1 和变量 (x1a) 的名称，并从数据框 2 中划掉值 1。

读取 x1b 并与数据帧 2 进行比较。值 1 （不再）在数据帧 2 中。读取 x2b。值 4 在数据框 2 中。在数据框 3 中打印值 4 和变量名称 (x2b)，并从数据框 2 中划掉值 4。

Data Frame 3 应该是这样的：

数据框 3：

ID	Value	Variable
a	1	x1i
b	4	x2i

Data Frame 4（Data Frame 2的剩余数量）：

Remaining numbers
2
3

R 中的示例解决这个理论问题

到现在为止，我编写了这段代码来完成这项工作：

    b <- as.data.frame(c(1:4)) # data frame 2
    colnames(b, do.NULL = FALSE)
    colnames(b) <- c("b")
    View(b)

    a <- as.data.frame(cbind(c("a","b"), c(3,3), c(2,1), c(1,2))) # data frame 1
    colnames(a, do.NULL = FALSE)
    colnames(a) <- c("ID","x1i","x2i","x3i")
    View(a)

    `%notin%` <- Negate(`%in%`) #got this one from <https://www.marsja.se/how-to-use-in-in-r/>
    Read_Info <- function(a,b)
    {
      if (a[1,2] %in% b[1:4,1]) {c_1<-c(a[1,1:2],names(a)[2]); b1<-subset(b,b %notin% a[1,2])} 
      if (a[2,2] %in% b1[1:3,1]) {c_2<-c(a[2,1:2],names(a)[2]); b2<-subset(b,b %notin% c(a[1,2],a[2,2]))} 
      else if (a[2,3] %in% b1[1:3,1]) {c_2<-c(a[2,1],a[2,3],names(a)[3]); b2<-subset(b,b %notin% c(a[1,2],a[2,3]))} 
      if (a[3,2] %in% b2[1:2,1]) {c_3<-c(a[3,1],a[3,2],names(a)[2]); b3<-subset(b,b %notin% c(a[1,2],a[2,3],a[3,2]))} 
      else if (a[3,2] %notin% b2[1:2,1]) {c_3<-c(NA,NA,NA); b3<-b2} 
      c<-rbind(c_1,c_2,c_3)
      colnames(c, do.NULL = FALSE)
      colnames(c) <- c("ID","Value","Variable")
      bx<-b3
      colnames(bx, do.NULL = FALSE)
      colnames(bx) <- c("Remaining numbers")
      print(c)
      print(bx)
    }

    Read_Info(a,b)

    # In this example, c is data frame 3 and bx is data frame 4

手头的实际任务 - If, else if R 中的循环函数

我确实面临以下障碍：我拥有的实际数据比上面的例子大一点。然而，它遵循相同的结构：

    b <- as.data.frame(c(1:20)) # this would be Data Frame 2 in the theoretical considerations
    colnames(l, do.NULL = FALSE)
    colnames(l) <- c("b")
    View(l)

    # This would be data frame 1 in the theoretical considerations
    # Note: between "ID" and "x1i", there are now two additional variables which were not in the example above
    # Although these two variables are part of the data, they are not of interest right know
    a2 <- cbind(c("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t"),c(0),c(1))
    a1 <- data.frame(replicate(16,sample(1:20,rep=T)))
    a <- cbind(a2, a1)
    colnames(a, do.NULL = FALSE)
    colnames(a) <- c("ID","variable1","variable2","x1i","x2i","x3i","x4i","x5i","x6i","x7i","x8i","x9i","x10i","x11i","x12i","x13i","x14i")
    View(a)

我尝试使用“for”创建一个“if”、“else if”循环函数，它应该自己完成这个阅读任务。到现在为止，我写了下面的代码还不能用。

    `%notin%` <- Negate(`%in%`) # got this one from <https://www.marsja.se/how-to-use-in-in-r/>
    Read_Info_Loop <- function(a,b)
      {for (i in 1:20) 
    { if (a[i,4] %in% b[1:(21-i),1]) {x[i]<-c(a[i,1],a[i,4],names(a)[4]); b[i]<-subset(b,b %notin% a[i,4])} 
      if (a[i,5] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,5],names(a)[5]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,5]))
      } else if (a[i,6] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,6],names(a)[6]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,6]))
      } else if (a[i,7] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,7],names(a)[7]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,7]))
      } else if (a[i,8] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,8],names(a)[8]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,8]))
      } else if (a[i,9] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,9],names(a)[9]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,9]))
      } else if (a[i,10] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,10],names(a)[10]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,10]))
      } else if (a[i,11] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,11],names(a)[11]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,11]))
      } else if (a[i,12] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,12],names(a)[12]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,12]))
      } else if (a[i,13] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,13],names(a)[13]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,13]))
      } else if (a[i,14] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,14],names(a)[14]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,14]))
      } else if (a[i,15] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,15],names(a)[15]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,15]))
      } else if (a[i,16] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,16],names(a)[16]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,16]))
      } else if (a[i,17] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,17],names(a)[17]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,17]))
      } else if (a[i,17] %notin% b[1:(21-i),1]) {x[i]<-c(NA,NA,NA); b[i]<-c(b[i-1])}
    y<-rbind(x[i[1:20]]) 
              colnames(y, do.NULL = FALSE)
              colnames(y) <- c("ID","Value","Variable")
    u<-rbind(b[i=20])
              colnames(u, do.NULL = FALSE)
              colnames(u) <- c("Remaining numbers")
        print(y)
        print(u)

      }
      }
    # y is supposed to be data frame 3 and u is supposed to be data frame 4 
    # in the above theoretical considerations

错误

我现在收到以下错误：

    Error in `[<-.data.frame`(`*tmp*`, i, value = c("a", "1", "x3i")) : 
      replacement has 3 rows, data has 4

    Error in Read_Info_Loop(test, l) : object 'x' not found

...不过，我昨天遇到的第一个错误。今天重启R后，出现第二个错误，似乎是解决函数代码内部结构问题。此外，我很确定，可能还有其他错误现在“隐藏”在其他错误之后，并且一旦处理了上述两个错误就会发生。

但是，我不希望你只是解决任何问题。我想问一下，如果您有想法我如何解决这两个特定错误，也许还有一个提示，让该功能更接近正常工作。所以，对我来说，重点显然是学习一两件事。

一些免责声明：我没有编程经验，所以代码或我的描述可能相当混乱。因此，如果您有任何需要澄清的问题，请随时提出。我试图尽快做出回应。英语不是我的母语，如有任何语言错误请见谅。

我期待学习并听到您对代码本身的想法、关于理论考虑或循环函数方法的想法。

亲切的问候

保罗

编辑/进度

编辑：我刚刚意识到，代码已经可以用另一个“for”来简化。尽管如此，我读到应该避免嵌套的“for”循环（for...for...）

    `%notin%` <- Negate(`%in%`) #got this one from <https://www.marsja.se/how-to-use-in-in-r/>
    Read_Info_Loop2 <- function(a,b)
    {for (i in 1:20) for (k in 5:17) {
    { if (a[i,4] %in% b[1:(21-i),1]) {x[i]<-c(a[i,1],a[i,4],names(a)[4]); b[i]<-subset(b,b %notin% a[i,4]) 
      } else if (a[i,k] %in% b[i-1][1:(21-i),1]) {x[i]<-c(a[i,1],a[i,k],names(a)[k]); b[i]<-subset(b,b %notin% c(a[1,4],a[i,k]))
      } else if (a[i,k] %notin% b[1:(21-i),1]) {x[i]<-c(NA,NA,NA); b[i]<-c(b[i-1])}
    }
      y<-rbind(x[i[1:20]]) 
      colnames(y, do.NULL = FALSE)
      colnames(y) <- c("ID","Value","Variable")
      u<-rbind(b[i=20])
      colnames(u, do.NULL = FALSE)
      colnames(u) <- c("Remaining numbers")
      print(y)
      print(u)
    }
    }

显示同样的错误：

    Error in Read_Info_Loop2(test, l) : object 'x' not found

我尝试使用此资源，继续前进：https://cran.r-project.org/doc/manuals/r-release/R-intro.html#Repetitive-execution

我将提供进一步的更新。

【问题讨论】：

标签： r function loops for-loop if-statement

【解决方案1】：

这是一个棘手的问题。我能够找到潜在问题的解决方案，但不幸的是，我无法按照要求修复 OP 的代码。

但是，这是我的解决方案：

library(data.table)
long <- melt(setDT(a), "ID", patterns("^x"))
df3 <- long[, {
  if (any(.SD$value %in% b)) {
    result <- first(.SD[value %in% b])
    b <- setdiff(b, result$value)
  } else {
    result <- data.table(variable = NA_integer_, value = NA_integer_)
  }
  result
}, by = ID]
df3

   ID variable value
1:  a      x1i     1
2:  b      x2i     4

# remaining values
df4 <- data.table(Remaining.numbers = setdiff(b, df3$value))
df4

   Remaining.numbers
1:                 2
2:                 3

说明

第一步，将数据集a 重新整形为长格式
```
long
```
```
   ID variable value
1:  a      x1i     1
2:  b      x1i     1
3:  a      x2i     2
4:  b      x2i     4
5:  a      x3i     4
6:  b      x3i     1
```
现在，variable 包含列名称作为数据项，这简化了后续步骤。请注意，melt() 保持了原始的行和列顺序，这对于以后选择正确的值很重要。
现在，我们通过 ID 的唯一值循环遍历 long。这是通过分组来实现的。作为data.table的特长，我们可以使用任意表达式（用大括号括起来）进行聚合。
对于每个ID，我们检查在remaining 值的向量中是否至少有一个value 可用。如果是这样，则将第一次出现作为结果行。对应的value 从b 中删除，然后用于下一个“迭代”，即下一个组级别。
请注意，表达式（大括号中）内的b 是一个局部变量。 b 的修改值在表达式环境之外不可用。
在使用任意数据集进行测试时，我注意到可能存在属于ID 的所有数字都已从remaining 中删除的情况。为了表明这一点，将返回一个带有 NA 值的虚拟 result。
因此，对于每个ID 组，将返回一行，然后将其组合成一个 data.table 对象并分配给df3。
df4 包含Remaining.numbers，是通过构建b 和选取值向量df3$value 之间的集合差异而创建的。

请注意，出于演示目的，我曾尝试将代码重写为循环，但我放弃了，因为我发现记账开销不值得。

数据

对于 OP 问题中的第一个用例：

a <- fread("ID  x1i x2i x3i
a   1   2   4
b   1   4   1")
b <- 1:4

可以使用以下代码创建具有不同行数、列数和 b 长度的其他用例。请注意set.seed() 很重要，因为创建的数据集a 和结果df3 和df4 都依赖于它。例如，使用set.seed(123)，我们可以重现最后一个ID 的剩余号码列表已用完的情况。

# number of rows and columns to create
n_rows <- 18
n_cols <- 16
# create vector b
b <- 1:20
# create data.frame a
a2 <- data.frame(ID = letters[seq(n_rows)], variable1 = 0, variable2 = 1)
set.seed(123) # to ensure reproducible results
a1 <- as.data.frame(replicate(n_cols, sample(b, n_rows, replace = TRUE)))
colnames(a1) <- sprintf("x%ii", seq(n_cols))
a <- cbind(a2, a1)

【讨论】：

【解决方案2】：

Uwe 的解决方案

非常感谢 Uwe 的解决方案和全面的解释！我什至没有想到将这些值组合到一个列表中并让函数在该列表上运行。因此，您的解决方案为数据开辟了新的视角。我将详细尝试您的解决方案，以尽可能多地学习并尽快在这里报告！

关于原代码的解决方案

我花了很长时间才找到原始代码的解决方案。

    test2 <- cbind(c("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t"),c(0),c(1),c(1,1,1,sample(1:15),1,1),c(2,3,3,sample(1:15),2,3))
    test1 <- data.frame(replicate(12,sample(1:20,rep=T)))
    data.frame1 <- cbind(test2, test1)
    colnames(data.frame1) <- c("ID","variable1","variable2","x1i","x2i","x3i","x4i","x5i","x6i","x7i","x8i","x9i","x10i","x11i","x12i","x13i","x14i")

    data.frame2 <- as.data.frame(c(1:20))

    x <- as.data.frame(matrix(NA,nrow = 3,ncol = 20))
    rownames(x) <- c("ID","value","variable")
    colnames(x) <- c()
    View(x)

    `%notin%` <- Negate(`%in%`) #got this one from <https://www.marsja.se/how-to-use-in-in-r/>
    Read_Info_Loop2 <- function(a,b) {for (k in 1:20) {for (i in 4:17)
      {if (a[k,i] %in% b[,1]) {x[k]<-c(a[k,1],(a[k,i]),names(a[i])); b<-subset(b,b %notin% a[k,i]);break}}
       }
      c<-rbind(x)
      bx<-b
      colnames(bx) <- c("numbers remaining")
      print(c)
      print(bx)
      }

    Read_Info_Loop2(data.frame1, data.frame2)

此解决方案的唯一缺点是输出。它是一种奇怪的形式。但我真的不介意。所以现在我们已经有了两种使用不同方法的解决方案。非常令人兴奋。关于 data.frames 3 和 4 的输出（见下图一些实际数据的输出）：最后 7 列是 NA，因为这个 data.frame1_original 只有 13 行（k=13）。所以对于最后 7 次迭代（k=14 到 k=20），没有输出。

这里是上面描述的随机data.frame1的输出。在这里，解决方案看起来很奇怪，因为对于“r”和“t”，所有条目都已从 data.frame2 中删除，它返回这些行的 NA。剩下的两个数字是 18 和 20。

【讨论】：