更新自定义函数以按组获取组合汇总统计信息答案

【问题标题】：Updating a custom function to get combined summary statistics by groups更新自定义函数以按组获取组合汇总统计信息
【发布时间】：2020-09-23 05:42:27
【问题描述】：

我创建了一个函数，用于获取平均值、百分位数的摘要。但我不想要特定子集的摘要。所以我相应地创建了子集。

但我的功能无法正常工作。

所以实际上我正在尝试更新我的函数，以便我可以获得变量列表的摘要，因为变量名称和摘要可以是多个变量列表的 rbind。

我不知道如何在我的函数中将“ALL”、“MM”作为变量的名称。这样两者的摘要就可以是 rbind 本身

df <- data.frame(Name = c("asdf","kjhgf","cvbnm","rtyui","cvbnm","jhfd","cvbnm","sdfghj","cvbnm","dfghj","cvbnm"),
                 sale=c(27,28,27,16,14,25,14,14,19,18,28),
                 city=c("CA","TX","MN","NY","TX","MT","HU","KL","TX","SA","TX"),
                 Dept = c("HH","MM","NN","MM","AA","VV","MM","HU","JJ","MM","ZZ"))


df1<- df
df$cc1<-1
df2<- subset(df, Dept == 'MM')
df$cc2<-ifelse(df$Dept == 'MM',1,NA)
lst<-list(df$cc1, df$cc2)
listd<-list("ALL" = df1, "MM" =df2)

#I want to run my function for listd so that i can get a  combined summary for all variables in listd
tt2<-function(data,var,footer,Name_of_variable,decimal){
  for (d in 1:length(data)) {
    cat('\n\n#### ', names(data)[d], '\n\n')
    md<-data[[d]]
    table_list<-list()
    for (i in 1:length(d))
      table_list[[i]]<-t1(md,var,footer,decimal,Name_of_variable)
    tt<- do.call(rbind,table_list)
  } 
  cat(knit_print(tt))
  cat('\n\n')
}
t1<-function(dataset,var,Suff,decimal,Name_of_variable){
  numdig <- if (decimal == TRUE) {1} else {0}
  var <- rlang::parse_expr(var) 
summ_tab1<- dataset %>% filter(!is.na(!!var)) %>%   summarise(
  q25 = format(round(quantile(!! var,  type=6, probs = seq(0, 1, 0.25), na.rm=TRUE)[2],digits = numdig),nsmall = numdig),
  Median = format(round(quantile(!! var, type=6, probs = seq(0, 1, 0.25), na.rm=TRUE)[3],digits = numdig),nsmall = numdig),
  Average = format(round( mean(!! var, na.rm=TRUE),digits = numdig),nsmall = numdig),
  q75 = format(round(quantile(!! var, type=6, probs = seq(0, 1, 0.25), na.rm=TRUE)[4],digits = numdig) ,nsmall = numdig),
  N = sum(!is.na(!!var)))
summ_tab<-summ_tab1 %>%  
  mutate(" "=!!Name_of_variable,
         q25 = q25,
         Median =Median,
         Average =Average,
         q75 = q75)%>%
  dplyr::rename(
    `25th percentile` = q25,
    `75th percentile` = q75)%>%select(" ",N,everything())
summ_tab1
}


tt2(data = listd,var = "sale",Name_of_variable = "listd",decimal = TRUE)

以前我得到如下摘要

但现在输出摘要应该是这样的，变量的名称应该是行。

【问题讨论】：

欢迎来到 SO 并感谢您提供 MRE！除了您的问题，我建议您遵循样式指南，例如tidyverse styleguide（但还有更多）。这使您的代码更易于阅读，因此也更易于调试:)
我尝试过使用调试但不起作用

标签： r function dplyr

【解决方案1】：

我稍微重写了您的t1 函数并利用它返回数据帧的事实。这个可以和purrr::map_dfr一起使用：

library(dplyr)

df <- data.frame(Name = c("asdf","kjhgf","cvbnm","rtyui","cvbnm","jhfd","cvbnm","sdfghj","cvbnm","dfghj","cvbnm"),
                 sale=c(27,28,27,16,14,25,14,14,19,18,28),
                 city=c("CA","TX","MN","NY","TX","MT","HU","KL","TX","SA","TX"),
                 Dept = c("HH","MM","NN","MM","AA","VV","MM","HU","JJ","MM","ZZ"))


df1<- df
df$cc1<-1
df2<- subset(df, Dept == 'MM')
df$cc2<-ifelse(df$Dept == 'MM',1,NA)
lst<-list(df$cc1, df$cc2)
listd<-list("ALL" = df1, "MM" =df2)

t1 <- function(dataset, var, decimal){
  numdig <- if (decimal == TRUE) {
    1
  } else {
    0
  }
  
  var <- rlang::parse_expr(var)
  
  dataset %>%
    filter(!is.na(!!var)) %>%
    summarise(
      q25 = format(round(quantile(!!var,
                                  type = 6,
                                  probs = seq(0, 1, 0.25),
                                  na.rm=TRUE)[2],
                         digits = numdig),
                   nsmall = numdig),
      Median = format(round(quantile(!!var,
                                     type = 6,
                                     probs = seq(0, 1, 0.25), na.rm=TRUE)[3],
                            digits = numdig),
                      nsmall = numdig),
      Average = format(round(mean(!!var,
                                  na.rm = TRUE),
                             digits = numdig),
                       nsmall = numdig),
      q75 = format(round(quantile(!!var,
                                  type = 6,
                                  probs = seq(0, 1, 0.25),
                                  na.rm = TRUE)[4],
                         digits = numdig),
                   nsmall = numdig),
      N = sum(!is.na(!!var))) %>% 
    rename(
      `25th percentile` = q25,
      `75th percentile` = q75)
}

listd %>% 
  purrr::map_dfr(~t1(dataset = .x, var = "sale", decimal = TRUE), .id = " ")
#>       25th percentile Median Average 75th percentile  N
#> 1 ALL            14.0   19.0    20.9            27.0 11
#> 2  MM            14.5   17.0    19.0            25.5  4

^{由reprex package (v0.3.0) 于 2020 年 9 月 23 日创建}

【讨论】：