R/ReportPlot-methods.R

In RnBeads: RnBeads

########################################################################################################################
## ReportPlot-methods.R
## created: 2012-04-16
## creator: Yassen Assenov
## ---------------------------------------------------------------------------------------------------------------------
## ReportPlot class definition.
########################################################################################################################

## M E T H O D S #######################################################################################################

setValidity("ReportPlot",
	function(object) {
		if (object@fname == "") {
			return("file name must not be an empty character")
		}
		if (object@width <= 0) {
			return("width must be a positive value")
		}
		if (object@height <= 0) {
			return("height must be a positive value")
		}
#		if (!(object@create.pdf || object@low.png > 0 || object@high.png > 0)) {
#			return("no image type specified to create")
#		}
		TRUE
	}
)

########################################################################################################################

setMethod("initialize", "ReportPlot",
	function(.Object, fname="temp", report=NULL, width=7, height=7, create.pdf=FALSE, low.png=0L, high.png=0L, skip.dev.setup=FALSE) {
		.Object@fname <- fname
		.Object@width <- width
		.Object@height <- height
		.Object@create.pdf <- create.pdf
		.Object@low.png <- low.png
		.Object@high.png <- high.png
		## Use report to set directories
		if (!is.null(report)) {
			.Object@dir.pdf <- rnb.get.directory(report, "pdfs", absolute = TRUE)
			.Object@dir.png.low <- rnb.get.directory(report, "images", absolute = TRUE)
			.Object@dir.png.high <- rnb.get.directory(report, "images-high", absolute = TRUE)
		} else {
			.Object@dir.pdf <- getwd()
			.Object@dir.png.low <- getwd()
			.Object@dir.png.high <- getwd()
		}
		validObject(.Object)
		if (!skip.dev.setup){
			if (create.pdf) {
				validate.dir(.Object@dir.pdf)
				fn <- file.path(.Object@dir.pdf, paste0(fname, ".pdf"))
				pdf(fn, width = width, height = height)
			} else if (high.png > 0) {
				validate.dir(.Object@dir.png.high)
				if (low.png > 0 && .Object@dir.png.high == .Object@dir.png.low) {
					fname <- paste0(fname, "_high_resolution")
				}
				fn <- file.path(.Object@dir.png.high, paste0(fname, ".png"))
				png(fn, width = width * high.png, height = height * high.png)
			} else if (low.png > 0) {
				validate.dir(.Object@dir.png.low)
				fn <- file.path(.Object@dir.png.low, paste0(fname, ".png"))
				png(fn, width = width * low.png, height = height * low.png)
			} else {
				skip.dev.setup <- TRUE
			}
		}
		if (!skip.dev.setup) {
			dev.control(displaylist = "enable")
			par(mar = c(4, 4, 1, 1) + 0.1)
		}
		.Object
	}
)

########################################################################################################################

#' get.files
#'
#' Gets the list of all files that are planned to be generated, or were already generated by the given report plot.
#'
#' @param report.plot Report plot of interest. This must be an object of type \code{\linkS4class{ReportPlot}}.
#' @return Non-empty \code{character} vector of absolute file names.
#'
#' @examples
#' \donttest{
#' plot.image <- createReportPlot('scatterplot', high.png = 200)
#' get.files(plot.image)
#' }
#' @author Yassen Assenov
#' @export
get.files <- function(report.plot) {
	if (!inherits(report.plot, "ReportPlot")) {
		stop("invalid value for report.plot")
	}
	result <- character(0)
	fname <- report.plot@fname
	if (report.plot@create.pdf) {
		result <- file.path(report.plot@dir.pdf, paste(fname, "pdf", sep = "."))
	}
	if (report.plot@low.png > 0) {
		result <- c(result, file.path(report.plot@dir.png.low, paste(fname, "png", sep = ".")))
	}
	if (report.plot@high.png > 0) {
		if (report.plot@low.png && report.plot@dir.png.low == report.plot@dir.png.high) {
			fname <- paste(fname, "_high_resolution", sep = "")
		}
		result <- c(result, file.path(report.plot@dir.png.high, paste(fname, "png", sep = ".")))
	}
	return(result)
}

