比较每 2 行并显示 R 中的不匹配

Question

我进行了很多搜索并自己尝试过，但找不到针对此特定问题的解决方案。

对于每 2 行（'key' 很常见），我必须在每一列中找到不匹配的地方，并以如下所示的有条理的方式突出显示它们。

输出应采用以下格式：

COLUMN_NAME is not matching for records below:
PRINT COMPLETE RECORDS
...
COLUMN_NAME is not matching for records below:
PRINT COMPLETE RECORDS
...
COLUMN_NAME is not matching for records below:
PRINT COMPLETE RECORDS
...

输入数据（它是一个数据框）：

key V1  V2  V3  V4  V5
a1  1   2   3   4   5
a1  1   3   9   4   5
a5  2   1   4   7   5
a5  2   1   4   7   6
a6  7   6   8   9   6
a6  7   6   3   9   6
a9  7   6   8   9   4
a9  7   6   8   9   3

输出：

V2 is not matching for records below:
key V1  V2  V3  V4  V5
a1  1   2   3   4   5
a1  1   3   9   4   5


V3 is not matching for records below:
key V1  V2  V3  V4  V5
a1  1   2   3   4   5
a1  1   3   9   4   5
a6  7   6   8   9   6
a6  7   6   3   9   6


V5 is not matching for records below:
key V1  V2  V3  V4  V5
a5  2   1   4   7   5
a5  2   1   4   7   6
a9  7   6   8   9   4
a9  7   6   8   9   3

我是 R 的初学者，所以请善待 :)

Answer 1

首先将您的数据框按key：

dfs <- split(df, df$key)  # presuming your data frame is named `df`

现在编写一个函数，获取一个数据框并比较第一行和第二行（为简单起见，我们不会检查数据框是否实际上有 2 行 - 这只是理所当然的）：

chk <- function(x) sapply(x, function(u) u[1]==u[2])

现在将该函数应用于split'ed 数据：

matches <- sapply(dfs,chk)
## so `foo` is a matrix showing, for each variable and each ID, whether there is 
## a match or not
apply(matches, 1, function(x) colnames(matches)[which(!x)])
## and this one takes each row in `foo` and extracts the column name (i.e. key)
## for every TRUE-valued cell.  the result is a list - note that some of the
## elements will be empty

最后一行输出每个变量的不匹配对的名称（key 列）。

现在是最后一步：

mm_keys <- apply(matches, 1, function(x) colnames(matches)[which(!x)])
# mm_keys stands for mismatching keys
lapply(mm_keys, function(x) subset(df, key %in% x))
# this one, called `mm_lines` below, takes each element from mm_keys
# .. and extracts (via `subset`) the corresponding lines from the original data frame

好的，您已经拥有了您想要的所有信息，但没有以很好的方式格式化。您也可以轻松做到这一点。

mm_lines <- lapply(mm_keys, function(x) subset(df, key %in% x))
mm_lines <- mm_lines[sapply(mm_lines, nrow)>0]  
# leave out variables where there is no mismatch
# for understanding this, try what `sapply(mm_lines, nrow)` does
# and add labels the way you want:
names(mm_lines) <- paste(names(mm_lines), "IS NOT MATCHING FOR RECORDS BELOW:")

现在输出：

print(boo)
#$`V2 IS NOT MATCHING FOR RECORDS BELOW:`
#  key V1 V2 V3 V4 V5
#1  a1  1  2  3  4  5
#2  a1  1  3  9  4  5
#
#$`V3 IS NOT MATCHING FOR RECORDS BELOW:`
#  key V1 V2 V3 V4 V5
#1  a1  1  2  3  4  5
#2  a1  1  3  9  4  5
#5  a6  7  6  8  9  6
#6  a6  7  6  3  9  6
#
#$`V5 IS NOT MATCHING FOR RECORDS BELOW:`
#  key V1 V2 V3 V4 V5
#3  a5  2  1  4  7  5
#4  a5  2  1  4  7  6
#7  a9  7  6  8  9  4
#8  a9  7  6  8  9  3

[编辑]

既然你要求它，这里有一些东西可以在一行上完成，看起来有点像魔术师：

boo <- (function(x) x[sapply(x, nrow)>0])(lapply(lapply(df, function(x) tapply(x, df$key, function(x) x[1]!=x[2])), function(x) subset(df, key %in% names(which(x)))))

并以您想要的方式将其写入文本文件（“out.txt”）：

sink("out.txt")
for(iii in seq_along(boo)){
  cat(names(boo)[iii], "IS NOT MATCHING FOR THE RECORDS BELOW:\n")
  print(boo[[iii]])
  cat("\n")
  }
sink(NULL)

Answer 2

你可以试试by

res <- c(with(stack(by(df[,-1], df[,1],
         FUN=function(x)names(x)[ x[1,]!=x[2,]])), 
           by(ind, values, FUN=function(x) df[df[,1] %in% x,])))

 names(res) <- paste(names(res), "is not matching for records below")
 res
#$`V2 is not matching for records below`
#  key V1 V2 V3 V4 V5
#1  a1  1  2  3  4  5
#2  a1  1  3  9  4  5

#$`V3 is not matching for records below`
#  key V1 V2 V3 V4 V5
#1  a1  1  2  3  4  5
#2  a1  1  3  9  4  5
#5  a6  7  6  8  9  6
#6  a6  7  6  3  9  6

#$`V5 is not matching for records below`
# key V1 V2 V3 V4 V5
#3  a5  2  1  4  7  5
#4  a5  2  1  4  7  6
#7  a9  7  6  8  9  4
#8  a9  7  6  8  9  3