问题：

为多组列动态创建行手段的替代（更快）方法

蓟和煦

2023-03-14

我正在尝试自动计算多组列的每行平均分数。例如，一组列可以代表不同规模的项目。这些列也被系统地命名为（scale_itemnumber）。

例如，下面的虚拟数据框包含三种不同比例的项目。(可能发生的情况是，没有包括每个等级的所有项目，此处表示为缺失的VAR_3)。

#library(tidyverse)
set.seed(123)
df <- tibble(  G_1 =  sample(1:5, size = 10000, replace = TRUE),
               G_2 =  sample(1:5, size = 10000, replace = TRUE),
               G_3 =  sample(1:5, size = 10000, replace = TRUE),
             MOT_1 =  sample(1:5, size = 10000, replace = TRUE),
             MOT_2 =  sample(1:5, size = 10000, replace = TRUE),
             MOT_3 =  sample(1:5, size = 10000, replace = TRUE),
             VAR_1 =  sample(1:5, size = 10000, replace = TRUE),
             VAR_2 =  sample(1:5, size = 10000, replace = TRUE),
             VAR_4 =  sample(1:5, size = 10000, replace = TRUE))

我试图做的是为每个构造（具有动态名称，如mean_G，mean_MOT，mean_VAR）创建一个额外的列，该列表示其各自列集的行平均值。

# A tibble: 6 x 12
    G_1   G_2   G_3 MOT_1 MOT_2 MOT_3 VAR_1 VAR_2 VAR_4 mean_G mean_MOT mean_VAR
  <int> <int> <int> <int> <int> <int> <int> <int> <int>  <dbl>    <dbl>    <dbl>
1     3     3     1     1     1     1     1     5     4   2.33     1        3.33
2     3     5     3     3     2     1     4     3     5   3.67     2        4   
3     2     5     4     5     3     2     4     1     1   3.67     3.33     2   
4     2     5     4     4     4     1     2     5     4   3.67     3        3.67
5     3     4     2     1     4     5     2     2     3   3        3.33     2.33
6     5     3     4     4     3     4     1     1     4   4        3.67     2

实际上，我有一个使用rowwise（）和c_across（）与purrr结合使用的工作方法，但与手动操作（突变rowMeans组合）相比，它的执行速度非常慢。但是，真正的df具有更多的比例和更多的项目，因此我宁愿不必对每个平均列进行硬编码并插入每个项目（特别是因为所包含的确切选择也可能因数据帧而异）。

#functional but slow approach

#get list of variable prefixes
var_names <- str_extract(names(df), "^.*(?=(_))") %>% 
  unique()

#use map and c_across to calculate the means rowwise per variable group

df_functional <-
      df %>% 
      bind_cols(
        map_dfc(.x = var_names, 
                .f = ~ .y %>% 
                  rowwise() %>% 
                  transmute(!!str_c("mean_", .x) := mean(c_across(starts_with(.x)))),
                .y = .))



#manual approach
df_manual <- df %>% mutate(mean_G   = rowMeans(select(., G_1,   G_2,   G_3)),
                             mean_MOT = rowMeans(select(., MOT_1,   MOT_2,   MOT_3)),
                             mean_VAR = rowMeans(select(., VAR_1,   VAR_2,   VAR_4)))

结果是相同的，但动态/功能方法明显较慢！不确定对于具有更多列/组的dfs来说，这会是什么样子。如何在保持动态方法的灵活性的同时加快速度？

> identical(df_manual, df_functional)
[1] TRUE

#Benchmark (using the microbenchmark package)
benchmark
Unit: milliseconds
       expr        min         lq        mean     median         uq        max neval
 functional 37198.3569 38592.6855 48313.00156 52936.3254 55349.0561 59831.0141   100
     manual    16.0662    18.0139    27.53403    19.9085    22.9384   138.5401   100

共有3个答案

赵星华

2023-03-14

这里还有两种使用purrr::map_dfc和dplyover::的方法，两者在速度方面都相同，比duce方法快一点，但比@Baraliuhs回答的split_mutate方法慢得多。

library(dplyr)
library(purrr)
library(dplyover) # https://github.com/TimTeaFan/dplyover
library(stringr)

