时间戳

首页 > 解决方案 > 交织数据框行的整洁功能方式

r - 交织数据框行的整洁功能方式

问题描述

我已经编写了下面的代码来获取两个数据帧并根据此示例将它们逐行交织。我相信这是使用 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)

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

标签： rdplyrfunctional-programmingpurrr

解决方案

我认为您的函数的问题在于它一次向数据框插入一行。最好创建交错索引，调用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

推荐阅读