具有条件、迭代计算和公差匹配的复杂 ID 分配答案

【问题标题】：Complex ID Assignment with conditions, iterative calculations, and tolerance matching具有条件、迭代计算和公差匹配的复杂 ID 分配
【发布时间】：2018-12-27 01:37:40
【问题描述】：

我正在尝试编写一个相当复杂的迭代匹配函数，但我淹没在 ifelse 和不起作用的函数中。不幸的是，我没有人可以提出想法，因此感谢任何支持或想法。

我的数据结构

我的数据的每一行都是一个包含许多变量的观察结果，相关变量包含在此示例中。观察有一个指定的Sample_Name、一个对应于样本名称的Matching_Group、Time 的测量值和一个主观的Assigned_idx，它从数据清理的早期部分中部分完成。每个观察到的 Sample_Name 可以包含 0-7 个观察值，但 Matching_Group 将始终包含 7 个观察值。

structure(list(Sample_Name = c("A", "A", "A", "A", "A", "B", "B", "B", 
"B", "B", "B", "QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "SS", 
"SS", "SS", "SS", "SS", "SS", "SS"), Matching_Group = c("QQ", 
"QQ", "QQ", "QQ", "QQ", "SS", "SS", "SS", "SS", "SS", "SS", "QQ", 
"QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "SS", "SS", "SS", "SS", "SS", 
"SS", "SS"), Time = c(1, 1.1, 1.2, 1.4, 1.6, 7.203, 7.395, 
7.5, 7.6, 7.7, 7.802, 1, 1.102, 1.2, 1.3, 1.398, 1.501, 1.6, 
7.2, 7.3, 7.4, 7.5, 7.6, 7.7, 7.8), Assigned_idx = c(NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, 2, 3, 4, 5, 6, 7, 1, 2, 
3, 4, 5, 6, 7)), row.names = c(NA, -25L), class = c("tbl_df", 
"tbl", "data.frame"))


Sample_Name Matching_Group  Time        Assigned_idx

A           QQ              1.000   
A           QQ              1.100   
A           QQ              1.200   
A           QQ              1.400   
A           QQ              1.600   
B           SS              7.203   
B           SS              7.395   
B           SS              7.500   
B           SS              7.600   
B           SS              7.700   
B           SS              7.802   
QQ          QQ              1.000       1
QQ          QQ              1.102       2
QQ          QQ              1.200       3
QQ          QQ              1.300       4
QQ          QQ              1.398       5
QQ          QQ              1.501       6
QQ          QQ              1.600       7
SS          SS              7.200       1
SS          SS              7.300       2
SS          SS              7.400       3
SS          SS              7.500       4
SS          SS              7.600       5
SS          SS              7.700       6
SS          SS              7.800       7

我的问题

对于每个观察（行），我想计算对应Matching_Group 的每个行之间Time 的比率。每个Matching_Group 将分配一个唯一的Time_Ratio 值，计算需要等于+/- 一些容差。如果计算出的比率匹配特定于该组的预定义比率，我想提取并分配属于@987654333 观察的行中的Assigned_idx @ 并将其分配给观察。如果不是，请使用相同的观察到的Time 和Matching_Group 的下一行中的Time 重复计算。重复直到每个观察值在Assigned_idx 中都有一个值。

示例：在此数据集中，对于Matching_Group，Time_Ratio 应等于1.000 +/- 0.0020。在我的真实数据集中，每个Matching_Group 将有唯一的Time_Ratio 值，在单独的表中指定。所以对于 Time = 1.200 的第 3 行，Matching_Group 是 QQ。当我们使用第一个观察时间QQ 计算比率时，1.200/1.000 = 1.200 超出了我们定义的容差 --> 下一个观察时间 QQ。 1.200/1.102 = 1.089...再次超出我们的容忍范围。最后，1.200/1.200 = 1.000 确实在我们为此Matching_Group 指定的容差范围内。在具有匹配率的Matching_Group 的观察行中，Assigned_idx 列包含3。我们获取该值，并将其映射到第 3 行的 Assigned_idx 列。然后对第 4 行重复此操作并迭代该过程。

期望的结果：

Sample_Name Matching_Group  Time        Assigned_idx    Time_Ratio (Sample:Matching) 

