R：你如何计算（百分比）匹配观察？

Question

所以我的数据集看起来像这样，字母是因子变量。 Pred 列用于每个 ID 的预测观测值，Real 列是真实观测值。我想计算每个 ID 的预测值的总体准确度。

ID  Pred1 Pred2 Pred3 Real1 Real2 Real3
1    A      C     E      A     D    B
2    A      B     D      E     C    C
3    E      C     A      A     B    D
4    D      A     B      B     B    D
5    B      A     C      C     A    B

所以我想改变一个名为“score”的列，它为您提供 Pred1,2,3 和 Real1,2,3 列之间匹配观察数的百分比。 我只关心在任何“Real”列中找到任何“Pred”值。 如果在 Real1、Real2 和 Real3 之一中找到 Pred1，那么我给出的分数是 1/3。 如果 Pred1 和 Pred2（不是 Pred3）都在 Real1、Real2 和 Real3 列中的任何一个中找到，（*顺序无关紧要。Pred1 可以在 Real2 或 Real3 中找到——就在“Real”列中的任何位置），那么我给出2/3 的分数。 我希望这是有道理的。顺序无关紧要，我只关心在任何“Real”列中找到任何“Pred”值。 所以我想要下面的东西。

ID  Pred1 Pred2 Pred3 Real1 Real2 Real3  Score
1    A      C     E      A     D    B     1/3
2    A      B     D      E     C    C      0
3    E      C     A      A     B    D     1/3
4    D      A     B      B     E    D     2/3
5    B      A     C      C     A    B      1

我正在尝试编写一个函数并尝试了类似的东西 ifelse("Pred1" %in% c("Real1","Real2","Real3") , 1/3 ,0 )) 但效果不佳..（有错误消息与强制逻辑等我不知道怎么解决） 所以我也在尝试不同的事情，但一直被错误困住...... 有人可以帮忙吗？提前谢谢！

Answer 1

很难比较具有不同因子水平的值。我们可以首先将列从因子转换为字符。

df[-1] <- lapply(df[-1], as.character)

找出 Predicted 和 Real 列的索引，然后为每一行检查 Real 中存在多少 Predicted 观察。

pred_cols <- grep("^Pred", names(df))
real_cols <- grep("^Real", names(df))

df$Score <- sapply(1:nrow(df), function(x) 
            sum(df[x, pred_cols] %in% df[x, real_cols]))/length(pred_cols)

df
#  ID Pred1 Pred2 Pred3 Real1 Real2 Real3 Score
#1  1     A     C     E     A     D     B  0.33
#2  2     A     B     D     E     C     C  0.00
#3  3     E     C     A     A     B     D  0.33
#4  4     D     A     B     B     B     D  0.67
#5  5     B     A     C     C     A     B  1.00

---

由于是逐行比较，我们也可以使用相同的逻辑将apply 与MARGIN = 1 一起使用。使用这种方法，我们不需要将列显式转换为字符。

apply(df, 1, function(x) sum(x[pred_cols] %in% x[real_cols]))/length(pred_cols)

Answer 2

tidyverse 的一种可能是：

bind_cols(df %>%
 gather(var, val, -matches("(Real|ID)")) %>%
 select(ID, val), df %>%
 gather(var2, val2, -matches("(Pred|ID)")) %>%
 select(val2)) %>%
 group_by(ID) %>%
 summarise(res = paste0(sum(val %in% val2), "/3")) %>%
 left_join(df, by = c("ID" = "ID"))

     ID res   Pred1 Pred2 Pred3 Real1 Real2 Real3
  <int> <chr> <fct> <fct> <fct> <fct> <fct> <fct>
1     1 1/3   A     C     E     A     D     B    
2     2 0/3   A     B     D     E     C     C    
3     3 1/3   E     C     A     A     B     D    
4     4 2/3   D     A     B     B     B     D    
5     5 3/3   B     A     C     C     A     B 

它首先将包含Pred 和Real 的列分别从宽格式转换为长格式。其次，它按列将两者结合起来。最后，它按“ID”分组，将匹配案例的数量相加，并将其与原始 df 连接。

或者如果对数不固定为3：

bind_cols(df %>%
 gather(var, val, -matches("(Real|ID)")) %>%
 select(ID, val), df %>%
 gather(var2, val2, -matches("(Pred|ID)")) %>%
 select(val2)) %>%
 add_count(ID) %>%
 group_by(ID) %>%
 summarise(res = paste(sum(val %in% val2), first(n), sep = "/")) %>%
 left_join(df, by = c("ID" = "ID"))

或者如果你想要一个数值变量作为结果：

bind_cols(df %>%
           gather(var, val, -matches("(Real|ID)")) %>%
           select(ID, val), df %>%
           gather(var2, val2, -matches("(Pred|ID)")) %>%
           select(val2)) %>%
 add_count(ID) %>%
 group_by(ID) %>%
 summarise(res = sum(val %in% val2)/first(n)) %>%
 left_join(df, by = c("ID" = "ID"))

     ID   res Pred1 Pred2 Pred3 Real1 Real2 Real3
  <int> <dbl> <fct> <fct> <fct> <fct> <fct> <fct>
1     1 0.333 A     C     E     A     D     B    
2     2 0     A     B     D     E     C     C    
3     3 0.333 E     C     A     A     B     D    
4     4 0.667 D     A     B     B     B     D    
5     5 1     B     A     C     C     A     B