是否有可能做你自己的有效的描述性统计功能？ -R答案

【问题标题】：Is it possible to do your own efficient descriptive statistics function? - R是否有可能做你自己的有效的描述性统计功能？ -R
【发布时间】：2019-11-11 20:27:25
【问题描述】：

通常，我发现自己使用一些汇总函数或进行自己的计算以从数据中获取一些额外的初始信息。例如，我想查看给定不同值限制的每个变量的计数和百分比：

table_transposed <- function(vector){

    merge(as.data.frame(table(vector, dnn="values")),
          as.data.frame(round(prop.table(table(vector, dnn="values")),2)), 
          by="values", 
          all.x=TRUE) %>% 
    data.table::transpose(keep.names = "values",
                          make.names = names(.)[1]) %T>%
    {.[,c("values")] <- c("Count", "Percentage")}
    }
table_transposed_filter <- function(dataframe, max_number_categories) {
    (lapply(dataframe, function(x) NROW(unique(x))) <= max_number_categories) %>% 
            as.vector() %>% 
            {dataframe[,.]} %>% 
            lapply(table_transposed)
            }

所以，你给每个变量的数据框和不同值的阈值。

table_transposed_filter(mtcars, 10)

但是，它非常慢（可能是因为使用 merge() 而不是 dplyr 中的 left_join()）。现在，我正在尝试寻找一种高效、快速且简单的方法来组合psych::describe()、Hmisc::describe()、其他和我自己的数字和分类变量（每个变量一个描述函数）。类似的东西（对于数字）：

|变量 |数据类型 |意思|模式 |方差 |偏斜 |百分位数 25 | ...

如果我主要使用sapply() 创建此表，是否比实际学习创建 r-package 并在其中进行开发更好（更高效、更快、更简单的代码）？

PS：我想把这个问题放在 StackMetaExchange 或 Crossvalidation 中，但似乎没有一个适合它。

【问题讨论】：

如果您担心速度，请花一些时间profiling your code 看看实际需要很长时间。在这里提出问题时，您应该包括使问题清晰的数据。到底有多慢对你来说太慢了？包括必须满足的特定基准。
回复：您的 PS - 是的，Stack Overflow 是问题的正确位置，您只需要解决 MrFlick 的观点。问题是关于编程的，让它在这里成为主题。 Meta Stack Overflow 用于解答有关使用 Stack Overflow 的问题。交叉验证适用于统计问题。
确实会出现一些效率低下的问题：(a) table_transpose 使用 table(vector, dnn = "values") 两次 - 这样做会更有效，将其保存为变量，然后使用两次。我也认为根本不需要merge - table 和prop.table 的顺序相同。我很困惑 NROW(unique(x))) <= max_number_categories) 被输入... table_transposed 已经返回一个具有唯一类别数量维度的结果，再次计算效率低下。
啊 - 我错过了一组括号，现在我看到 NROW(unique()) 是预过滤的，这很好。

标签： r

【解决方案1】：

这是一个更快的版本。在小数据（如mtcars）上速度大约快 2 倍，但在大数据上 litte bit 差异会缩小。

这是有道理的，因为您执行的最昂贵的操作是 table - 您的版本执行两次，我的版本执行一次。我没有分析代码，但我的猜测是 table 是任何大型数据的一个数量级以上的瓶颈，因此尝试优化代码的任何其他部分是一种浪费。

t_transp = function(x, digits = 2) {
  tab = table(x)
  prop_tab = prop.table(tab)
  df = data.frame(values = c("Count", "Percentage"))
  df = cbind(df, rbind(tab, round(prop_tab, digits = digits)))
  row.names(df) = NULL
  df
}

t_transp_filter = function(data, n_max, ...) {
  lapply(Filter(function(x) NROW(unique(x)) <= n_max, data), t_transp, ...)
}

基准测试：

microbenchmark::microbenchmark(
  gregor = t_transp_filter(mtcars, n_max = 4),
  OP = table_transposed_filter(mtcars, 4),
  times = 20
)
# Unit: milliseconds
#    expr    min     lq     mean  median      uq    max neval cld
#  gregor 1.6483 1.7093 2.253425 1.74765 1.84680 7.5394    20  a 
#      OP 5.6988 5.7627 6.316295 6.08545 6.57965 8.1048    20   b

set.seed(47)
df = as.data.frame(matrix(
  c(sample(letters[1:5], size = 1e5 * 20, replace = T))
  , ncol = 20))

microbenchmark::microbenchmark(
  gregor = t_transp_filter(df, n_max = 5),
  OP = table_transposed_filter(df, 5),
  times = 20
)
# Unit: milliseconds
#    expr      min        lq     mean    median       uq      max neval cld
#  gregor  59.5466  59.95545  63.6825  61.14075  67.2167  75.4270    20  a 
#      OP 110.3265 117.35585 123.8782 118.91005 133.7795 149.0651    20   b

【讨论】：