r-用比例(百分比)扩展事故表



我有一个计数的列联表,我想用每组的相应比例来扩展它。

一些样本数据(ggplot2包中的tips数据集):

library(ggplot2)
head(tips, 3)
#   total_bill tip    sex smoker day   time size
# 1         17 1.0 Female     No Sun Dinner    2
# 2         10 1.7   Male     No Sun Dinner    3
# 3         21 3.5   Male     No Sun Dinner    3

首先,使用table来计算吸烟者与非吸烟者的对比,nrow来计算受试者总数:

table(tips$smoker)
#  No Yes 
# 151  93 
nrow(tips)
# [1] 244

然后,我想计算一下吸烟者和不吸烟者的比例。类似这样的东西(丑陋的代码):

# percentage of smokers
options(digits = 2)
transform(as.data.frame(table(tips$smoker)), percentage_column = Freq / nrow(tips) * 100)
#   Var1 Freq percentage_column
# 1   No  151                62
# 2  Yes   93                38

有更好的方法吗?

(更好的做法是对一组列(我列举了这些列)执行此操作,并使输出格式良好)(例如,吸烟者、日期和时间)

如果你想要简洁,你可能会喜欢:

prop.table(table(tips$smoker))

然后按100缩放,如果你喜欢的话可以进行圆形缩放。或者更像你的确切输出:

tbl <- table(tips$smoker)
cbind(tbl,prop.table(tbl))

如果你想为多个专栏做这件事,根据你的口味,你可以选择很多不同的方向,但这里有一个选择:

tblFun <- function(x){
    tbl <- table(x)
    res <- cbind(tbl,round(prop.table(tbl)*100,2))
    colnames(res) <- c('Count','Percentage')
    res
}
do.call(rbind,lapply(tips[3:6],tblFun))
       Count Percentage
Female    87      35.66
Male     157      64.34
No       151      61.89
Yes       93      38.11
Fri       19       7.79
Sat       87      35.66
Sun       76      31.15
Thur      62      25.41
Dinner   176      72.13
Lunch     68      27.87

如果你不喜欢把不同的表叠在一起,你可以放弃do.call,把它们放在列表中。

您的代码对我来说并不难看…
然而,一种替代方案(好不了多少)可以是:

df <- data.frame(table(yn))
colnames(df) <- c('Smoker','Freq')
df$Perc <- df$Freq / sum(df$Freq) * 100
------------------
  Smoker Freq Perc
1     No   19 47.5
2    Yes   21 52.5

我不能100%确定,但我认为使用prop.table可以达到你想要的效果。主要参见最后3行。其余的代码只是在创建伪造的数据。

set.seed(1234)
total_bill <- rnorm(50, 25, 3)
tip <- 0.15 * total_bill + rnorm(50, 0, 1)
sex <- rbinom(50, 1, 0.5)
smoker <- rbinom(50, 1, 0.3)
day <- ceiling(runif(50, 0,7))
time <- ceiling(runif(50, 0,3))
size <- 1 + rpois(50, 2)
my.data <- as.data.frame(cbind(total_bill, tip, sex, smoker, day, time, size))
my.data
my.table <- table(my.data$smoker)
my.prop <- prop.table(my.table)
cbind(my.table, my.prop)

这里有一个tidyverse版本:

library(tidyverse)
data(diamonds)
(as.data.frame(table(diamonds$cut)) %>% rename(Count=1,Freq=2) %>% mutate(Perc=100*Freq/sum(Freq)))

或者,如果你想要一个方便的功能:

getPercentages <- function(df, colName) {
  df.cnt <- df %>% select({{colName}}) %>% 
    table() %>%
    as.data.frame() %>% 
    rename({{colName}} :=1, Freq=2) %>% 
    mutate(Perc=100*Freq/sum(Freq))
}

现在你可以做:

diamonds %>% getPercentages(cut)

或者这个:

df=diamonds %>% group_by(cut) %>% group_modify(~.x %>% getPercentages(clarity))
ggplot(df,aes(x=clarity,y=Perc))+geom_col()+facet_wrap(~cut)

我在做聚合函数和类似的时做了这个

per.fun <- function(x) {
    if(length(x)>1){
        denom <- length(x);
        num <- sum(x);
        percentage <- num/denom;
        percentage*100
        }
        else NA
    }

这里是在基R中使用lapplytable函数的另一个例子。

freqList = lapply(select_if(tips, is.factor), 
              function(x) {
                  df = data.frame(table(x))
                  df = data.frame(fct = df[, 1], 
                                  n = sapply(df[, 2], function(y) {
                                      round(y / nrow(dat), 2)
                                    }
                                )
                            )
                  return(df) 
                    }
                )

使用print(freqList)查看标记为因子的每列/特征/变量(取决于您的工艺)的比例表(频率百分比)。

最新更新