R/meta.plot.R

In suvarzz/MNuc: MNuc

#' @title TSS & ARS regions for metaplot
#'
#' These functions allows to create txt file with a list of TSS or ARS with a
#' given size.
#'
#' @param indir Input directory with means DAT files (mean.dat.gz) generated by
#'   \code{\link{meandata}} funcion.
#' @param outdir Output directory.
#' @param col.file Text file containing list of colors in the first column.
#' @param filename Name of output file.
#' @param curnames A vector containing desiered legend names. The order of names
#'   must correspond to the data in the mean.dat files.
#' @param ncur Numeric vector of lines to draw (e.g  c(2,4,6)). The first
#'   element in 'ncur' is a denominator if 'log' argument is TRUE.
#' @param labels Vector of names for multiple plot.
#' @param log Log2 of difference. The denominator is the first element in 'ncur'
#'   argument.
#' @param main Main header of the plot.
#' @param xlab X-axis lable.
#' @param ylab Y-axis lable.
#' @param xlim The x limits (x1, x2) of the plot.
#' @param ylim The y limins (y1, y2) of the plot.
#' @param legendpos Position of the legend. Possible values: "bottomright",
#'   "bottom", "bottomleft", "left", "topleft", "top", "topright", "right",
#'   "center".
#'
#' @return None
#'
#' @seealso \code{\link{meta.data}}, \code{\link{meandata}}
#' 
#' @author Mark Boltengagen \email{m.boltengagen@@gmail.com}
#' 
#' @export
#' 

### META_PLOT

meta.plot <- function (indir,
                       outdir,
                       col.file,
                       filename = "Meta_plot",
                       curnames = NULL,
                       ncur = NULL,
                       labels = NULL,
                       log = FALSE,
                       smooth = FALSE,
                       spar = 0.85,
                       setmin = FALSE,
                       setmink = FALSE,
                       main = "Meta Plot",
                       xlab = "Distance from feature, bp",
                       ylab = "Signal",
                       xlim = NULL,
                       ylim = NULL,
                       legendpos = c("bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right", "center"),
                       las = 1,		 # labels orientations (all horizontal)
                       cex.lab = 1,	
                       cex.axis = 1)
{
    if (is.null(indir) | is.null(outdir)) stop("Specify \"indir\" and \"outdir\" input and output directories.")
    legendpos <- match.arg(legendpos)
    
    ## READ FILES, get data and keep the first (coordinates) and the last (averages) of data
    files <- list.files(path=indir, pattern="*.dat.gz", full.names=T, recursive=FALSE)
    data <- lapply(1:length(files), function(f) {
        df <- read.table(files[f], header=TRUE, sep="\t", na.strings="NA", check.names=TRUE)
    })
    if (!all(apply(sapply(data, dim), 1, function(x) length(unique(x)) == 1) == TRUE)) stop("Dimentions of data in files are different.")
    if (is.null(ncur)) ncur <- 1:(ncol(data[[1]])-1)
    if (is.null(curnames)) {
        curnames = strtrim(colnames(data[[1]][,2:ncol(data[[1]])]), 17)
    }
    curnames = curnames[ncur]
    
    ## Read colors from file and take the last colors
    colors <- as.vector(read.table(col.file)[,1])
    colors <- tail(colors, n=(ncol(data[[1]])-1))
    
    ##### Normalizing 'on the way'
    if (setmin ==  TRUE & setmink == TRUE) stop("Set TRUE for \"setmin\" OR \"setmik\" for normalization.")
    ## Set minimal values for all curves on same level by subtraction
    if(setmin) {
        data <- lapply(data, FUN=MNuc::setmin.dat)
    }
    if(setmink) {
        data <- lapply(data, FUN=MNuc::setmink.dat)
    }
    
    ## GRAPHICAL PARAMETERS
    ## get coordinates and values limits
    if (is.null(xlim)) {
        all_coord <- unlist(lapply(data, '[', 1 ))
        xlim <- c(min(all_coord), max(all_coord))
    } 
    
    if (is.null(ylim) & log==FALSE) {
        all_values <- unlist(lapply(data, '[', 2:ncol(data[[1]])))
        ylim <- c(min(all_values), max(all_values))
    }
    if (is.null(ylim) & log==TRUE) {
        logmin <- min(unlist(lapply(data, function(x) min(log2((x[,(tail(ncur,-1)+1)]/x[,(ncur[1]+1)]))))))
        logmax <- max(unlist(lapply(data, function(x) max(log2((x[,(tail(ncur,-1)+1)]/x[,(ncur[1]+1)]))))))
        ylim <- c(logmin, logmax)
    }
    
    ##### Draw plot for all files
    dir.create(outdir, recursive=TRUE, showWarnings = FALSE)
    cols=ceiling(length(files))
    rows=ceiling(length(files)/cols)
    
    
    # PDF
    pdf(paste(outdir, filename, ".pdf", sep=""), width=3*cols, height=3*rows, pointsize=5)
    par(mfrow=c(rows, cols), cex=1, mar=c(4.1,4.1,2.1,1.1), oma=c(0,0,2,0))
    
    for (f in 1:length(data)) {
        ## Empty plot
        plot(1, type = "n",
             xlim=xlim,
             ylim=ylim,
             xlab=xlab,
             ylab=ylab,
             las=las,
             cex.lab=cex.lab,
             cex.axis=cex.axis)
        
        # Header for each plot
        title(labels[f], line=0.5, cex.main=1)
        
        for (l in ncur) {
            x = data[[f]][,1]
            if(log==FALSE) { 
                y = data[[f]][,(l+1)]
            } else if (log==TRUE ) {
                # The first element in ncur determine the denominator
                y = log2(data[[f]][,(l+1)] / data[[f]][,(ncur[1]+1)])
            }
            
            # Draw lines
            if (smooth == FALSE) {
                lines(x,y , col=colors[l])
            } else if (smooth == TRUE) {
                lines(smooth.spline(x,y, spar=spar), col=colors[l])
            }
            
        }
        
        ##### LEGEND
        legend(legendpos, curnames,
               ncol=ifelse(length(ncur) > 5, 2, 1),
               lty=rep(1, times=length(ncur)),	# line type
               lwd=rep(2, times=length(ncur)),	# line width
               col=colors[ncur])
    }
    # Main title
    title(main, outer=TRUE, cex.main=1.5)
    
    dev.off()
}