# purrr's `map_dfc()` inside mutate
f_map_dfc <- function(df) {

    var_names <- str_extract(names(df), "^.*(?=(_))") %>% 
    unique()

    df %>% 
      mutate(map_dfc(set_names(var_names, paste0("mean_", var_names)),
                     ~ rowMeans(across(starts_with(.x)), na.rm = TRUE)
                     )
             )
}

# dplyover's `over()` (disclaimer: I'm the maintainer)
f_over <- function(df) {
  
  df %>% 
    mutate(over(cut_names("_[0-9]"),
                ~ rowMeans(across(starts_with(.x)), na.rm = TRUE),
                .names = "mean_{x}"
    )
    )
}

# Baraliuhs answer
split_mutate <- function(df){
  row_means <- split.default(df, stringr::str_remove(names(df), '_[0-9]')) %>% 
    map(rowMeans)
  df %>% 
    mutate(
      !!!row_means
    ) %>% 
    rename_with(~paste0('mean_', .), .cols = !matches('_'))
}

# Stefans functional approach
functional <- function(df) {
  
  var_names <- str_extract(names(df), "^.*(?=(_))") %>% 
    unique()
  
  df %>%
    Reduce(function(x, y) {
      mutate(x, "mean_{y}" := rowMeans(across(starts_with(y)), na.rm = TRUE))
    }, var_names, init = .)
}

# Stefans manual dplyr approach
manual <- function(df) {
  df %>% mutate(
    mean_G = rowMeans(select(., G_1, G_2, G_3)),
    mean_MOT = rowMeans(select(., MOT_1, MOT_2, MOT_3)),
    mean_VAR = rowMeans(select(., VAR_1, VAR_2, VAR_4))
  )
}

# benchmark using the {bench} package:
bench::mark(map_dfc = f_map_dfc(df),
                               over = f_over(df),
                               reduce = functional(df),
                               dplyr_manual = manual(df),
                               split_mutate = split_mutate(df))

#> # A tibble: 5 × 6
#>   expression        min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>   <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 map_dfc       12.68ms  13.54ms      72.5    3.14MB     9.07
#> 2 over          12.28ms  13.06ms      75.2  818.39KB     6.64
#> 3 reduce        16.27ms  17.27ms      57.4   719.1KB    12.5 
#> 4 dplyr_manual  32.99ms  34.91ms      28.2  951.76KB     7.69
#> 5 split_mutate   6.04ms   6.42ms     151.   758.86KB     8.73

^{由reprex软件包（v0.3.0）于2022年7月1日创建。}

子车海

2023-03-14

下面是使用基本还原的方法。不如手动方法快，但几乎：

functional <- function(df) {
  df %>%
    Reduce(function(x, y) {
      mutate(x, "mean_{y}" := rowMeans(across(starts_with(y)), na.rm = TRUE))
    }, var_names, init = .)
}

manual <- function(df) {
  df %>% mutate(
    mean_G = rowMeans(select(., G_1, G_2, G_3)),
    mean_MOT = rowMeans(select(., MOT_1, MOT_2, MOT_3)),
    mean_VAR = rowMeans(select(., VAR_1, VAR_2, VAR_4))
  )
}


microbenchmark::microbenchmark(functional(df), manual(df))
#> Unit: milliseconds
#>            expr      min       lq     mean   median       uq      max neval cld
#>  functional(df) 7.582979 7.891255 8.702247 7.994792 8.440233 20.11192   100   a
#>      manual(df) 7.362384 7.816135 8.312074 7.988434 8.433740 11.55050   100   a

益兴生

2023-03-14

这应该更快：

library(dplyr, warn.conflicts = FALSE)
library(purrr)
df <- tibble(  G_1 =  sample(1:5, size = 10000, replace = TRUE),
               G_2 =  sample(1:5, size = 10000, replace = TRUE),
               G_3 =  sample(1:5, size = 10000, replace = TRUE),
               MOT_1 =  sample(1:5, size = 10000, replace = TRUE),
               MOT_2 =  sample(1:5, size = 10000, replace = TRUE),
               MOT_3 =  sample(1:5, size = 10000, replace = TRUE),
               VAR_1 =  sample(1:5, size = 10000, replace = TRUE),
               VAR_2 =  sample(1:5, size = 10000, replace = TRUE),
               VAR_4 =  sample(1:5, size = 10000, replace = TRUE))
