创建用于迭代摘要的自定义函数

Question

我创建了一个算法来获取子集列表的摘要。

这是我的数据框：

df <- data.frame(
  Name = c("asdf", "kjhgf", "cvbnm", "rtyui", "cvbnm", "jhfd", "cvbnm", "sdfghj", "cvbnm", "dfghj", "cvbnm"),
  sale = c(27,NA, 27, 16, 14,NA, 14, 14,NA, 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
#Astellas
df2<- subset(df, Dept == 'MM')
df$cc2<-ifelse(df$Dept == 'MM',1,NA)
lst<-list(df$cc1, df$cc2)
ldat<-list("ALL" = df1, "MM" =df2)

使用下面的算法，我可以获得所需的摘要输出，但我想创建一个功能相同的函数。请帮助了解如何创建自定义函数以获得与以下脚本相同的结果。

df %>%
  select(-Name, -city) %>%
  group_by(Dept) -> dat

  N <- length(dat[[1]])
  Median <- median(dat[[1]])
  Average <- mean(dat[[1]])
  q25 <- quantile(dat[[1]])[2]
  q75 <- quantile(dat[[1]])[4]
  cbind(q25, Median, Average, q75, N) -> ALL
  dat %>% filter(Dept == "MM") -> MM
  N <- length(MM[[1]])
  Median <- median(MM[[1]])
  Average <- mean(MM[[1]])
  q25 <- quantile(MM[[1]])[2]
  q75 <- quantile(MM[[1]])[4]
  cbind(q25, Median, Average, q75, N) -> MM
  as.data.frame(rbind(ALL, MM)) %>%
  `rownames<-`(., c("ALL", "MM")) %>%
    pander::pander() %>% as.data.frame()

我需要把上面的脚本转换成这样的函数：

functiont(data=ldat,var = "sale", name_of_var = c("ALL","MM"))

对于变量列表，函数应该是动态的。在这种情况下，我们有两个变量c("ALL" ,"MM")。所以这应该是动态的。

输出摘要应该是这样的flextable：

Answer 1

检查您的代码后，您想要的功能是可能的。本解决方案中的函数采用所需的参数，但我稍作修改以仅使用一个数据帧，即主要的df。原因是ALL 摘要将始终来自第一个大数据框，因此不需要为全局数据框创建列表，然后为过滤器创建其他对象。该功能产生您想要的东西，它可以接受您提到的任何过滤器。这里是函数的代码和一些应用：

library(dplyr)
#Function
myfun <- function(data,var, name_of_var)
{
  #Data
  dat <- data
  #Compute for all items
  N <- length(dat[[var]])
  Median <- median(dat[[var]])
  Average <- mean(dat[[var]])
  q25 <- quantile(dat[[var]])[2]
  q75 <- quantile(dat[[var]])[4]
  as.data.frame(cbind(q25, Median, Average, q75, N)) -> ALL
  rownames(ALL) <- 'All'
  #Now the filter values
  dat %>% filter(Dept %in% name_of_var) -> MM
  #Create list
  List <- split(MM,MM$Dept)
  #Apply summaries in a function
  compute <- function(x)
  {
    N <- length(x[[var]])
    Median <- median(x[[var]])
    Average <- mean(x[[var]])
    q25 <- quantile(x[[var]])[2]
    q75 <- quantile(x[[var]])[4]
    as.data.frame(cbind(q25, Median, Average, q75, N)) -> y
    rownames(y) <- unique(x$Dept)
    return(y)
  }
  #Apply
  List2 <- do.call(rbind,lapply(List,compute))
  #Bind all
  Binded <- rbind(ALL,List2)
  return(Binded)
}

现在，一些应用程序：

#Apply function 1
Ex1 <- myfun(data=df,var = "sale", name_of_var = c("MM"))

输出：

     q25 Median  Average  q75  N
All 15.0     19 20.90909 27.0 11
MM  15.5     17 19.00000 20.5  4

示例 2：

#Apply function 2
Ex2 <- myfun(data=df,var = "sale", name_of_var = c("MM","HH"))

输出：

     q25 Median  Average  q75  N
All 15.0     19 20.90909 27.0 11
HH  27.0     27 27.00000 27.0  1
MM  15.5     17 19.00000 20.5  4

之后，您可以根据需要以任何样式格式化输出。

Answer 2

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