交织数据框行的整洁功能方式答案

【问题标题】：tidy functional way of interweaving rows of a data frame交织数据框行的整洁功能方式
【发布时间】：2020-11-20 15:56:44
【问题描述】：

我已经编写了下面的代码来获取两个数据帧并根据this 示例将它们逐行交织。我相信这是使用 Bresenham 的线算法，该算法将较短的数据帧均匀地分散在较长的数据帧中。

interleave_rows <- function(x, y) {
  m <- nrow(x)
  
  yi <- 1
  len <- m + nrow(y)
  err <- len %/% 2
  res <- x
  
  for (i in 1:len) {
    err <- err - m
    if (err < 0) { err <- err + len } else {
      res <- add_row(res, !!! slice(y, yi), .before = i)
      yi <- yi + 1
    }
  }
  res
}

l <- list(
  a = tibble(n = 1:3, l = letters[1:3]),
  b = tibble(n = 4:9, l = letters[4:9]),
  c = tibble(n = 10:11, l = letters[10:11])
)

reduce(l, interleave_rows)

我在一个闪亮的应用程序中使用它作为减少的一部分，它有点慢。我也不认为这是解决这个问题的一种非常整洁或实用的方法。如果没有循环和重新分配变量，我无法理解如何做到这一点，但我怀疑这样做会更快。有更好的方法吗？

【问题讨论】：

标签： r dplyr functional-programming purrr

【解决方案1】：

我认为您的函数的问题在于它一次向数据框插入一行。最好创建交错索引，调用一次rbind，然后按索引进行子集化。

此函数通过有效地计算每个数据帧内的行号的分位数，然后找到分位数的顺序来工作：

interleave_rows <- function(df_a, df_b)
{
  if(nrow(df_b) > nrow(df_a)) return(interleave_rows(df_b, df_a))
  a <- seq(nrow(df_a))
  b <- seq(nrow(df_b))
  
  rbind(df_a, df_b)[order(c(a, length(a) * b/(length(b) + 1))), ]
}

您可以清楚地看到这两个数据框是如何工作的：

df_a <- data.frame(came_from = rep("A", 10), value = 1:10)
df_b <- data.frame(came_from = rep("B", 4),  value = 101:104)

interleave_rows(df_a, df_b)
#>    came_from value
#> 1          A     1
#> 2          A     2
#> 11         B   101
#> 3          A     3
#> 4          A     4
#> 12         B   102
#> 5          A     5
#> 6          A     6
#> 13         B   103
#> 7          A     7
#> 8          A     8
#> 14         B   104
#> 9          A     9
#> 10         A    10

根据您自己的数据，您将获得：

l <- list(
  a = tibble(n = 1:3, l = letters[1:3]),
  b = tibble(n = 4:9, l = letters[4:9]),
  c = tibble(n = 10:11, l = letters[10:11])
)

reduce(l, interleave_rows)
#> # A tibble: 11 x 2
#>        n l    
#>    <int> <chr>
#>  1     4 d    
#>  2     1 a    
#>  3     5 e    
#>  4    10 j    
#>  5     6 f    
#>  6     2 b    
#>  7     7 g    
#>  8    11 k    
#>  9     3 c    
#> 10     8 h    
#> 11     9 i

在时间方面，即使在小数据帧上，这也比原来的速度快 10 倍以上。我怀疑这种差异在更大的数据帧上会更加明显：

microbenchmark::microbenchmark(reduce(l, interleave_rows), 
                               reduce(l, interleave_rows_OP))
#> Unit: milliseconds
#>                           expr     min       lq      mean   median       uq     max
#>     reduce(l, interleave_rows)  2.6741  2.94680  3.610404  3.05115  3.22800 21.5097
#>  reduce(l, interleave_rows_OP) 36.2170 37.82645 40.005754 38.90145 40.03415 57.3965
#>  neval
#>    100
#>    100

【讨论】：

【解决方案2】：

根据 Allan Cameron 的出色回答，我能够完全按照自己的意愿行事。我添加这个答案只是为了参考如何使用 tidy 来做到这一点。

interleave_rows_tidy <- function(df_a, df_b) {
  if(nrow(df_b) > nrow(df_a)) return(interleave_rows_tidy(df_b, df_a))
  a <- df_a %>% nrow %>% seq
  b <- df_b %>% nrow %>% seq
  
  bind_rows(df_a, df_b) %>% arrange(c(a, length(a) * b/(length(b) + 1)))
}

对我来说，关键特征是如何计算序列。如果有人想知道这里是微基准。

> microbenchmark::microbenchmark(reduce(l, interleave_rows_tidy), reduce(l, interleave_rows_SO))
Unit: microseconds
                            expr     min        lq     mean    median       uq      max neval
 reduce(l, interleave_rows_tidy) 852.904 1088.5170 2586.924 1742.8185 4013.212 7401.947   100
   reduce(l, interleave_rows_SO) 504.500  636.9975 1251.016  769.7465 1357.512 4738.728   100

在这个测试数据上，tidy 版本看起来有点慢。这两者都比我原来的逐一添加行的循环快得多。

【讨论】：