f <- function(df){
    row_means <- split.default(df, stringr::str_remove(names(df), '_[0-9]')) %>% 
        map(rowMeans) %>% 
        setNames(paste0("mean_", names(.)))
    df %>% 
        mutate(
            !!!row_means
        )
}
    manual <- function(df) {
        df %>% mutate(
            mean_G = rowMeans(select(., G_1, G_2, G_3)),
            mean_MOT = rowMeans(select(., MOT_1, MOT_2, MOT_3)),
            mean_VAR = rowMeans(select(., VAR_1, VAR_2, VAR_4))
        )
    }
    microbenchmark::microbenchmark(prog = f(df), man = manual(df))
#> Unit: milliseconds
#>  expr    min      lq     mean   median       uq     max neval cld
#>  prog 2.6982 2.91245  3.30497  3.09260  3.30435  7.5209   100  a 
#>   man 9.1948 9.85690 10.79482 10.13105 10.81000 19.4007   100   b

^{创建于 2022-07-01 由 reprex 软件包（v2.0.1）}

类似资料：

更快的替代方案

问题内容：我知道这个话题已经解决了上千次。但是我找不到解决办法。我正在尝试计算列表（df2.list2）的列中出现列表（df1.list1的每一行）的频率。所有列表仅包含唯一值。List1包含约300.000行，list2包含30.000行。我有一个有效的代码，但是它的运行速度非常慢（因为我使用的是迭代程序）。我也尝试过itertuples（），但它给了我一个错误（“要解压缩的值太多（预期2
DecimalFormat.format（）的更快替代方法？

问题内容：为了提高其性能，我一直在使用VisualVM采样器对我的一个应用程序进行性能分析，最小采样周期为20ms。根据探查器，主线程在该方法中花费了将近四分之一的CPU时间。我正在与该模式一起使用，以将数字“转换” 为正好有六个十进制数字的字符串表示形式。我知道这种方法相对昂贵并且被多次调用，但是我对这些结果感到有些惊讶。这种采样分析器的结果在多大程度上准确？我将如何验证它们-最好不借
Powershell创建数组正确、更快的方法

本文向大家介绍Powershell创建数组正确、更快的方法，包括了Powershell创建数组正确、更快的方法的使用技巧和注意事项，需要的朋友参考一下通常当新的对象添加到一个数组中，根据经验你最担心其性能问题。下面第一个例子将告诉你一个错误的操作方法：在这个循环中，这个数组通过符号“+=”增加了许多新的对象。这样做会需要很长时间，因为在你改变其大小时Powershell每次需要去创造一个新的数
更快的替代方法来替换Java String中的方法？

问题内容： replace方法返回一个字符串对象而不是替换给定字符串的内容这一事实有点让人费解（但是，当您知道字符串在Java中是不可变的时，这是可以理解的）。通过在某些代码中使用深度嵌套的替换，我的性能受到了重大影响。有什么我可以替换的东西可以使它更快吗？问题答案：这就是StringBuilder的目的。如果要进行很多操作，请在上进行操作，然后在需要时将其转换为。因此描述： “可变的字符序
手动导入类的替代方法？

我正在尝试为一个简单的android应用程序编写代码，我想知道是否有其他方法可以手动导入每个类，或者为什么它会显示为红色，因为每当我以类似的方式编写东西时，它都不会运行。android studio屏幕截图
Javascript动态创建表格及删除行列的方法

本文向大家介绍Javascript动态创建表格及删除行列的方法，包括了Javascript动态创建表格及删除行列的方法的使用技巧和注意事项，需要的朋友参考一下本文实例讲述了Javascript动态创建表格及删除行列的方法。分享给大家供大家参考。具体实现方法如下：希望本文所述对大家的javascript程序设计有所帮助。

为多组列动态创建行手段的替代（更快）方法

共有3个答案

相关问答

相关文章

相关阅读

相关工具

相关文档