创建具有相互关联的分布的多因素geom_bar

Question

采取以下样本数据：

set.seed(123456)
#
Male_alive <- rbinom(100,1,0.6)
Male_age <- sample(20:80, 100, T)
#
Female_alive <- rbinom(100,1,0.7)
Female_age <- sample(20:80, 100, T)
#
Alive <- c(Male_alive, Female_alive)
Age <- c(Male_age, Female_age)
Sex <- c(rep('Male', length(Male_alive)),rep('Female', length(Female_alive)))
#
Patients <- data.frame(Alive, Age, Sex) 

我可以使用以下代码创建一个简单的条形图：

ggplot(Patients, aes(Sex, fill = factor(Alive))) +
  geom_bar(position = "fill")

但我希望通过创建一个看起来像图像的多因素条形图（针对Sex和AgeGr）来扩展这一点（颜色并不重要）：

#
Patients$AgeGr <- cut(Patients$Age, 6)

使用

ggplot(Patients, aes(..., fill = factor(Alive))) +
  geom_bar(position = "fill") + geom_wrap(~Sex)

AgeGr仅填充到Alive的相应高度

Answer 1

也许这可能是一种可怕的方式：

#to get plots side by side
library(gridExtra)

#plot count of males
pmales <-ggplot(Patients[Patients$Sex=='Male',], aes(Sex, fill =factor(Alive))) + geom_bar(position='fill')

#plot grage males0
pagegrmales0 <-ggplot(Patients[Patients$Sex=='Male' & Patients$Alive==0,], aes(Sex, fill =factor(AgeGr))) + geom_bar(position='fill') + ylab(NULL) +xlab(NULL) + theme(legend.position="none", plot.margin=unit(c(1,1,-0.5,1), "cm"))

#plot grage males1
pagegrmales1 <-ggplot(Patients[Patients$Sex=='Male' & Patients$Alive==1,], aes(Sex, fill =factor(AgeGr))) + geom_bar(position='fill') + ylab(NULL) +xlab(NULL) + theme(legend.position="none", plot.margin=unit(c(-0.5,1,1,1), "cm"))

factorsmale <- grid.arrange(pagegrmales0, pagegrmales1, heights=c(prop.table(table(Patients[Patients$Sex=='Male',]$Alive))[[1]], prop.table(table(Patients[Patients$Sex=='Male',]$Alive))[[2]]), nrow=2)

males <- grid.arrange(pmales, factorsmale, ncol =2, nrow= 2)

########

#plot count of females
pfemales <-ggplot(Patients[Patients$Sex=='Female',], aes(Sex, fill =factor(Alive))) + geom_bar(position='fill')

#plot grage females0
pagegrfemales0 <-ggplot(Patients[Patients$Sex=='Female' & Patients$Alive==0,], aes(Sex, fill =factor(AgeGr))) + geom_bar(position='fill') + ylab(NULL) +xlab(NULL) + theme(legend.position="none", plot.margin=unit(c(1,1,-0.5,1), "cm"))

#plot grage females1
pagegrfemales1 <-ggplot(Patients[Patients$Sex=='Female' & Patients$Alive==1,], aes(Sex, fill =factor(AgeGr))) + geom_bar(position='fill') + ylab(NULL) +xlab(NULL) + theme(legend.position="none", plot.margin=unit(c(-0.5,1,1,1), "cm"))

factorsfemale <- grid.arrange(pagegrfemales0, pagegrfemales1, heights=c(prop.table(table(Patients[Patients$Sex=='Female',]$Alive))[[1]], prop.table(table(Patients[Patients$Sex=='Female',]$Alive))[[2]]), nrow=2)

females <- grid.arrange(pfemales, factorsfemale, ncol =2, nrow= 2)

grid.arrange(males, females, ncol = 2, nrow = 1)

Answer 2

合并alive和agegroup列

Patients$Alive_AgeGr <- paste(Patients$Alive, Patients$AgeGr, sep="_")

剧情

ggplot(Patients, aes(x = factor(Alive), fill = factor(AgeGr))) +
    geom_bar(position = "fill") + facet_wrap(~Sex)

Answer 3

首先，您需要创建仅包含所需列的长格式数据集，然后使用换行绘制堆积条图，如下所示：

library("reshape2")
mPatients <- melt(Patients[,-2], id.vars = "Sex")

ggplot(mPatients, aes(x=variable, fill = factor(value))) +
    geom_bar(position = "fill") + facet_wrap(~Sex)