########################################################################################################################

#' @rdname off-methods
#' @export
setMethod("off", "ReportPlot",
	function(.Object) {
		convert.f <- function(fname, ...) {
			doerror <- function(e) {
				dev.off()
				em <- paste("Could not create file.", e$message)
				if (logger.isinitialized()) {
					logger.error(em)
				} else {
					stop(em)
				}
			}

			tryCatch(
				dev2bitmap(fname, type = "pngalpha", height = .Object@height, width = .Object@width,
					method = "pdf", ...),
				warning = function(e) {
					if (grepl(" had status 1$", e$message)) {
						doerror(e)
					} else if (logger.isinitialized()) {
						logger.warning(e$message)
					} else {
						invisible(e$message)
					}
				},
				error = doerror)
		}
		if (.Object@create.pdf) {
			if (.Object@high.png > 0) {
				validate.dir(.Object@dir.png.high)
				fname <- .Object@fname
				if (.Object@low.png > 0 && .Object@dir.png.high == .Object@dir.png.low) {
					fname <- paste0(fname, "_high_resolution")
				}
				fname <- file.path(.Object@dir.png.high, paste0(fname, ".png"))
				convert.f(fname, res = .Object@high.png, fonts = c("Helvetica", "sans"))
			}
			if (.Object@low.png > 0) {
				validate.dir(.Object@dir.png.low)
				fname <- file.path(.Object@dir.png.low, paste0(.Object@fname, ".png"))
				convert.f(fname, res = .Object@low.png, fonts = c("Helvetica", "sans"))
			}
		} else if (.Object@low.png > 0 && .Object@high.png > 0) {
			validate.dir(.Object@dir.png.low)
			fname <- file.path(.Object@dir.png.low, paste0(.Object@fname, ".png"))
			convert.f(fname, res = .Object@low.png)
		}
		dev.off()
		return(invisible(.Object))
	}
)

########################################################################################################################
########################################################################################################################

