Mercurial > repos > artbio > small_rna_map
diff small_rna_map.r @ 0:1ad5d040f85f draft
planemo upload for repository https://github.com/ARTbio/tools-artbio/tree/master/tools/small_rna_map commit fa452d860cf550c7524df59e77b36fd39e3e2a45
| author | artbio |
|---|---|
| date | Mon, 10 Jul 2017 10:31:49 -0400 |
| parents | |
| children | 2299eb1e7c93 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/small_rna_map.r Mon Jul 10 10:31:49 2017 -0400 @@ -0,0 +1,164 @@ +library(optparse) +library(ggplot2) +library(gridExtra) +library(RColorBrewer) +library(gtable) +library(grid) + +option_list <- list( + make_option(c("-r", "--output_tab"), type="character", help="path to tabular file"), + make_option("--output_pdf", type = "character", help="path to the pdf file with plot") + ) + +parser <- OptionParser(usage = "%prog [options] file", option_list = option_list) +args = parse_args(parser) + +theme_set(theme_bw()) #a theme with a white background +Table = read.delim(args$output_tab, header=T, row.names=NULL) +Table <- within(Table, Nbr_reads[Polarity=="R"] <- (Nbr_reads[Polarity=="R"]*-1)) + +#To assign colors to categorical variables in ggplot2 that have stable mapping +myColors <- brewer.pal(3,"Set1") +names(myColors) <- levels(Table$Polarity) +colScale <- scale_colour_manual(name = "Polarity",values = myColors) + +#Make initial figures +p <- ggplot(Table, aes(x=Coordinate, y=Nbr_reads, colour=Polarity)) + + colScale+ + geom_segment(aes(y = 0, + x = Coordinate, + yend = Nbr_reads, + xend = Coordinate, + color=Polarity), + alpha=1 + ) + + geom_segment(aes(y = Nbr_reads, + x = 0, + yend=Nbr_reads, + xend=Chrom_length), alpha=0 + )+ + facet_wrap(Dataset~Chromosome, scales="free", nrow=1, labeller = label_wrap_gen(multi_line = FALSE))+ + scale_y_continuous(breaks = function(x) round(pretty(seq(-(max(x) + 1), (max(x) + 1)))))+#to display only integer values on y axis + geom_hline(yintercept=0, size=0.3)+ + theme(strip.text = element_text(size = 6, lineheight = 0.1), #specify strip size + panel.grid.major = element_line(colour = "#ffffff"),#conceal major grid lines + panel.grid.minor = element_line(colour = "#ffffff"),#conceal minor grid lines + axis.title = element_blank(),# Conceal axis titles + axis.text = element_text(size = 6))#modify the size of tick labels along axes +#extract legend +g_legend<-function(a.gplot){ + tmp <- ggplot_gtable(ggplot_build(a.gplot)) + leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") + legend <- tmp$grobs[[leg]] + return(legend)} + +mylegend <- g_legend(p); + +p <- p+ theme(legend.position = "none")# Hide the repeated caption + +# The second plot +cols<- c("Median"="#000000", "Mean"="#fffa00") +p2 <- ggplot(Table, aes(x = Coordinate, group=1)) + + geom_point(aes(y=Median, colour="Median"), alpha=1, size = 1) + + geom_point(aes(y=Mean, colour="Mean"), alpha= 0.3, size = 1.2)+ + scale_colour_manual(name="", values=cols)+ + expand_limits(y = seq(0,max(Table$Median),by=5)) + + facet_wrap(Dataset~Chromosome, scales="free", nrow=1, labeller = label_wrap_gen(multi_line = FALSE))+ + geom_segment(aes(y = Nbr_reads, + x = 0, + yend=Nbr_reads, + xend=Chrom_length), alpha=0 + )+ + scale_y_continuous(limits = c(0,max(Table$Median)), position = "right")+ + theme(strip.text = element_text(size = 6, lineheight = 0.1), + panel.background = element_rect(fill = NA), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_rect(fill = NA, colour = "grey50"), + axis.text = element_text(size = 6), + legend.position = "right" + ) +mylegend2 <- g_legend(p2); +legend <- rbind(mylegend, mylegend2) +# Transforme ggplot graphs on list of graphs +plot.list1 <- by(data = Table, + INDICES = c(Table$Chromosome), + simplify = TRUE, + FUN = function(x) { + p %+% x + }) + +plot.list2 <- by(data = Table, + INDICES = c(Table$Chromosome), + simplify = TRUE, + FUN = function(x) { + p2 %+% x + }) + +# A function to get the original tick mark length +plot_theme <- function(p) { + plyr::defaults(p$theme, theme_get()) +} + +# ggplot contains many labels that are themselves complex grob; +# usually a text grob surrounded by margins. +# When moving the grobs from, say, the left to the right of a plot, +# Make sure the margins and the justifications are swapped around. +# The function below does the swapping. +# Taken from the cowplot package: +# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R + +hinvert_title_grob <- function(grob){ + + # Swap the widths + 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] + + # Fix the justification + 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 +} + +dual_axis <- function(v1,v2){ +# Get the ggplot grobs + g1 <- ggplot_gtable(ggplot_build(v1)) + g2 <- ggplot_gtable(ggplot_build(v2)) +# Get the locations of the plot panels in g1. + pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r)) +# Overlap panels for second plot on those of the first plot + g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)], + pp$t, pp$l, pp$b, pp$l) +# Get the y axis from g2 (axis line, tick marks, and tick mark labels) + index <- which(g2$layout$name == "axis-r-1-1") # Which grob. + yaxis <- g2$grobs[[index]] # Extract the grob + ticks <- yaxis$children[[2]] # swap tick marks and tick mark labels + +# Move the tick marks, Tick mark lengths can change. + tml <- plot_theme(p)$axis.ticks.length # Tick mark length + ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + tml + +# Swap margins and fix justifications for the tick mark labels +ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]]) + +# Put ticks back into yaxis +yaxis$children[[2]] <- ticks + +# Put the transformed yaxis on the right side of g1 +g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], max(pp$r)) +g <- gtable_add_grob(g, yaxis, max(pp$t), max(pp$r) + 1, max(pp$b), max(pp$r) + 1, + clip = "off") + +} + +plots <- list() +len = length(plot.list1) +for(i in 1:len ) {plots[[i]] <- dual_axis(plot.list1[[i]],plot.list2[[i]])} +# Plotting in multiple pages with different rows +multi.plot<-do.call(marrangeGrob,list(grobs=plots,ncol=1,nrow=8,top=NULL, bottom="Coordinates(nt)", left="Number of reads", right= legend)) +ggsave(args$output_pdf, device="pdf", plot=multi.plot, height=11.69, width=8.2) +
