带有条件、迭代计算和公差匹配的复杂ID分配
我正在尝试编写一个非常复杂的迭代匹配函数，但是我淹没在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比(Time)。每个Matching_Group都将有一个指定的唯一Time_Ratio值，该值的计算需要等于+/-一些公差。如果计算的比率与特定于组的预定义比率匹配，我希望从属于Matching_Group观测的行中提取和分配 Assigned_idx，并将其分配给观察。如果不是，使用相同的观察到的Time和下一行Time重复计算。重复，直到每个观察在Assigned_idx中都有一个值。
示例:在此数据集中的，对于两个Matching_Group，Time_Ratio都应该等于1.000 +/- 0.0020。在我的真实数据集中，在一个单独的表中，每个Matching_Group都会有唯一的Matching_Group值。因此，对于Time = 1.200的第3行，Matching_Group是QQ。当我们计算第一个QQ观测时间的比值时，1.200/1.000 = 1.200超出了我们定义的容差->下一个QQ观测时间。1.200/1.102 = 1.089...again超出了我们的容忍范围。最后，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和函数中。我的尝试包括将%>%与比率计算、data.table::shift等进行组合，但我似乎无法让它与我的条件参数一起工作。此外，如果这是相关的，在我的真实数据将有~50个“名称”和~25个匹配组。我将有第二个数据源，列出匹配的组名和相应的比率，但是在这个示例中没有包括这样的细节。
我真的很困惑，任何想法都很感激。
回答 2
Stack Overflow用户
发布于 2018-07-20 06:02:14
更新
第一个版本相当笨重，这里有一个更干净的第二关：
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()可以给出亚阈值比的第一次匹配。(注意:这也解决了您对每个匹配组都有不同的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首先，通过向df添加name2来创建data。它只是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-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
...不是我最漂亮的solution...for所有的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"))Stack Overflow用户
发布于 2018-07-19 21:33:27
像这样的事情应该有效：
#!/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);https://stackoverflow.com/questions/51413775
复制相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号