以前にこんなのを書いたんだが、
ggplot2 で内訳を左から右に詳細化していく棒グラフ - 廿TT
新しいgeomを作るまでもないことに気がついた。
library(tidyverse) make_drilldown <-function(data,dimensions,metrics){ len <- length(dimensions) out <-vector("list",len) dat1 <- as.data.frame(dplyr::summarize_each_(dplyr::group_by_(data, dimensions[1]),dplyr::funs(sum),metrics)) dat1$level <- dat1[,1] dat1 <- setNames(dat1,c("level",metrics,"label")) dat1 <- dat1[order(dat1$label, decreasing =TRUE),] dat1$dimensions <- dimensions[1] out[[1]]<-dat1 if(len>=2){for(i in2:len){ tmp <- as.data.frame(dplyr::summarize_each_(dplyr::group_by_(data, .dots=dimensions[1:i]),dplyr::funs(sum),metrics)) tmp <- tidyr::unite(tmp,level,1:i,remove=FALSE,sep="__") tmp <- tmp[,-c(2:i)] tmp <- setNames(tmp,c("level","label",metrics)) tmp <- tmp[order(tmp$level,decreasing =TRUE),] tmp$dimensions <- dimensions[i] out[[i]]<- tmp }} out_df <- dplyr::bind_rows(out) out_df$dimensions <- factor(out_df$dimensions,levels = dimensions) out_df } Titanic_df <- make_drilldown(as.data.frame(Titanic),dimensions = c("Survived","Age","Sex","Class"),metrics ="Freq") ggplot(Titanic_df,aes(x=dimensions,y=Freq,group=level,label=label,fill=label))+ geom_col(colour="black",alpha=0.5,width=1)+ geom_text(position = position_stack(vjust =0.5))+ theme(legend.position ="none",axis.text.x = element_text(size=18))