R/dual-y-axis.R

In ShouyeLiu/metaboliteUtility:

plot_theme <- function(p)
{
    plyr::defaults(p$theme, theme_get())
}

hinvert_title_grob <- function(grob){
    widths <- grob$widths
    grob$widths[1] <- widths[3]
    grob$widths[3] <- widths[1]
    grob$vp[[1]]$layout$widths[1] <- widths[3]
    grob$vp[[1]]$layout$widths[3] <- widths[1]

    grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
    grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
    grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
    grob
}
#'  merge two ggplots

#' @param leftplot left plot
#' @param rightplot right plot
#' @examples

#'    library(ggplot2)
#'    p1<-ggplot(economics, aes(date, unemploy)) + geom_line()
#'    recent <- economics[economics$date > as.Date("2013-01-01"), ]
#'    p2<-ggplot(recent, aes(date, unemploy)) + geom_line(colour="red")
#'    mergeggplot(p1,p2)

mergeggplot<-function(leftplot,rightplot)
{
    rightplot<-rightplot+ggplot2::theme(panel.background = ggplot2::element_rect(fill = NA),
                                        panel.grid.major=element_line(colour=NA))
    rightplot<-rightplot+xlab("")
    g1 <- ggplot2::ggplotGrob(leftplot)
    g2 <- ggplot2::ggplotGrob(rightplot)
    # Grab the panels from g2 and overlay them onto the panels of g1
    pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), select = t:r))
    g <- gtable::gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)],
                                 pp$t, pp$l, pp$b, pp$l)
    index <- which(grepl("axis-l", g2$layout$name))  # Which grob
    if(length(index)>1)
    {
        index <- which("axis-l-1-1"== g2$layout$name)  # Which grob
    }
    yaxis <- g2$grobs[[index]]                    # Extract the grob
    ticks <- yaxis$children[[2]]
    ticks$widths <- rev(ticks$widths)
    ticks$grobs <- rev(ticks$grobs)


    tml <- plot_theme(leftplot)$axis.ticks.length   # Tick mark length
    ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + tml

    ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
    yaxis$children[[2]] <- ticks
    # Put the y axis into g, to the right of the right-most panel
    # Note: Only one column, but two y axes - one for each row of the facet_wrap plot
    for(i in 1:length(unique(pp$r)))
    {
        g <- gtable::gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = unique(pp$r)[i])
        pp <- c(subset(g$layout, grepl("panel", g$layout$name), select = t:r))
    }

    ncols = length(unique(pp$r)) # Number of col
    nrows = length(unique(pp$t)) # Number of rows
    emptycell=0
    for(i in rev(1:(ncols*nrows)))
    {
        if("NULL"==g$grobs[grepl("panel", g1$layout$name)][[i]]$name)
        {
            emptycell=emptycell+1;
        }

    }
    lastline_col=ncols-emptycell
    if(nrows>1)
    {
        for(i in 1:(nrows-1))
        {
            g <- gtable::gtable_add_grob(g, rep(list(yaxis), ncols),
                                         t = unique(pp$t)[i], l = unique(pp$r)+1,
                                         b = unique(pp$b)[i], r = unique(pp$r)+1,
                                         clip = "off", name = paste0("axis-r-",i,"-", 1:ncols))
        }
    }
    g <- gtable::gtable_add_grob(g, rep(list(yaxis), lastline_col),
                                 t = unique(pp$t)[nrows], l = unique(pp$r)[1:lastline_col]+1,
                                 b = unique(pp$b)[nrows], r = unique(pp$r)[1:lastline_col]+1,
                                 clip = "off", name = paste0("axis-r-",i,"-", 1:lastline_col))
    index <- which(g2$layout$name == "ylab-l")
    if(length(index)!=0)
    {
        ylab <- g2$grobs[[index]]                # Extract that grob
        ylab <- hinvert_title_grob(ylab)
        # Put the y label into g, to the right of the right-most panel
        # Note: Only one column and one y label
        g <- gtable::gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r+1))
        g <- gtable::gtable_add_grob(g,ylab, t = min(pp$t), l = max(pp$r)+2,
                                     b = max(pp$b), r = max(pp$r)+2,
                                     clip = "off", name = "ylab-r")
    }
    g1box_index<-which(g1$layout$name == "guide-box")
    g2box_index<-which(g2$layout$name == "guide-box")
    if(length(g1box_index)&&length(g2box_index))
    {
        leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]]
        leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]]
        g$grobs[[which(g$layout$name == "guide-box")]] <-gtable:::rbind_gtable(leg1, leg2, "first")
    }
    grid::grid.draw(g)
}