R语言 统计描述 分组统计(各种小方案)

可以直接复制到R运行

#加载包
library(tidyverse)
#创建一系列数据
data=data.frame(
  row.names = c('QWE','TYE','WUN','EJN','JDB',
                'wuy','okf','Aqe','Bdf','wty') ,
  Chinese = c(50, 60, 64, 55, 59,
              54, 61, 63, 64, 66 ),
  Math =  c(72, 68, NA, 29, NA,   #这里故意设置了缺失值
            45, 76, 74, 76, 75 ),
  gender = c(1, 2, 1, 2, 2, 2,1,1,2,1),  #1=男  2=女
  smoke = c('y','n','y','y','y','n','n','y','n','y'),
  bmi = c('正常','低体重','正常','超重','肥胖',
          '低体重','超重','正常','低体重','正常')
)
#自定义function内容
describe<-function(x,na.omit=TRUE){     #na.omit=TRUE不忽略缺失值
  if (na.omit)
    Miss<-sum(is.na(x)==TRUE)    #统计缺失值个数
  x<-x[!is.na(x)]                #去掉缺失值，下面的都是去掉NA计算的
  m<-mean(x)
  n<-length(x)                   #全部数据(已经去掉缺失值的)
  s<-sd(x)
  skew<-sum((x-m)^3/s^3)/n
  kurt<-sum((x-m)^4/s^4)/n-3
  Normal_ks=ks.test(x,"pnorm")[["p.value"]]
  #Noraml_sh=shapiro.test(x)[["p.value"]]    #把#号去掉可用
  return(round(c(n=n,Miss=Miss,mean=m,stdev=s,
                 skew=skew,kurtosis=kurt,
                 Normal_ks=Normal_ks
                 #Noraml_sh=Noraml_sh       #把#号去掉可以用
                 ),3))
}
#第一种分组统计法
b1 <- data    %>%
  filter(gender==1)  %>%
  select(Chinese,Math) %>%
  sapply(describe)
b2 <- data    %>%
  filter(gender==2)  %>%
  select(Chinese,Math) %>%
  sapply(describe)
cbind(b1,b2)  %>% print()
#第二种分组统计
describe_by<-function(x,na.omit=TRUE)sapply(x,describe,na.omit=TRUE)
a=by(data[,c('Chinese','Math')],data$gender,describe_by)
a
cbind(a[["1"]],a[["2"]])
#第三种方式
describe_by<-function(x,na.omit=TRUE)sapply(x,describe,na.omit=TRUE)
myvars <- c('Chinese','Math')
by(data[myvars], 
   list(xingbie=data$gender,
        xiyan=data$smoke), 
   FUN=describe_by)
#一些说明
# ties should not be present for the Kolmogorov-Smirnov test
#样本数据中存在有相同的值，单样本K-S检验要求检验分布是连续的，
#而连续分布出现相同值的概率为0.如果是出现相同的，则连续分布的假设不成立，
#则该方法无法使用

#第四种
library(Hmisc)    #在Hmisc包，需要预加载
describe(data$age) 
describe(data[data$nq101==1,]$age) #分组统计

#第五种 描述百分位数的
quantile(data[data$nq101==1, ]$age, p = c(0.05,0.25, 0.5, 0.75)) #分组统计
quantile(data$age, p = c(0.05,0.25, 0.5, 0.75))

#第六种 map函数
library(purrr)
map(data[data$group=="case",1:2],mean)

#第七种
#aggregate分类汇总函数
aggregate(x=list(), #进行分类的数据
          by=list(),#进行分类的数据条件，也就是分组
          FUN=
          )

fenlei1 <- aggregate(x=list(Q=data$Sepal.Length), #进行分类的数据  Q是行名
          by=list(group=data$Species),#进行分类的数据条件，也就是分组 
          FUN=mean,    #length mean sd 
)
fenlei1


#其他
summary(data[data$Species=='virginica',]$Sepal.Length)
mean(data[data$Species=='virginica',]$Sepal.Length)