#' createReportPlot
#'
#' Initializes a report plot and opens a device to create it. The type of the device created depends on the
#' parameters \code{create.pdf}, \code{low.png} and \code{high.png}. If \code{create.pdf} is \code{TRUE}, a PDF device
#' is opened and its contents are later copied to PNG device(s) if needed. Otherwise, a PNG device is opened. Note that
#' at least one of the following conditions must be met:
#' \itemize{
#'   \item{}{\code{create.pdf == TRUE}}
#'   \item{}{\code{low.png > 0}}
#'   \item{}{\code{high.png > 0}}
#' }
#'
#' @param fname      \code{character} vector with one element storing the name of the output file, without the
#'                   extension. The initialized object appends \code{.pdf} and/or \code{.png} to this name.
#' @param report     Report (object of type \code{\linkS4class{Report}}) to which this plot is going to be added. This
#'                   is used to set the directories for PDF and/or PNG files generated for these plots. If this
#'                   parameter is \code{NULL}, the current working directory is used to host all generated images.
#' @param width      \code{numeric} storing the width of the device in inches. The length of this vector must be
#'                   \code{1}.
#' @param height     \code{numeric} storing the height of the device in inches. The length of this vector must be
#'                   \code{1}.
#' @param create.pdf Flag indicating if a PDF image is to be created. The length of this vector must be \code{1}.
#' @param low.png    Resolution, in dots per inch, used for the figure image. Set this to \code{0} or a negative value
#'                   to disable the creation of a low resolution image. The length of this vector must be \code{1}.
#' @param high.png   Resolution, in dots per inch, used for a dedicated image. Set this to \code{0} or a negative value
#'                   to disable the creation of a high resolution image. The length of this vector must be \code{1}.
#' @return Newly created \code{ReportPlot} object.
#'
#' @seealso \code{\link{pdf}} for manually initializing a graphics device; \code{\linkS4class{Report}} for other
#'   functions adding contents to an HTML report
#'
#' @examples
#' \donttest{
#' plot.image <- createReportPlot('scatterplot_tumors')
#' plot(x = c(0.4, 1), y = c(9, 3), type = 'p', main = NA, xlab = expression(beta), ylab = 'Measure')
#' off(plot.image)
#' }
#'
#' @details
#' In order to ensure independence of the operating system, there are strong restrictions on the name of the file. It
#' can consist of the following symbols only: Latin letters, digits, dot (\code{.}), dash (\code{-}) and underline
#' (\code{_}). The name must not include paths, that is, slash (\code{/}) or backslash (\code{\\}) cannot be used.
#'
#' @author Yassen Assenov
#' @export
createReportPlot <- function(fname, report = NULL, width = 7, height = 7, create.pdf = TRUE, low.png = 100L,
	high.png = 0L) {
	validate.vector <- function(x, vtype) {
		return(class(x) == vtype && length(x) == 1 && (!is.na(x)))
	}
	if (!validate.vector(fname, "character")) {
		stop("invalid value for fname")
	}
	if (!grepl("^[A-Za-z0-9._-]+$", fname)) {
		stop("invalid value for fname")
	}
	if (!(is.null(report) || class(report) == "Report")) {
		stop("invalid value for report")
	}
	if (is.integer(width)) {
		width <- as.numeric(width)
	}
	if (is.integer(height)) {
		height <- as.numeric(height)
	}
	if (!validate.vector(width, "numeric")) {
		stop("invalid value for width")
	}
	if (!validate.vector(height, "numeric")) {
		stop("invalid value for height")
	}
	if (!validate.vector(create.pdf, "logical")) {
		stop("invalid value for create.pdf")
	}
	if (is.numeric(low.png) && isTRUE(all(low.png == as.integer(low.png)))) {
		low.png <- as.integer(low.png)
	}
	if (!validate.vector(low.png, "integer")) {
		stop("invalid value for low.png")
	}
	if (is.numeric(high.png) && isTRUE(all(high.png == as.integer(high.png)))) {
		high.png <- as.integer(high.png)
	}
	if (!validate.vector(high.png, "integer")) {
		stop("invalid value for high.png")
	}
	## Initialize report plots
	return(new("ReportPlot", fname, report, width, height, create.pdf, low.png, high.png))
}



## ReportGgPlot M E T H O D S #######################################################################################################

setValidity("ReportGgPlot",
		function(object) {
			if (object@fname == "") {
				return("file name must not be an empty character")
			}
			if (object@width <= 0) {
				return("width must be a positive value")
			}
			if (object@height <= 0) {
				return("height must be a positive value")
			}
			if (!(is.ggplot(object@ggp) | is.null(object@ggp))){
				return("ggp must be a ggplot object")
			}
			TRUE
		}
)


setMethod("initialize", "ReportGgPlot",
		function(.Object, ggp=ggplot(), ...) {
			.Object <- callNextMethod(.Object=.Object,skip.dev.setup=TRUE,...)
			.Object@ggp <- ggp
			validObject(.Object)
			.Object
		}
)

#' @rdname off-methods
#' @export
setMethod("off", "ReportGgPlot",
	function(.Object,handle.errors=FALSE) {
		do.it <- function(obj){
			if (obj@create.pdf) {
				validate.dir(obj@dir.pdf)
				fn <- file.path(obj@dir.pdf, paste(obj@fname, "pdf", sep = "."))
				ggplot2::ggsave(fn,obj@ggp,width=obj@width,height=obj@height)
			}
			if (obj@high.png > 0) {
				validate.dir(obj@dir.png.high)
				fname <- obj@fname
				if (obj@low.png > 0 && obj@dir.png.high == obj@dir.png.low) {
					fname <- paste(fname, "_high_resolution", sep = "")
				}
				fn <- file.path(obj@dir.png.high, paste(fname, "png", sep = "."))
				ggplot2::ggsave(fn,obj@ggp,width=obj@width,height=obj@height,dpi=obj@high.png)
			}
			if (obj@low.png > 0) {
				validate.dir(obj@dir.png.low)
				fn <- file.path(obj@dir.png.low, paste(obj@fname, "png", sep = "."))
				ggplot2::ggsave(fn,obj@ggp,width=obj@width,height=obj@height,dpi=obj@low.png)
			}
		}
		if (handle.errors){
			tryCatch(
				do.it(.Object),
				error=function(ee){
					logger.warning(c("ReportGgPlot error ('off' method):",ee$message))
					.Object@ggp <<- rnb.message.plot("plotting error")
					do.it(.Object)
				}
			)
		} else {
			do.it(.Object)
		}
		.Object@ggp <- NULL
		return(invisible(.Object))
	}
)

