 library("ggplot2")
 library("dplyr")
 library("grid")
 library("stringr")
 library("purrr")
 
 # 元のグラフ
 gp <- ggplot(data = iris, aes(Species, Sepal.Length)) +
   geom_boxplot(aes(colour = Sepal.Width < 3.2)) + 
   scale_x_discrete(name="")
 gp
 
 # 種名（後で使う）
 species_names <- c("setosa", "versicolor", "virginia")
 
 # ggplot の各レイヤーの情報を取得
 gt <- ggplotGrob(gp)
 
 # 各ボックスプロットの座標を取得
 # レイヤー名などは毎回変わる
 # 6番目のpanel 指定
 # gt$grobs[[6]]
 # そこから children をたどって geom_boxplot.gTree.xxx というのを探す
 # これの children が boxplot を描画している要素 
 # 各boxplot の children から segment を探す
 ## segment はエラーバーを描画している
 ## ない場合は boxplot の頂点の座標から計算する
 # segment の x0 が求めたい座標
 
 filter_child <- function(node, pattern){
   node %>% 
     pluck("children") %>% 
     attributes() %>% 
     pluck("names") %>% 
     str_subset(pattern)
 }
 
 
 filter_grobs <- function(node, pattern){
   node %>% 
     pluck("grobs") %>% 
     map_chr(function(x){
       x$name
     }) %>% 
     str_which(pattern)
 }
 
 id.panel <- grep("panel", gt$layout$name)
 
 geom_boxplot_name <- gt$grobs[[id.panel]] %>% 
   filter_child("^geom_boxplot.gTree")
 
 x <- gt$grobs[[id.panel]] %>% 
   pluck("children") %>% 
   pluck(geom_boxplot_name) %>% 
   pluck("children") %>% 
   map_dbl(function(x){
     grid_segments_name <- x %>% 
       filter_child("^GRID.segments")
     x %>% 
       pluck("children") %>% 
       pluck(grid_segments_name) %>% 
       pluck("x0") %>% 
       pluck(1)
   }) %>% 
   unit("native")
 
 # 軸の情報を変更
 # ラベルのx座標
 id.axis <- grep("axis-b", gt$layout$name)
 id.axis_text_x_bottom <- filter_grobs(gt$grobs[[id.axis]]$children$axis, "^axis.text.x.bottom..titleGrob")
 grid_text_name <- gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_text_x_bottom]] %>% 
   filter_child("^GRID.text")
 
 x_org <- unit(gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_text_x_bottom]]$children[[grid_text_name]]$x, "native")
 
 gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_text_x_bottom]]$children[[grid_text_name]]$x <- unit.c(x, x_org)
 
 # ラベル名
 l <- c("FALSE", "FALSE", "FALSE", "TRUE", "TRUE", "TRUE")
 gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_text_x_bottom]]$children[[grid_text_name]]$label <- c(l, species_names)
 
 # ラベルのy座標
 y <- rep(unit(1, "npc"), 6)
 gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_text_x_bottom]]$children[[grid_text_name]]$y <- unit.c(y, unit(rep(0, 3), "npc"))
 
 
 # x軸目盛（tick）の変更
 # x座標
 id.axis_ticks_x_bottom <- filter_grobs(gt$grobs[[id.axis]]$children$axis, "^axis.ticks.x.bottom")
 gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_ticks_x_bottom]]$x <- sort(rep(x, 2))
 
 # y座標
 gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_ticks_x_bottom]]$y <- rep(gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_ticks_x_bottom]]$y, 2)
 
 # id.length?
 gt$grobs[[id.axis]]$children$axis$grobs[[id.axis_ticks_x_bottom]]$id.lengths <- c(2, 2, 2, 2, 2, 2)
 
 plot(gt)