Quantcast
Channel: グラフ - 廿TT
Viewing all articles
Browse latest Browse all 123

ggplot2 で内訳を左から右に詳細化していく棒グラフ (2)

$
0
0

以前にこんなのを書いたんだが、
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))

f:id:abrahamcow:20190207030822p:plain


Viewing all articles
Browse latest Browse all 123

Trending Articles