R中的对称对

Question

我有一个大数据框，如下所示：

> my_table
   track_fid start_gid end_gid
1          1       100      82
2          2        82     100
3          3       100      82
4          4       100      32
5          5        82     100
6          6        82     100
7          7        82     100
8          8       100      82
9          9        34     100
10        10        31     100

我的目标是在末尾添加列 to_from 并用字符 y 或 n 填充它。

我们以第一行为例——start_gid 中的值 = 100，end_gid 中的值 = 82。如果表中的任何其他行存在值相反的位置，即end_gid = 100 和start_gid = 82 中的值，我想用y 填充两行的to_from 列。如果逆不存在，则第一行应用 n 填充。这里的关键是遍历每一行并按照track_fid的顺序在表中搜索它的逆。如果在track_fid 更大的位置找到逆，则应插入y。一旦一个逆接收到一个值y，它就不能再次使用。

例如，这将是一个示例输出：

> output
   track_fid start_gid end_gid to_from
1          1       100      82       y
2          2        82     100       y
3          3       100      82       y
4          4       100      32       n
5          5        82     100       y
6          6        82     100       y
7          7        82     100       n
8          8       100      82       y
9          9        34     100       n
10        10        31     100       n

有没有办法在 R 中创建这样的输出？

类似的东西：