#' createReportGgPlot
#'
#' creates a report plot containing a \code{ggplot object}. Except for the \code{ggp} parameter, the signature and
#' behavior is identical to \code{\link{createReportPlot}}.
#' 
#' @param ggp        \code{ggplot} object to be plotted
#' @param fname      \code{character} vector with one element storing the name of the output file, without the
#'                   extension. The initialized object appends \code{.pdf} and/or \code{.png} to this name.
#' @param report     Report (object of type \code{\linkS4class{Report}}) to which this plot is going to be added. This
#'                   is used to set the directories for PDF and/or PNG files generated for these plots. If this
#'                   parameter is \code{NULL}, the current working directory is used to host all generated images.
#' @param width      \code{numeric} storing the width of the device in inches. The length of this vector must be
#'                   \code{1}.
#' @param height     \code{numeric} storing the height of the device in inches. The length of this vector must be
#'                   \code{1}.
#' @param create.pdf Flag indicating if a PDF image is to be created. The length of this vector must be \code{1}.
#' @param low.png    Resolution, in dots per inch, used for the figure image. Set this to \code{0} or a negative value
#'                   to disable the creation of a low resolution image. The length of this vector must be \code{1}.
#' @param high.png   Resolution, in dots per inch, used for a dedicated image. Set this to \code{0} or a negative value
#'                   to disable the creation of a high resolution image. The length of this vector must be \code{1}.
#' @return Newly created \code{ReportGgPlot} object.
#'
#' @author Fabian Mueller
#' @export
createReportGgPlot <- function(ggp, fname, report = NULL, width = 7, height = 7, create.pdf = TRUE, low.png = as.integer(100),
		high.png = as.integer(0)) {
	validate.vector <- function(x, vtype) {
		return(class(x) == vtype && length(x) == 1 && (!is.na(x)))
	}
	if (!is.ggplot(ggp)){
		stop("invalid value for ggp")
	}
	if (!validate.vector(fname, "character")) {
		stop("invalid value for fname")
	}
	if (!grepl("^[A-Za-z0-9._-]+$", fname)) {
		stop("invalid value for fname")
	}
	if (!(is.null(report) || class(report) == "Report")) {
		stop("invalid value for report")
	}
	if (is.integer(width)) {
		width <- as.numeric(width)
	}
	if (is.integer(height)) {
		width <- as.numeric(height)
	}
	if (!validate.vector(width, "numeric")) {
		stop("invalid value for width")
	}
	if (!validate.vector(height, "numeric")) {
		stop("invalid value for width")
	}
	if (!validate.vector(create.pdf, "logical")) {
		stop("invalid value for create.pdf")
	}
	if (is.numeric(low.png) && isTRUE(all(low.png == as.integer(low.png)))) {
		low.png <- as.integer(low.png)
	}
	if (!validate.vector(low.png, "integer")) {
		stop("invalid value for low.png")
	}
	if (is.numeric(high.png) && isTRUE(all(high.png == as.integer(high.png)))) {
		high.png <- as.integer(high.png)
	}
	if (!validate.vector(high.png, "integer")) {
		stop("invalid value for high.png")
	}
	## Initialize report plots
	return(new("ReportGgPlot", ggp, fname, report, width, height, create.pdf, low.png, high.png))
}