A           QQ              1.000       1               1.0000
A           QQ              1.100       2               0.9982
A           QQ              1.200       3               1.0000
A           QQ              1.400       5               1.0014
A           QQ              1.600       7               1.0000
B           SS              7.203       1               1.0004
B           SS              7.395       3               0.9993
B           SS              7.500       4               1.0000
B           SS              7.600       5               1.0000
B           SS              7.700       6               1.0000
B           SS              7.802       7               1.0003
QQ          QQ              1.000       1               1.0000
QQ          QQ              1.102       2               1.0000
QQ          QQ              1.200       3               1.0000
QQ          QQ              1.300       4               1.0000
QQ          QQ              1.398       5               1.0000
QQ          QQ              1.501       6               1.0000
QQ          QQ              1.600       7               1.0000
SS          SS              7.200       1               1.0000
SS          SS              7.300       2               1.0000
SS          SS              7.400       3               1.0000
SS          SS              7.500       4               1.0000
SS          SS              7.600       5               1.0000
SS          SS              7.700       6               1.0000
SS          SS              7.800       7               1.0000

我已经尝试使用 dplyr 来解决这个问题，因为我认为它应该能够处理我想要完成的事情（也许 purrr 更适合？）。不幸的是，我似乎无法在 ifelse 和 for 函数中适当地对条件和表达式进行排序。我的尝试包括将 %>% 变异与比率计算、data.table::shift 等混合在一起，但我似乎无法让它与我的条件参数一起使用。此外，如果它是相关的，在我的真实数据中将有约 50 个“名称”和约 25 个匹配组。我将有第二个数据源列出匹配的组名和各自的比例，但在此示例中未包含此类详细信息。

我真的很难过，任何想法都值得赞赏。

【问题讨论】：

从dplyr 包中签出case_when()
在描述问题时，如果您可以从数据中添加示例或命名法，将会有所帮助。例如，比率是Variable 值之间的比率吗？ “观察组的名称”是指Name，“另一列指定要匹配的不同组”是指Relative Group吗？您能否举一个比率匹配失败的示例，然后根据后续行发生“提取和分配”？一般来说，在此过程中提供基于示例的说明将使您更容易理解您的问题。
@GordonShumway 谢谢，我会在今天晚些时候阅读case_when()，看看我能否取得进展。
@andrew_reece 感谢您提供有用的反馈，我已根据您的 cmets 更新了我的帖子，希望事情变得更加清晰。

标签： r dplyr

【解决方案1】：

更新
第一个版本相当笨拙，这是一个更干净的第二遍：

library(tidyverse)
thresh <- .002
baseline <- 1.0

仍在制作compare，但现在只有两行：每个匹配组一个，times 作为每个Matching_Group 的所有时间列表：

compare <- df %>%
  filter(Sample_Name == Matching_Group) %>% 
  group_by(Matching_Group) %>%
  summarise(times = list(Time)) 

compare
  Matching_Group times    
  <chr>          <list>   
1 QQ             <dbl [7]>
2 SS             <dbl [7]>

将df 与compare 连接起来，然后使用purrr::map() 变体获得比率、增量（从基线），然后非常方便的detect_index() 可以为我们提供低于阈值比率的第一个匹配项。（注意：这也解决了您的 cmets 提出的关于每个匹配组具有不同的 thresh 和 baseline 的问题 - 我们仍然在这里使用静态值，但操作都假设这两个变量现在是 df 中的列，理论上每行或组可能不同。）

df %>%
  mutate(thresh = thresh,
         baseline = baseline) %>%
  inner_join(compare, by = "Matching_Group") %>%
  mutate(ratios = map2(Time, times, ~ .x / .y),
         deltas = map2(baseline, ratios, ~ abs(.x - .y)),
         Assigned_idx = map2_dbl(deltas, thresh, 
                                 ~detect_index(.x, ~ .x < .y, .y))) %>%
  select(-times, -ratios, -deltas)

输出：

   Sample_Name Matching_Group  Time Assigned_idx  thresh baseline
   <chr>       <chr>          <dbl>        <dbl>   <dbl>    <dbl>
 1 A           QQ              1.00           1. 0.00200       1.
 2 A           QQ              1.10           2. 0.00200       1.
 3 A           QQ              1.20           3. 0.00200       1.
 4 A           QQ              1.40           5. 0.00200       1.
 5 A           QQ              1.60           7. 0.00200       1.
 6 B           SS              7.20           1. 0.00200       1.
 7 B           SS              7.40           3. 0.00200       1.
 8 B           SS              7.50           4. 0.00200       1.
 9 B           SS              7.60           5. 0.00200       1.
