Mercurial > repos > artbio > probecoverage
comparison probecoverage.r @ 0:3c0451ca266e draft
"planemo upload for repository https://github.com/ARTbio/tools-artbio/tree/master/tools/probecoverage commit 62a8b073b9ac98b0231641e5266768e7f8b80b89"
| author | artbio |
|---|---|
| date | Tue, 07 Jan 2020 11:08:31 +0000 |
| parents | |
| children | 9eb4a7000c1e |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:3c0451ca266e |
|---|---|
| 1 ## Setup R error handling to go to stderr | |
| 2 options( show.error.messages=F, | |
| 3 error = function () { cat( geterrmessage(), file=stderr() ); q( "no", 1, F ) } ) | |
| 4 warnings() | |
| 5 library(optparse) | |
| 6 library(ggplot2) | |
| 7 library(reshape2) | |
| 8 | |
| 9 option_list <- list( | |
| 10 make_option(c("-i", "--input"), type="character", help="Path to dataframe"), | |
| 11 make_option(c("-t", "--title"), type="character", help="Main Title"), | |
| 12 make_option("--xlab", type = "character", help="X-axis legend"), | |
| 13 make_option("--ylab", type = "character", help="Y-axis legend"), | |
| 14 make_option("--sample", type = "character", help="a space separated of sample labels"), | |
| 15 make_option("--method", type = "character", help="bedtools or pysam"), | |
| 16 make_option(c("-o", "--output"), type = "character", help="path to the pdf plot") | |
| 17 ) | |
| 18 | |
| 19 parser <- OptionParser(usage = "%prog [options] file", option_list = option_list) | |
| 20 args = parse_args(parser) | |
| 21 samples = substr(args$sample, 2, nchar(args$sample)-2) | |
| 22 samples = strsplit(samples, ", ") | |
| 23 | |
| 24 # data frames implementation | |
| 25 | |
| 26 Table <- read.delim(args$input, header=F) | |
| 27 headers = c("chromosome", "start", "end", "id") | |
| 28 for (i in seq(1, length(Table)-4)) { | |
| 29 headers <- c(headers, samples[[1]][i]) | |
| 30 colnames(Table) <- headers | |
| 31 } | |
| 32 | |
| 33 ## function | |
| 34 if (args$method == 'bedtools') { | |
| 35 cumul <- function(x,y) sum(Table[,y]/(Table$end-Table$start) > x)/length(Table$chromosome) | |
| 36 } else { | |
| 37 cumul <- function(x,y) sum(Table[,y] > x)/length(Table$chromosome) | |
| 38 } | |
| 39 scaleFUN <- function(x) sprintf("%.3f", x) | |
| 40 | |
| 41 ## end of function | |
| 42 ## let's do a dataframe before plotting | |
| 43 if (args$method == 'bedtools') { | |
| 44 maxdepth <- trunc(max(Table[,5:length(Table)]/(Table$end-Table$start))) + 20 | |
| 45 } else { | |
| 46 maxdepth <- trunc(max(Table[,5:length(Table)])) + 20 | |
| 47 } | |
| 48 | |
| 49 graphpoints <- data.frame(1:maxdepth) | |
| 50 i <- 5 | |
| 51 for (colonne in colnames(Table)[5:length(colnames(Table))]) { | |
| 52 graphpoints <- cbind(graphpoints, mapply(cumul, 1:maxdepth, rep(i, maxdepth))) | |
| 53 i <- i + 1 | |
| 54 } | |
| 55 colnames(graphpoints) <- c("Depth", colnames(Table)[5:length(Table)]) | |
| 56 maxfrac = max(graphpoints[,2:length(graphpoints)]) | |
| 57 | |
| 58 graphpoints <- melt(graphpoints, id.vars="Depth", variable.name="Samples", value.name="sample_value") | |
| 59 | |
| 60 ## GRAPHS | |
| 61 | |
| 62 pdf(file=args$output) | |
| 63 ggplot(data=graphpoints, aes(x=Depth, y=sample_value, colour=Samples)) + | |
| 64 geom_line(size=1) + | |
| 65 scale_x_continuous(trans='log2', breaks = 2^(seq(0,log(maxdepth, 2)))) + | |
| 66 scale_y_continuous(breaks = seq(0, maxfrac, by=maxfrac/10), labels=scaleFUN) + | |
| 67 labs(x=args$xlab, y=args$ylab, title=args$title) + | |
| 68 theme(legend.position="top", legend.title=element_blank(), legend.text=element_text(colour="blue", size=7)) | |
| 69 | |
| 70 | |
| 71 ## facet_wrap(~Samples, ncol=2) | |
| 72 | |
| 73 devname=dev.off() | |
| 74 |
