Mercurial > repos > iarc > mutspec
view R/mutationSpectra_Galaxy.r @ 1:748b7a8b634c draft
Uploaded
author | iarc |
---|---|
date | Thu, 21 Apr 2016 09:36:32 -0400 |
parents | 8c682b3a7c5b |
children | 46a10309dfe2 |
line wrap: on
line source
#!/usr/bin/Rscript #-----------------------------------# # Author: Maude # # Script: mutationSpectra_Galaxy.r # # Last update: 23/07/15 # #-----------------------------------# ######################################################################################################################################### # Represent the mutation spectra with a bar graph # ######################################################################################################################################### #------------------------------------------------------------------------------- # Print a usage message if there is no argument pass to the command line #------------------------------------------------------------------------------- args <- commandArgs(TRUE) usage <- function() { msg <- paste0('Usage:\n', ' mutationSpectra_Galaxy.r input_Mutation_Spectra Sample_Name Output_Folder_High_Resolution Output_Folder_Low_Resolution Count_ca Count_cg Count_ta Count_tc Count_tg\n', '\ninput_Mutation_Spectra should be tab-separated: alteration context value\n', '\nOutput_Folder_High_Resolution: Folder for saving the high resolution image (display on the HTML page)\n', '\nOutput_Folder_Low_Resolution: Folder for saving the low resolution image (display on the Excel report)\n' ) cat(msg, '\n', file="/dev/stderr") quit(status=1) } input = args[length(args)] if (length(args) == 0) { usage() } #------------------------------------------------------------------------------- # Load library #------------------------------------------------------------------------------- suppressMessages(suppressWarnings(library(ggplot2))) suppressMessages(suppressWarnings(library(reshape))) suppressMessages(suppressWarnings(library(grid))) suppressMessages(suppressWarnings(library(scales))) suppressMessages(suppressWarnings(library(gridExtra))) #------------------------------------------------------------------------------- # Recover the arguments #------------------------------------------------------------------------------- input <- args[1] sampleName <- args[2] output_html <- args[3] output_report <- args[4] count_ca <- as.numeric(args[5]) count_cg <- as.numeric(args[6]) count_ct <- as.numeric(args[7]) count_ta <- as.numeric(args[8]) count_tc <- as.numeric(args[9]) count_tg <- as.numeric(args[10]) count_ca <- paste("C>A (", count_ca, ")") count_cg <- paste("C>G (", count_cg, ")") count_ct <- paste("C>T (", count_ct, ")") count_ta <- paste("T>A (", count_ta, ")") count_tc <- paste("T>C (", count_tc, ")") count_tg <- paste("T>G (", count_tg, ")") ############################################################################### # Load the functions # ############################################################################### #------------------------------------------------------------------------------- # Set the font depending on X11 availability #------------------------------------------------------------------------------- font <- "" # Check the device available device <- capabilities() # X11 is available if(device[5]) { font <- "Helvetica" } else { font <- "mono" } #------------------------------------------------------------------------------- # My own thme #------------------------------------------------------------------------------- theme_custom <- function(base_size = 12, base_family = "") { # Starts with theme_grey and then modify some parts theme_grey(base_size = base_size, base_family = base_family) %+replace% theme( axis.text = element_text(size = rel(1), family=font), axis.ticks = element_line(colour = "black"), axis.line = element_line(colour = "black", size = .5), legend.key = element_blank(), panel.background = element_blank(), panel.border = element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank() ) } #------------------------------------------------------------------------------- # Customize the theme for adding a y axis #------------------------------------------------------------------------------- mytheme <- theme_custom() mytheme$axis.line.x <- mytheme$axis.line.y <- mytheme$axis.line mytheme$axis.line.x$colour <- 'white' #------------------------------------------------------------------------------- # Set the decimal precision to 0.0 #------------------------------------------------------------------------------ fmt <- function() { function(x) format(x,nsmall = 1,scientific = FALSE, digits=1) } ############################################################################### # MAIN # ############################################################################### matrixW_inputggplot2 <- read.table(input, header=T) matrixW_melt <- melt(matrixW_inputggplot2) max_matrixW <- max(matrixW_inputggplot2[,3:ncol(matrixW_inputggplot2)]) p <- ggplot(matrixW_melt, aes(x=context, y=value, fill=alteration)) + geom_bar(stat="identity", width=0.5) + facet_grid(variable ~ alteration, scales="free_y") # Color the mutation like Alexandrov et al. p <- p + scale_fill_manual(values=c("blue", "black", "red", "#828282", "#00CC33", "pink")) # Remove the legend p <- p + guides(fill=FALSE) # customized theme (no background, no facet grid and strip, y axis only) p <- p + mytheme # Remove the title of the x facet strip p <- p + theme(strip.text.x=element_blank(), strip.text.y=element_blank()) # Remove the x axis label, thicks and title p <- p + theme(axis.title.x=element_blank(), axis.ticks.x=element_blank(), axis.title.y=element_text(size=15)) # Scale the y axis to the maximum value p <- p + scale_y_continuous(limits=c(0,max_matrixW), oob=squish, breaks=c(0,max_matrixW), labels=fmt()) # Rename the y axis p <- p + ylab("percent") # Add a title to the plot p <- p + ggtitle(sampleName) + theme(plot.title = element_text(vjust = 3.4, family=font)) # Add a top margin for writing the title of the plot p <- p + theme(plot.margin=unit(c(.7,0,0,0), "cm")) p <- p + scale_x_discrete(breaks = c("A_A","A_C","A_G","A_T", "C_A","C_C","C_G","C_T", "G_A","G_C","G_G","G_T", "T_A","T_C","T_G","T_T"), labels =c('A\nA',"\nC","\nG","\nT", 'C\nA',"\nC","\nG","\nT", 'G\nA',"\nC","\nG","\nT", 'T\nA',"\nC","\nG","\nT" ) ) #------------------------------------------------------------------------------------------------------------------------------ # Change the color of the facets for the mutation type #------------------------------------------------------------------------------------------------------------------------------ cols <- rep( c("blue", "black", "red", "#828282", "#00CC33", "pink")) # Facet strip colours # Make a grob object Pg <- ggplotGrob(p) # To keep track of strip.background grobs idx <- 0 # Find each strip.background and alter its backround colour for( g in 1:length(Pg$grobs) ) { if( grepl( "strip.absoluteGrob" , Pg$grobs[[g]]$name ) ) { idx <- idx + 1 sb <- which( grepl( "strip\\.background" , names( Pg$grobs[[g]]$children ) ) ) Pg$grobs[[g]]$children[[sb]][]$gp$fill <- cols[idx] } } # Reduce the size of the facet strip Pg$heights[[3]] = unit(.1,"cm") # Save the plot for the HTML page (higher resolution) graphics.off() # close graphics windows # Use cairo device as isn't possible to install X11 on the server... png(paste0(output_html, "/", sampleName, "-MutationSpectraPercent-Genomic.png"), width=3500, heigh=500, res=300, type=c("cairo-png")) plot(Pg) ## Add label for the mutation type above the strip facet grid.text(0.13, unit(0.90,"npc") - unit(1,"line"), label=count_ca) grid.text(0.29, unit(0.90,"npc") - unit(1,"line"), label=count_cg) grid.text(0.45, unit(0.90,"npc") - unit(1,"line"), label=count_ct) grid.text(0.6, unit(0.90,"npc") - unit(1,"line"), label=count_ta) grid.text(0.76, unit(0.90,"npc") - unit(1,"line"), label=count_tc) grid.text(0.92, unit(0.90,"npc") - unit(1,"line"), label=count_tg) invisible( dev.off() ) # Save the plot for the report png(paste0(output_report, "/", sampleName, "-MutationSpectraPercent-Genomic-Report.png"), width=1000, heigh=150, type=c("cairo-png")) plot(Pg) ## Add label for the mutation type above the strip facet grid.text(0.13, unit(0.90,"npc") - unit(1,"line"), label=count_ca) grid.text(0.29, unit(0.90,"npc") - unit(1,"line"), label=count_cg) grid.text(0.45, unit(0.90,"npc") - unit(1,"line"), label=count_ct) grid.text(0.6, unit(0.90,"npc") - unit(1,"line"), label=count_ta) grid.text(0.76, unit(0.90,"npc") - unit(1,"line"), label=count_tc) grid.text(0.92, unit(0.90,"npc") - unit(1,"line"), label=count_tg) invisible( dev.off() ) # Delete the empty plot created by the script if (file.exists("Rplots.pdf")) invisible( file.remove("Rplots.pdf") )