10 B           SS              7.70           6. 0.00200       1.
# ... with 15 more rows

原解决方案

这是tidyverse 解决方案。想法是将Sample_Name 转换为宽格式（即compare），然后获取每行的比率（并评估它们是否通过thresh 测试）。然后就是重新组合和清理不必要的变量。

library(stringr)
library(tidyverse)

thresh <- .002
baseline <- 1.0

首先，通过将name2 添加到data 来创建df。它只是Sample_Name 的副本，但添加了索引值：

df <- data %>%
  group_by(Sample_Name) %>%
  mutate(name2 = paste0(Sample_Name, 1:length(Sample_Name))) %>%
  ungroup() 

df
# A tibble: 25 x 5
   Sample_Name Matching_Group  Time Assigned_idx name2
   <chr>       <chr>          <dbl>        <dbl> <chr>
 1 A           QQ              1.00           NA A1   
 2 A           QQ              1.10           NA A2   
 3 A           QQ              1.20           NA A3   
 4 A           QQ              1.40           NA A4   
 5 A           QQ              1.60           NA A5   
 6 B           SS              7.20           NA B1 
 ...

现在创建compare 数据框：

compare <- df %>% 
      select(name2, Time) %>%
      spread(name2, value = Time)

compare
# A tibble: 1 x 25
     A1    A2    A3    A4    A5    B1    B2    B3    B4    B5    B6   QQ1   QQ2
* <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1    1.  1.10  1.20  1.40  1.60  7.20  7.40  7.50  7.60  7.70  7.80    1.  1.10
# ... with 12 more variables: QQ3 <dbl>, QQ4 <dbl>, QQ5 <dbl>, QQ6 <dbl>,
#   QQ7 <dbl>, SS1 <dbl>, SS2 <dbl>, SS3 <dbl>, SS4 <dbl>, SS5 <dbl>,
#   SS6 <dbl>, SS7 <dbl>

使用purrr:pmap 计算比率并与thresh 进行比较：

matched_df <- df %>%
  pmap(~ compare %>% 
         select(starts_with(..2)) %>% 
         mutate_all(funs(..3/., which(abs(baseline - ./..3 ) < thresh)[1])) %>%
         select(contains("_"))
       ) %>% 
  bind_rows(.) 

matched_df
# A tibble: 25 x 28
   `QQ1_/` `QQ2_/` `QQ3_/` `QQ4_/` `QQ5_/` `QQ6_/` `QQ7_/` `QQ1_[` `QQ2_[`
     <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <int>   <int>
 1    1.00   0.907   0.833   0.769   0.715   0.666   0.625       1      NA
 2    1.10   0.998   0.917   0.846   0.787   0.733   0.688      NA       1
 3    1.20   1.09    1.00    0.923   0.858   0.799   0.750      NA      NA
 4    1.40   1.27    1.17    1.08    1.00    0.933   0.875      NA      NA
 5    1.60   1.45    1.33    1.23    1.14    1.07    1.00       NA      NA

最后，将matched_df 绑定到df 并进行清理。
缩小到正确匹配索引的关键操作是filter(Assigned_idx == matched2)。在此之前，每个Sample_Name-to-Matching_Group 分配的所有可能比率都存在。

bind_cols(df, matched_df) %>%
  select(-name2, -Assigned_idx) %>%
  gather(Assigned_idx, value, -contains("/"), -Sample_Name, -Matching_Group, -Time) %>%
  filter(!is.na(value)) %>%
  gather(matched2, Time_Ratio, -Assigned_idx, -value, -Sample_Name, -Matching_Group, -Time) %>%
  mutate(Assigned_idx = str_replace(Assigned_idx, "_\\[", ""),
         matched2 = str_replace(matched2, "_/", "")) %>%
  filter(Assigned_idx == matched2) %>%
  arrange(Sample_Name) %>%
  select(-value, -matched2) %>%
  mutate(Assigned_idx = str_sub(Assigned_idx, -1),
         Time_Ratio = round(Time_Ratio, 4))

       Sample_Name Matching_Group  Time Assigned_idx Time_Ratio
1            A             QQ 1.000            1     1.0000
2            A             QQ 1.100            2     0.9982
3            A             QQ 1.200            3     1.0000
4            A             QQ 1.400            5     1.0014
5            A             QQ 1.600            7     1.0000
6            B             SS 7.203            1     1.0004
7            B             SS 7.395            3     0.9993
8            B             SS 7.500            4     1.0000
...

