R/isovision.R
In jsicherman/IsoVision2: Create Isoform Plots
Defines functions
isovision
Documented in
isovision
#' IsoVision
#'
#' @param data Data generated by \code{isoviz_data}.
#' @param whichIsoforms A character vector of isoform names or an integer vector for isoform ranks to visualize. If null, plots all isoforms.
#' @param main The title.
#' @param main.cex The \code{cex} graphical parameter for the title.
#' @param use.barplot Whether or not to plot a barplot of total reads next to the track.
#' @param barplot.width The relative width of the barplot (0.0 to 1.0).
#' @param barplot.fill A vector of colors for the bars. Passed to the R barplot function.
#' @param barplot.border A vector of colors for the border of the bars. Passed to the R barplot function.
#' @param line.color The color of the track lines as a vector of the same length of the number of isoforms, an RColorBrewer palette or a single value.
#' @param intron.reduction The reduction factor for intron widths to ensure long introns are shrunk for plotting.
#' @param n.chunks The number of chunks to split the line into for intron scaling. Higher numbers mean more intron reduction.
#' @param orf.lwd The border weight for exons in the ORF.
#' @param orf.lty The border line type for exons in the ORF.
#' @param norf.lwd The border weight for exons not in the ORF.
#' @param norf.lty The border line type for exons not in the ORF.
#' @param mar The margin.
#' @param terminal.style The drawing style for the terminal exons. Options include "arrow" and "triangle". Any other value will draw a normal rectangular exon.
#' @param terminal.fill The fill color of the terminal exons.
#' @param terminal.border The border color of the terminal exons.
#' @param default.fill The fill color of exons without any annotations.
#' @param default.border The border color of exons without any annotations.
#' @param legend.values A named character with names set to domain annotation names present in \code{data} and values set to the preferred "pretty print" name that will show in the legend.
#' @param legend.colors Colors to be applied to domain annotations. Will be applied sequentially in the order that domains are defined in \code{legend.values}. Colors will be recycled if length is less than the number of domains in \code{legend.values}. Can also be an RColorBrewer palette.
#' @param filename The name to save this plot as.
#' @param width The width, in inches.
#' @param height The height, in inches.
isovision <- function(data, whichIsoforms = NULL, main = NULL, main.cex = 2,
use.barplot = T, barplot.width = 0.1, barplot.fill = 'white', barplot.border = 'black',
line.color = 'black', intron.reduction = 0.9, n.chunks = 1000,
orf.lwd = 1.5, orf.lty = 1, norf.lwd = 1, norf.lty = 4, mar = 0.1,
terminal.style = 'triangle', terminal.fill = 'white', terminal.border = 'black', default.fill = 'white', default.border = 'black',
legend.values = NULL, legend.colors = 'Set3',
filename = 'Rplots.pdf', width = 11, height = 8.5) {
require(RColorBrewer)
require(data.table)
require(dplyr)
use.barplot <- use.barplot && 'total' %in% colnames(data)
lighterColor <- function(color) {
innerColor <- col2rgb(color)
innerColor <- innerColor + (255 - innerColor) * 0.9
rgb(t(innerColor), maxColorValue = 255)
}
if(endsWith(filename, '.pdf'))
pdf(filename, width, height)
else if(endsWith(filename, '.jpg') || endsWith(filename, '.jpeg'))
jpeg(filename, width, height)
else if(endsWith(filename, '.png'))
png(filename, width, height)
if(is.character(whichIsoforms))
data <- data[isoformName %in% whichIsoforms]
else if(is.numeric(whichIsoforms)) {
data <- data[isoformName %in% data[, unique(isoformName)][whichIsoforms]]
if(!('total' %in% colnames(data)))
message('Ranks were not associated in isoviz_data. Top N variants are arbitrary!')
}
if(is.null(legend.values)) {
cols <- which(!(colnames(data) %in% c('isoformName', 'start', 'end', 'cStart', 'cEnd', 'ORF', 'total', 'ratio_total_reads')))
if(length(cols) > 0) {
legend.present <- colnames(data[, ..cols])[colSums(data[, ..cols] > 0) > 0]
legend.values <- setNames(legend.present, legend.present)
}
}
N <- length(data[, unique(isoformName)])
if(!is.null(legend.values))
legend <- names(legend.values)
plot.layout <- rbind(switch(use.barplot + 1, 1, rep(1, 2)),
cbind(switch(use.barplot + 1, NULL, N + 2), 2:(N + 1)),
switch(is.null(legend.values) + 1, switch(use.barplot + 1, N + 2, c(N + 4, N + 3)), NULL))
layout(plot.layout,
switch(use.barplot + 1, 1, c(barplot.width, 1 - barplot.width)))
# Shrink in chunks
if(n.chunks > 1 && intron.reduction != 0) {
chunks <- data.frame(start = seq(min(data[, cStart]), max(data[, cEnd]), length.out = n.chunks + 1))
chunks$end <- c(chunks$start[-1], max(data[, cEnd]))
data <- copy(data)
data[, c('chunk', 'tmp') := list('0', 1:nrow(data))]
for(c in 1:n.chunks) {
data[cEnd > chunks$start[c] & cStart < chunks$end[c], c('chunk', 'maxChunk') := list(paste(chunk, c, sep = ','), c)]
}
data.chunks <- data[, sapply(strsplit(chunk, ','), as.integer), tmp]
for(c in 1:n.chunks) {
if(sum(data.chunks == c) == 0)
data[maxChunk >= c, cStart := cStart - (chunks$end[c] - chunks$start[c]) * intron.reduction]
}
}
plot.range <- c(min(data[, cStart]), max(data[, max(cStart + end - start)]))
par(mar = c(mar, switch(use.barplot + 1, mar, mar * 2), mar * 2, mar))
plot(plot.range, c(0, 10), type = 'n', xlab = '', ylab = '', axes = F)
title(main, cex.main = main.cex)
par(mar = rep(mar, 4))
if(!is.null(legend.colors) && !is.null(legend.values))
legend.colors <- tryCatch(brewer.pal(length(legend.values), legend.colors), error = function(x) legend.colors)
line.color <- tryCatch(brewer.pal(N, line.color), error = function(x) line.color)
lapply(1:N, function(iso) {
isoform <- data[, unique(isoformName)][iso]
subset <- data[isoformName == isoform]
plot(plot.range, c(0, 100), type = 'n', xlab = '', ylab = '', axes = F)
segments(plot.range[1], 50, plot.range[2], 50, col = switch((length(line.color) == 1) + 1, line.color[iso], line.color))
lapply(1:nrow(subset), function(exon) {
len <- subset[exon, end - start]
r <- as.matrix(subset[exon, .(cStart, cStart + len)])
xs <- c(r[1], r[2], r[2], r[1], r[1])
ys <- c(0, 0, 100, 100, 0)
if(is.null(legend.colors))
outerColor <- NULL
else
outerColor <- legend.colors[which(as.matrix(subset[exon, ..legend]))]
if(length(outerColor) == 0) {
outerColor <- default.border
innerColor <- default.fill
} else
innerColor <- lighterColor(outerColor)
if(subset[exon, cStart] == data[, min(cStart)] || subset[exon, cEnd] == data[, max(cEnd)]) {
innerColor <- terminal.fill
outerColor <- terminal.border
if(terminal.style == 'arrow') {
xs <- c(r[1], r[1] + 0.7 * len, r[1] + 0.7 * len, r[2],
r[1] + 0.7 * len, r[1] + 0.7 * len, r[1], r[1])
ys <- c(33, 33, 0, 50, 100, 66, 66, 33)
} else if(terminal.style == 'triangle') {
xs <- c(r[1], r[1] + 0.8 * len, r[2], r[1] + 0.8 * len,
r[1], r[1])
ys <- c(0, 0, 50, 100, 100, 0)
}
}
inORF <- T
if('ORF' %in% colnames(subset))
inORF <- subset[exon, ORF]
polygon(xs, ys, border = outerColor, col = innerColor,
lty = switch(inORF + 1, norf.lty, orf.lty), lwd = switch(inORF + 1, norf.lwd, orf.lwd))
})
})
# Barplot
if(use.barplot) {
barplot(unique(data[, -ratio_total_reads, isoformName]) %>% .[, V1] %>% rev,
horiz = T, col = rev(barplot.fill), border = rev(barplot.border),
xlim = c(-max(data[, ratio_total_reads]) * 1.2, -min(data[, ratio_total_reads]) * 0.66),
xaxs = 'i', yaxs = 'i', axes = F, mar = c(mar, 4.1, mar, mar))
axis(side = 1,
labels = paste0(round(c(max(data[, ratio_total_reads]), min(data[, ratio_total_reads]) * 0.66) * 100, 2), '%'),
at = -c(max(data[, ratio_total_reads]), min(data[, ratio_total_reads]) * 0.66))
}
# Legend
if(!is.null(legend.values) && length(legend.values) > 0) {
plot(c(0, 100), c(0, 100), type = 'n', xlab = '', ylab = '', axes = F)
legend(0, 50, legend.values, sapply(legend.colors, lighterColor), border = legend.colors, bty = 'n', horiz = T)
}
dev.off()
}
jsicherman/IsoVision2 documentation built on June 10, 2020, 12:35 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions isovision
Documented in isovision
#' IsoVision
#'
#' @param data Data generated by \code{isoviz_data}.
#' @param whichIsoforms A character vector of isoform names or an integer vector for isoform ranks to visualize. If null, plots all isoforms.
#' @param main The title.
#' @param main.cex The \code{cex} graphical parameter for the title.
#' @param use.barplot Whether or not to plot a barplot of total reads next to the track.
#' @param barplot.width The relative width of the barplot (0.0 to 1.0).
#' @param barplot.fill A vector of colors for the bars. Passed to the R barplot function.
#' @param barplot.border A vector of colors for the border of the bars. Passed to the R barplot function.
#' @param line.color The color of the track lines as a vector of the same length of the number of isoforms, an RColorBrewer palette or a single value.
#' @param intron.reduction The reduction factor for intron widths to ensure long introns are shrunk for plotting.
#' @param n.chunks The number of chunks to split the line into for intron scaling. Higher numbers mean more intron reduction.
#' @param orf.lwd The border weight for exons in the ORF.
#' @param orf.lty The border line type for exons in the ORF.
#' @param norf.lwd The border weight for exons not in the ORF.
#' @param norf.lty The border line type for exons not in the ORF.
#' @param mar The margin.
#' @param terminal.style The drawing style for the terminal exons. Options include "arrow" and "triangle". Any other value will draw a normal rectangular exon.
#' @param terminal.fill The fill color of the terminal exons.
#' @param terminal.border The border color of the terminal exons.
#' @param default.fill The fill color of exons without any annotations.
#' @param default.border The border color of exons without any annotations.
#' @param legend.values A named character with names set to domain annotation names present in \code{data} and values set to the preferred "pretty print" name that will show in the legend.
#' @param legend.colors Colors to be applied to domain annotations. Will be applied sequentially in the order that domains are defined in \code{legend.values}. Colors will be recycled if length is less than the number of domains in \code{legend.values}. Can also be an RColorBrewer palette.
#' @param filename The name to save this plot as.
#' @param width The width, in inches.
#' @param height The height, in inches.
isovision <- function(data, whichIsoforms = NULL, main = NULL, main.cex = 2,
use.barplot = T, barplot.width = 0.1, barplot.fill = 'white', barplot.border = 'black',
line.color = 'black', intron.reduction = 0.9, n.chunks = 1000,
orf.lwd = 1.5, orf.lty = 1, norf.lwd = 1, norf.lty = 4, mar = 0.1,
terminal.style = 'triangle', terminal.fill = 'white', terminal.border = 'black', default.fill = 'white', default.border = 'black',
legend.values = NULL, legend.colors = 'Set3',
filename = 'Rplots.pdf', width = 11, height = 8.5) {
require(RColorBrewer)
require(data.table)
require(dplyr)
use.barplot <- use.barplot && 'total' %in% colnames(data)
lighterColor <- function(color) {
innerColor <- col2rgb(color)
innerColor <- innerColor + (255 - innerColor) * 0.9
rgb(t(innerColor), maxColorValue = 255)
}
if(endsWith(filename, '.pdf'))
pdf(filename, width, height)
else if(endsWith(filename, '.jpg') || endsWith(filename, '.jpeg'))
jpeg(filename, width, height)
else if(endsWith(filename, '.png'))
png(filename, width, height)
if(is.character(whichIsoforms))
data <- data[isoformName %in% whichIsoforms]
else if(is.numeric(whichIsoforms)) {
data <- data[isoformName %in% data[, unique(isoformName)][whichIsoforms]]
if(!('total' %in% colnames(data)))
message('Ranks were not associated in isoviz_data. Top N variants are arbitrary!')
}
if(is.null(legend.values)) {
cols <- which(!(colnames(data) %in% c('isoformName', 'start', 'end', 'cStart', 'cEnd', 'ORF', 'total', 'ratio_total_reads')))
if(length(cols) > 0) {
legend.present <- colnames(data[, ..cols])[colSums(data[, ..cols] > 0) > 0]
legend.values <- setNames(legend.present, legend.present)
}
}
N <- length(data[, unique(isoformName)])
if(!is.null(legend.values))
legend <- names(legend.values)
plot.layout <- rbind(switch(use.barplot + 1, 1, rep(1, 2)),
cbind(switch(use.barplot + 1, NULL, N + 2), 2:(N + 1)),
switch(is.null(legend.values) + 1, switch(use.barplot + 1, N + 2, c(N + 4, N + 3)), NULL))
layout(plot.layout,
switch(use.barplot + 1, 1, c(barplot.width, 1 - barplot.width)))
# Shrink in chunks
if(n.chunks > 1 && intron.reduction != 0) {
chunks <- data.frame(start = seq(min(data[, cStart]), max(data[, cEnd]), length.out = n.chunks + 1))
chunks$end <- c(chunks$start[-1], max(data[, cEnd]))
data <- copy(data)
data[, c('chunk', 'tmp') := list('0', 1:nrow(data))]
for(c in 1:n.chunks) {
data[cEnd > chunks$start[c] & cStart < chunks$end[c], c('chunk', 'maxChunk') := list(paste(chunk, c, sep = ','), c)]
}
data.chunks <- data[, sapply(strsplit(chunk, ','), as.integer), tmp]
for(c in 1:n.chunks) {
if(sum(data.chunks == c) == 0)
data[maxChunk >= c, cStart := cStart - (chunks$end[c] - chunks$start[c]) * intron.reduction]
}
}
plot.range <- c(min(data[, cStart]), max(data[, max(cStart + end - start)]))
par(mar = c(mar, switch(use.barplot + 1, mar, mar * 2), mar * 2, mar))
plot(plot.range, c(0, 10), type = 'n', xlab = '', ylab = '', axes = F)
title(main, cex.main = main.cex)
par(mar = rep(mar, 4))
if(!is.null(legend.colors) && !is.null(legend.values))
legend.colors <- tryCatch(brewer.pal(length(legend.values), legend.colors), error = function(x) legend.colors)
line.color <- tryCatch(brewer.pal(N, line.color), error = function(x) line.color)
lapply(1:N, function(iso) {
isoform <- data[, unique(isoformName)][iso]
subset <- data[isoformName == isoform]
plot(plot.range, c(0, 100), type = 'n', xlab = '', ylab = '', axes = F)
segments(plot.range[1], 50, plot.range[2], 50, col = switch((length(line.color) == 1) + 1, line.color[iso], line.color))
lapply(1:nrow(subset), function(exon) {
len <- subset[exon, end - start]
r <- as.matrix(subset[exon, .(cStart, cStart + len)])
xs <- c(r[1], r[2], r[2], r[1], r[1])
ys <- c(0, 0, 100, 100, 0)
if(is.null(legend.colors))
outerColor <- NULL
else
outerColor <- legend.colors[which(as.matrix(subset[exon, ..legend]))]
if(length(outerColor) == 0) {
outerColor <- default.border
innerColor <- default.fill
} else
innerColor <- lighterColor(outerColor)
if(subset[exon, cStart] == data[, min(cStart)] || subset[exon, cEnd] == data[, max(cEnd)]) {
innerColor <- terminal.fill
outerColor <- terminal.border
if(terminal.style == 'arrow') {
xs <- c(r[1], r[1] + 0.7 * len, r[1] + 0.7 * len, r[2],
r[1] + 0.7 * len, r[1] + 0.7 * len, r[1], r[1])
ys <- c(33, 33, 0, 50, 100, 66, 66, 33)
} else if(terminal.style == 'triangle') {
xs <- c(r[1], r[1] + 0.8 * len, r[2], r[1] + 0.8 * len,
r[1], r[1])
ys <- c(0, 0, 50, 100, 100, 0)
}
}
inORF <- T
if('ORF' %in% colnames(subset))
inORF <- subset[exon, ORF]
polygon(xs, ys, border = outerColor, col = innerColor,
lty = switch(inORF + 1, norf.lty, orf.lty), lwd = switch(inORF + 1, norf.lwd, orf.lwd))
})
})
# Barplot
if(use.barplot) {
barplot(unique(data[, -ratio_total_reads, isoformName]) %>% .[, V1] %>% rev,
horiz = T, col = rev(barplot.fill), border = rev(barplot.border),
xlim = c(-max(data[, ratio_total_reads]) * 1.2, -min(data[, ratio_total_reads]) * 0.66),
xaxs = 'i', yaxs = 'i', axes = F, mar = c(mar, 4.1, mar, mar))
axis(side = 1,
labels = paste0(round(c(max(data[, ratio_total_reads]), min(data[, ratio_total_reads]) * 0.66) * 100, 2), '%'),
at = -c(max(data[, ratio_total_reads]), min(data[, ratio_total_reads]) * 0.66))
}
# Legend
if(!is.null(legend.values) && length(legend.values) > 0) {
plot(c(0, 100), c(0, 100), type = 'n', xlab = '', ylab = '', axes = F)
legend(0, 50, legend.values, sapply(legend.colors, lighterColor), border = legend.colors, bty = 'n', horiz = T)
}
dev.off()
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.