for(i in 2:nrow(my_table)) {
if(my_table[i-1,"start_gid"]= my_table[i,"end_gid"]) {
my_table$to_from = "y" } else { my_table$to_from = "n"}


> str(output)
'data.frame':   10 obs. of  4 variables:
 $ track_fid: int  1 2 3 4 5 6 7 8 9 10
 $ start_gid: int  100 82 100 100 82 82 82 100 34 31
 $ end_gid  : int  82 100 82 32 100 100 100 82 100 100
 $ to_from  : Factor w/ 2 levels "n","y": 2 2 2 1 2 2 1 2 1 1

Answer 1

如果没有 R 中的循环，我没有办法做到这一点。您可以使用 for 循环和 next 和 break 语句来做到这一点。但在这种情况下，如果问题规模很大，我会求助于 Rcpp。

library(Rcpp)
sourceCpp(code = "
          #include <Rcpp.h>
          // [[Rcpp::export]]
          Rcpp::LogicalVector myfun(const Rcpp::IntegerVector x, const Rcpp::IntegerVector y) {
            Rcpp::LogicalVector res(x.length());
            for (int i=0; i<(x.length()-1); i++) {
              if(res(i)) continue;
              for (int j=i+1; j<x.length(); j++) {
                if (res(j)) continue;
                if (x(i) == y(j) && x(j) == y(i)) {
                   res(i) = true;
                   res(j) = true;
                   break;
                }
              }
            }
            return res;
          }
          ")

DF$from_to <- myfun(DF$start_gid, DF$end_gid)
#   track_fid start_gid end_gid from_to
#1          1       100      82    TRUE
#2          2        82     100    TRUE
#3          3       100      82    TRUE
#4          4       100      32   FALSE
#5          5        82     100    TRUE
#6          6        82     100    TRUE
#7          7        82     100   FALSE
#8          8       100      82    TRUE
#9          9        34     100   FALSE
#10        10        31     100   FALSE

Answer 2

感谢算法的详细描述，我们还可以使用data.table 构造一个不带循环的不同解决方案。

首先，我们统计start_gid和end_gid的唯一组合：

pairs <- dt[, .N, by = .(start_gid, end_gid)]
pairs

#   start_gid end_gid N
#1:       100      82 3
#2:        82     100 4
#3:       100      32 1
#4:        34     100 1
#5:        31     100 1

很明显，(100, 82) 和 (82, 100) 的前 3 次出现将具有反向伙伴，而 (82, 100) 的第 4 次出现则没有。此外，(100, 32)、(34, 100) 和 (31, 100) 的出现没有反向伙伴。

我们现在确定每个组中可能配对的最大数量nmatch。 (100, 82) 和 (82, 100) 的所有出现都属于同一组 82_100。如果组中只有一个成员，则没有其他配对伙伴，因此nmatch 为 0。

pairs <- pairs[, .(start_gid, end_gid, nmatch = if (.N <= 1L) 0L else min(N)), 
      by = .(grp = paste(pmin(start_gid, end_gid), pmax(start_gid, end_gid), sep = "_"))]
pairs

#      grp start_gid end_gid nmatch
#1: 82_100       100      82      3
#2: 82_100        82     100      3
#3: 32_100       100      32      0
#4: 34_100        34     100      0
#5: 31_100        31     100      0

我们现在连接两个表。这是一个右连接，因此dt 的所有行都会出现在输出中：

out <- pairs[dt, on = .(start_gid, end_gid)]
out
#       grp start_gid end_gid nmatch track_fid
# 1: 82_100       100      82      3         1
# 2: 82_100        82     100      3         2
# 3: 82_100       100      82      3         3
# 4: 32_100       100      32      0         4
# 5: 82_100        82     100      3         5
# 6: 82_100        82     100      3         6
# 7: 82_100        82     100      3         7
# 8: 82_100       100      82      3         8
# 9: 34_100        34     100      0         9
#10: 31_100        31     100      0        10

在最后一步，标记每组中的第一个nmatch配对，结果按track_fid排序

out <- out[, .(track_fid, to_from = seq_len(.N) <= nmatch), by = .(start_gid, end_gid)]
out[order(track_fid)]
     start_gid end_gid track_fid to_from
# 1:       100      82         1    TRUE
# 2:        82     100         2    TRUE
# 3:       100      82         3    TRUE
# 4:       100      32         4   FALSE
# 5:        82     100         5    TRUE
# 6:        82     100         6    TRUE
# 7:        82     100         7   FALSE
# 8:       100      82         8    TRUE
# 9:        34     100         9   FALSE
#10:        31     100        10   FALSE

基准 1：原始数据（10 行）

使用只有 10 行的原始数据集比较 data.table 解决方案与 Rolands 的 Rcpp 解决方案：

代码

library(microbenchmark)
microbenchmark(
  dt = {
    dt[, .N, by = .(start_gid, end_gid)][
      , .(start_gid, end_gid, nmatch = if (.N <= 1L) 0L else min(N)), 
      by = .(grp = paste(pmin(start_gid, end_gid), pmax(start_gid, end_gid), sep = "_"))][
        dt, on = .(start_gid, end_gid)][
          , .(track_fid, to_from = seq_len(.N) <= nmatch), 
          by = .(start_gid, end_gid)][
            order(track_fid)]
  },
  rcpp_source = {
    sourceCpp(code = "
          #include <Rcpp.h>
          // [[Rcpp::export]]
          Rcpp::LogicalVector myfun(const Rcpp::IntegerVector x, const Rcpp::IntegerVector y) {
            Rcpp::LogicalVector res(x.length());
            for (int i=0; i<(x.length()-1); i++) {
              if(res(i)) continue;
              for (int j=i+1; j<x.length(); j++) {
                if (res(j)) continue;
                if (x(i) == y(j) && x(j) == y(i)) {
                   res(i) = true;
                   res(j) = true;
                   break;
                }
              }
            }
            return res;
          }
          ")
    dt$from_to <- myfun(dt$start_gid, dt$end_gid)
    dt
  },
  rcpp_func = {
    dt$from_to <- myfun(dt$start_gid, dt$end_gid)
    dt
  }
)

结果

Unit: microseconds
        expr      min       lq      mean    median       uq       max neval
          dt 2873.017 3233.418 3466.5484 3408.0495 3558.705  6345.633   100
 rcpp_source 8112.335 8537.114 8932.8953 8811.2385 9173.150 12093.931   100
   rcpp_func  101.192  121.582  142.0769  137.4405  154.620   255.246   100

正如预期的那样，仅 Rcpp 函数就比 data.table 解决方案快 20 倍以上（对于给定的玩具尺寸样本数据）。但是，如果包含对 sourceCPP 的调用，则它需要的时间是 data.table 解决方案的两倍以上。

请注意，data.tablecode 已被 chaining data.table 查询压缩。

基准 2：更大的数据集

正如@Roland 所建议的，我在更大的数据集上比较了data.table 解决方案和Rcpp：

对于少于 1000 行的数据帧，Rcpp 比 data.table 解决方案更快。对于较大的数据帧，data.table 解决方案的扩展性比Rcpp 解决方案好得多。请注意，这是已实现算法的一个特征，通常不得归于Rcpp。