不是我最漂亮的解决方案...对于所有的 tidyverse 向导，很高兴从任何建议中学习。

数据：

data <- structure(list(Sample_Name = c("A", "A", "A", "A", "A", "B", "B", "B", 
"B", "B", "B", "QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "SS", 
"SS", "SS", "SS", "SS", "SS", "SS"), Matching_Group = c("QQ", 
"QQ", "QQ", "QQ", "QQ", "SS", "SS", "SS", "SS", "SS", "SS", "QQ", 
"QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "SS", "SS", "SS", "SS", "SS", 
"SS", "SS"), Time = c(1, 1.1, 1.2, 1.4, 1.6, 7.203, 7.395, 
7.5, 7.6, 7.7, 7.802, 1, 1.102, 1.2, 1.3, 1.398, 1.501, 1.6, 
7.2, 7.3, 7.4, 7.5, 7.6, 7.7, 7.8), Assigned_idx = c(NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, 2, 3, 4, 5, 6, 7, 1, 2, 
3, 4, 5, 6, 7)), row.names = c(NA, -25L), class = c("tbl_df", 
"tbl", "data.frame"))

【讨论】：

嘿，安德鲁，我能够使用我的真实数据进行上述操作！只是想问一个后续问题，请让我知道是否最好完全创建一个新帖子，因为这将涉及修改我将提供的原始数据框。我试图玩弄它，但是您对如何合并每个Matching_Group 特有的thresh 和baseline 值有什么建议吗？这看起来像原来的 data，但有两个额外的列 thresh 和 baseline 我已经在其中添加了 left_join（每一行都将被填充）。
还有后续问题 #2，对于两个 gather 步骤，我有 10-12 个无关的元数据列要保留。为了保留这些，我必须将它们全部输入gather(..., -metadata1, -metadata2, etc.)。关于如何在不明确引用每一列的情况下执行此操作的任何建议？感谢您的支持！
嗨，比尔，请参阅更新的解决方案。在这种情况下，新版本消除了您关于 gather 的第二个问题，但一般来说，您可以只添加您确实想要收集的变量，而不是列出所有您不想收集的变量。有关示例，请参阅gather docs。
安德鲁，感谢您的帮助。我介绍了一些东西来适应我的真实数据更复杂的性质，现在我的一切都运行良好且快速。干杯，

【解决方案2】：

这样的事情应该可以工作：

#!/usr/bin/R

a = structure(list(Sample_Name = c("A", "A", "A", "A", "A", "B", "B", "B", 
"B", "B", "B", "QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "SS", 
"SS", "SS", "SS", "SS", "SS", "SS"), Matching_Group = c("QQ", 
"QQ", "QQ", "QQ", "QQ", "SS", "SS", "SS", "SS", "SS", "SS", "QQ", 
"QQ", "QQ", "QQ", "QQ", "QQ", "QQ", "SS", "SS", "SS", "SS", "SS", 
"SS", "SS"), Time = c(1, 1.1, 1.2, 1.4, 1.6, 7.203, 7.395, 
7.5, 7.6, 7.7, 7.802, 1, 1.102, 1.2, 1.3, 1.398, 1.501, 1.6, 
7.2, 7.3, 7.4, 7.5, 7.6, 7.7, 7.8), Assigned_idx = c(NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, 2, 3, 4, 5, 6, 7, 1, 2, 
3, 4, 5, 6, 7)), row.names = c(NA, -25L), class = c("tbl_df", 
"tbl", "data.frame"));

tol = 0.002;

a$Time_Ratio <- NA;

for (i in 1:nrow(a)) {
  s_name <- a[i, "Sample_Name"];
  mg     <- a[i, "Matching_Group"];
  s_time <- a[i, "Time"];

  for (j in 1:nrow(a)) {
    mg_name <- a[j, "Sample_Name"];
    if (mg_name == mg) {
      mg_time <- a[j, "Time"];
      time_ratio = s_time/mg_time;
      if (abs(time_ratio - 1.0) < tol) {
        a[i, "Assigned_idx"] <- a[j, "Assigned_idx"];
        a[i, "Time_Ratio"] <- time_ratio;
        break;
      }
    }
  }
}

print(a);

【讨论】：

感谢大卫的回答，样本数据集和我的真实数据都按预期工作！