是否有可能实现您自己的高效描述性统计功能R

通常，我会使用一些摘要函数或自己进行计算，从数据中获得一些额外的初始信息。例如，我希望看到给定不同值限制的每个变量的计数和百分比：

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)
            }

但是，它的速度非常慢（可能是因为使用了

merge（）

而不是

left\u join（）

from

dplyr

）。现在，我正试图找到一种高效、快速、简单的方法，将数值变量和分类变量（每个变量有一个描述性函数）组合起来使用

psych:：Descripte（）

、

Hmisc:：Descripte（）

、其他变量和我自己的变量。例如（对于数字）：

|变量|数据类型|平均|模式|方差|偏斜|百分位25 |

例如，如果我主要使用

sapply（）

创建此表，它是否比实际学习创建r包并在其中开发更好（更高效、更快、更简单的代码）

---

PS：我本想把这个问题放在StackMetaExchange或交叉验证中，但它们似乎都不符合要求。

这里有一个更快的版本。在小数据（如

mtcars

）上，速度大约快2倍，但在大数据上，差异在小位上缩小

这是有道理的，因为您执行的最昂贵的操作是

表

——您的版本执行两次，我的版本执行一次。我没有分析代码，但我的猜测是

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, ...)
}

---

如果你担心速度，花点时间看看到底是什么花了很长时间。当在这里提问时，你应该包括清楚问题的数据。到底有多慢对你来说太慢了？包括必须满足的特定基准。re：你的PS-是的，堆栈溢出是问题的正确位置，你只需要解决MrFlick的要点。这个问题是关于编程的，让它在这里直面主题。元堆栈溢出用于回答有关使用堆栈溢出的问题。交叉验证用于统计问题。确实会出现一些低效现象：（A）

table\u transpose

使用

table（vector，dnn=“values”）

两次-将其保存为变量并使用两次会更有效。我也认为根本不需要

merge

-

table

和

prop.table

的顺序是一样的。我被

NROW（unique（x）））搞糊涂了-我错过了一组括号，现在我看到
NROW（unique（））
是预过滤的，这很好。
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