#' Plot a Hi-C interaction matrix in a square format
#'
#' @usage plotHicSquare(
#' data,
#' resolution = "auto",
#' zrange = NULL,
#' norm = "KR",
#' matrix = "observed",
#' chrom,
#' chromstart = NULL,
#' chromend = NULL,
#' altchrom = NULL,
#' altchromstart = NULL,
#' altchromend = NULL,
#' assembly = "hg38",
#' palette = colorRampPalette(brewer.pal(n = 9, "YlGnBu")),
#' colorTrans = "linear",
#' half = "both",
#' yaxisDir = "increase",
#' bg = NA,
#' x = NULL,
#' y = NULL,
#' width = NULL,
#' height = NULL,
#' just = c("left", "top"),
#' default.units = "inches",
#' draw = TRUE,
#' params = NULL,
#' quiet = FALSE
#' )
#'
#' @param data Path to .hic file as a string or a 3-column dataframe of
#' interaction counts in sparse upper triangular format.
#' @param resolution A numeric specifying the width in
#' basepairs of each pixel. For hic files, "auto" will attempt
#' to choose a resolution based on the size of the region. For
#' dataframes, "auto" will attempt to detect the resolution the
#' dataframe contains.
#' @param zrange A numeric vector of length 2 specifying the range
#' of interaction scores to plot, where extreme values will be set
#' to the max or min.
#' @param norm Character value specifying hic data normalization method,
#' if giving .hic file. This value must be found in the .hic file.
#' Default value is \code{norm = "KR"}.
#' @param matrix Character value indicating the type of matrix to output.
#' Default value is \code{matrix = "observed"}. Options are:
#' \itemize{
#' \item{\code{"observed"}: }{Observed counts.}
#' \item{\code{"oe"}: }{Observed/expected counts.}
#' \item{\code{"log2oe"}: }{Log2 transformed observed/expected counts.}
#' }
#' @param chrom Chromosome of region to be plotted, as a string.
#' @param chromstart Integer start position on chromosome to be plotted.
#' @param chromend Integer end position on chromosome to be plotted.
#' @param altchrom Alternate chromosome for off-diagonal plotting
#' or interchromosomal plotting, as a string.
#' @param altchromstart Alternate chromosome integer start position
#' for off-diagonal plotting or interchromosomal plotting.
#' @param altchromend Alternate chromosome integer end position
#' for off-diagonal plotting or interchromosomal plotting.
#' @param assembly Default genome assembly as a string or a
#' \link[plotgardener]{assembly} object.
#' Default value is \code{assembly = "hg38"}.
#' @param palette A function describing the color palette to use for
#' representing scale of interaction scores.
#' Default value is
#' \code{palette = colorRampPalette(brewer.pal(n = 9, "YlGnBu"))}.
#' @param colorTrans A string specifying how to scale Hi-C colors.
#' Options are "linear", "log", "log2", or "log10".
#' Default value is \code{colorTrans = "linear"}.
#' @param half A character value indicating which diagonal regions to plot.
#' For intrachromosomal plotting, options are \code{"both"}, \code{"top"},
#' or \code{"bottom"}. For off-diagonal or interchromosomal plotting,
#' options are \code{"top"} or \code{"bottom"}.
#' Default value is \code{half = "both"}.
#' \itemize{
#' \item{\code{"both"}: }{Both diagonal halves.}
#' \item{\code{"top"}: }{Half above the diagonal.}
#' \item{\code{"bottom"}: }{Half below the diagonal.}
#' }
#' @param yaxisDir A string specifying the genomic direction of the y-axis.
#' Options are \code{"increase"}, where the bottom left corner of the Hi-C map
#' indicates the origin, and \code{"decrease"}, where the top left corner of the
#' Hi-C map indicates the origin. This will change the direction of the diagonal
#' for intrachromosomal maps.
#' Default value is \code{yaxisDir = "increase"}.
#' @param bg Character value indicating background color.
#' Default value is \code{bg = NA}.
#' @param x A numeric or unit object specifying square Hi-C plot x-location.
#' @param y A numeric, unit object, or character containing a "b" combined
#' with a numeric value specifying square Hi-C plot y-location.
#' The character value will
#' place the square Hi-C plot y relative to the bottom of the most recently
#' plotted plot according to the units of the plotgardener page.
#' @param width A numeric or unit object specifying square Hi-C plot width.
#' @param height A numeric or unit object specifying square Hi-C plot height.
#' @param just Justification of square Hi-C plot relative to
#' its (x, y) location. If there are two values, the first value specifies
#' horizontal justification and the second value specifies vertical
#' justification.
#' Possible string values are: \code{"left"}, \code{"right"},
#' \code{"centre"}, \code{"center"}, \code{"bottom"}, and \code{"top"}.
#' Default value is \code{just = c("left", "top")}.
#' @param default.units A string indicating the default units to use if
#' \code{x}, \code{y}, \code{width}, or \code{height} are only given as
#' numerics. Default value is \code{default.units = "inches"}.
#' @param draw A logical value indicating whether graphics output should be
#' produced. Default value is \code{draw = TRUE}.
#' @param params An optional \link[plotgardener]{pgParams} object containing
#' relevant function parameters.
#' @param quiet A logical indicating whether or not to print messages.
#'
#' @return Returns a \code{hicSquare} object containing relevant
#' genomic region, Hi-C data, placement, and \link[grid]{grob} information.
#'
#' @examples
#' ## Load Hi-C data
#' library(plotgardenerData)
#' data("IMR90_HiC_10kb")
#'
#' ## Create a page
#' pageCreate(width = 3, height = 3, default.units = "inches")
#'
#' ## Plot and place Hi-C plot
#' hicPlot <- plotHicSquare(
#' data = IMR90_HiC_10kb, resolution = 10000,
#' zrange = c(0, 70),
#' chrom = "chr21",
#' chromstart = 28000000, chromend = 30300000,
#' assembly = "hg19",
#' x = 0.5, y = 0.5, width = 2, height = 2,
#' just = c("left", "top"),
#' default.units = "inches", bg = "black"
#' )
#'
#' ## Annotate heatmap legend
#' annoHeatmapLegend(
#' plot = hicPlot, x = 2.6, y = 0.5,
#' width = 0.12, height = 1.2,
#' just = c("left", "top"), default.units = "inches"
#' )
#'
#' ## Annotate x-axis and y-axis genome labels
#' annoGenomeLabel(
#' plot = hicPlot, scale = "Mb", axis = "x",
#' x = 0.5, y = 2.53, just = c("left", "top")
#' )
#' annoGenomeLabel(
#' plot = hicPlot, scale = "Mb", axis = "y",
#' x = 0.47, y = 0.5, just = c("right", "top")
#' )
#'
#' ## Hide page guides
#' pageGuideHide()
#' @details
#' A square Hi-C plot can be placed on a plotgardener coordinate page
#' by providing plot placement parameters:
#' \preformatted{
#' plotHicSquare(data, chrom,
#' chromstart = NULL, chromend = NULL,
#' x, y, width, height, just = c("left", "top"),
#' default.units = "inches")
#' }
#' This function can be used to quickly plot an unannotated
#' square Hi-C plot by ignoring plot placement parameters:
#' \preformatted{
#' plotHicSquare(data, chrom,
#' chromstart = NULL, chromend = NULL)
#' }
#'
#' @seealso \link[plotgardener]{readHic}
#'
#' @export
plotHicSquare <- function(data, resolution = "auto", zrange = NULL,
norm = "KR", matrix = "observed", chrom,
chromstart = NULL, chromend = NULL,
altchrom = NULL,
altchromstart = NULL, altchromend = NULL,
assembly = "hg38",
palette = colorRampPalette(brewer.pal(
n = 9, "YlGnBu"
)),
colorTrans = "linear",
half = "both", yaxisDir = "increase", bg = NA,
x = NULL, y = NULL, width = NULL,
height = NULL, just = c("left", "top"),
default.units = "inches",
draw = TRUE, params = NULL, quiet = FALSE) {
# =========================================================================
# FUNCTIONS
# =========================================================================
## Define a function that catches errors for plotHicSquare
errorcheck_plotHicSquare <- function(hic, hicPlot, norm, yaxisDir) {
###### hic/norm
hicErrors(hic = hic, norm = norm)
###### chrom/chromstart/chromend/
###### altchrom/altchromstart/altchromend
regionErrors(chromstart = hicPlot$chromstart,
chromend = hicPlot$chromend)
if (!is.null(hicPlot$altchrom)) {
## Can't specify altchrom without a chrom
if (is.null(hicPlot$chrom)) {
stop("Specified \'altchrom\', but did not give \'chrom\'.",
call. = FALSE
)
}
regionErrors(chromstart = hicPlot$altchromstart,
chromend = hicPlot$altchromend)
if (!is.null(hicPlot$chromstart) & !is.null(hicPlot$chromend) &
!is.null(hicPlot$altchromstart) &
!is.null(hicPlot$altchromend)) {
## Check to see if region is square
if ((hicPlot$chromend - hicPlot$chromstart) !=
(hicPlot$altchromend - hicPlot$altchromstart)) {
warning("Trying to plot non-square region.", call. = FALSE)
}
}
}
###### zrange #####
rangeErrors(range = hicPlot$zrange)
###### half #####
if (is.null(hicPlot$altchrom)) {
if (!(hicPlot$half %in% c("both", "top", "bottom"))) {
stop("Invalid \'half\'. Options are \'both\', ",
"\top\', or \'bottom\'.",
call. = FALSE
)
}
} else {
if (!hicPlot$half %in% c("top", "bottom")) {
stop("Invalid \'half\' for off-diagonal and ",
"interchromosomal plotting. Options are \'top\' ",
"or \'bottom\'.", call. = FALSE)
}
}
##### yaxisDir #####
if (!yaxisDir %in% c("increase", "decrease")){
stop("Invalid \'yaxisDir\'. Options are \'increase\' ",
"or \'decrease\'.", call. = FALSE)
}
}
## Define a function that checks for and gets whole chromosome
## starts/ends based on an assembly TxDb
get_wholeChrom <- function(chrom, assembly) {
chromstart <- NULL
chromend <- NULL
if (is(assembly$TxDb, "TxDb")) {
txdbChecks <- TRUE
} else {
if (!requireNamespace(assembly$TxDb, quietly = TRUE)){
txdbChecks <- FALSE
warning("`", assembly$TxDb, "` not available. Please install",
" to plot full chromosome Hi-C map.", call. = FALSE)
} else {
txdbChecks <- TRUE
}
}
if (txdbChecks == TRUE) {
if (is(assembly$TxDb, "TxDb")) {
tx_db <- assembly$TxDb
} else {
tx_db <- eval(parse(text = paste0(as.name(assembly$TxDb),
"::",
as.name(assembly$TxDb))))
}
assembly_data <- GenomeInfoDb::seqlengths(tx_db)
if (!chrom %in% names(assembly_data)) {
warning("Chromosome",
"'", chrom, "'",
"not found in", "`", assembly$TxDb$packageName, "`",
"and data for entire chromosome cannot be plotted.",
call. = FALSE
)
} else {
chromstart <- 1
chromend <- assembly_data[[chrom]]
}
}
return(list(chromstart, chromend))
}
## Define a function that subsets data
subset_data <- function(hic, hicPlot) {
if (nrow(hic) > 0) {
if (is.null(hicPlot$altchrom)) {
hic <- hic[which(hic[, "x"] >= hicPlot$chromstart -
hicPlot$resolution &
hic[, "x"] <= hicPlot$chromend + hicPlot$resolution &
hic[, "y"] >= hicPlot$chromstart - hicPlot$resolution &
hic[, "y"] <= hicPlot$chromend + hicPlot$resolution), ]
} else {
hic <- hic[which(hic[, "x"] >= hicPlot$chromstart -
hicPlot$resolution &
hic[, "x"] <= hicPlot$chromend + hicPlot$resolution &
hic[, "y"] >= hicPlot$altchromstart -
hicPlot$resolution &
hic[, "y"] <= hicPlot$altchromend +
hicPlot$resolution), ]
}
}
return(hic)
}
## Define a function that sets viewport xscale and yscale
vp_scale <- function(hicPlot, yaxisDir) {
if (!is.null(hicPlot$chromstart) & !is.null(hicPlot$chromend)) {
if (is.null(hicPlot$altchrom)) {
xscale <- c(hicPlot$chromstart, hicPlot$chromend)
yscale <- xscale
} else {
if (hicPlot$half == "bottom") {
xscale <- c(hicPlot$chromstart, hicPlot$chromend)
yscale <- c(hicPlot$altchromstart, hicPlot$altchromend)
}
if (hicPlot$half == "top") {
xscale <- c(hicPlot$altchromstart, hicPlot$altchromend)
yscale <- c(hicPlot$chromstart, hicPlot$chromend)
}
}
} else {
xscale <- c(0, 1)
yscale <- c(0, 1)
}
if (yaxisDir == "decrease"){
yscale <- rev(yscale)
}
return(list(xscale, yscale))
}
## Define a function that subsets the hic dataframe into which will
## be squares and which will be triangles
hic_shapes <- function(hic, hicPlot, half) {
if (!is.null(hicPlot$altchrom)) {
## all squares
squares <- hic
triangles <- NULL
} else {
if (half == "both") {
## all squares
squares <- hic
triangles <- NULL
} else if (half == "top") {
## squares for top half
## triangles for diagonal
squares <- hic[which(hic[, "y"] > hic[, "x"]), ]
triangles <- hic[which(hic[, "y"] == hic[, "x"]), ]
} else if (half == "bottom") {
## squares for bottom half
## triangles for diagonal
squares <- hic[which(hic[, "y"] < hic[, "x"]), ]
triangles <- hic[which(hic[, "y"] == hic[, "x"]), ]
}
}
return(list(squares, triangles))
}
## Define a function that makes grobs for the square hic diagonal
hic_diagonal <- function(hic, hicPlot, half) {
col <- hic["color"]
x <- utils::type.convert(hic["x"], as.is = TRUE)
y <- utils::type.convert(hic["y"], as.is = TRUE)
xleft <- x
xright <- x + hicPlot$resolution
ybottom <- y
ytop <- y + hicPlot$resolution
if (half == "top") {
hic_triangle <- polygonGrob(
x = c(xleft, xleft, xright),
y = c(ybottom, ytop, ytop),
gp = gpar(col = NA, fill = col),
default.units = "native"
)
} else if (half == "bottom") {
hic_triangle <- polygonGrob(
x = c(xleft, xright, xright),
y = c(ybottom, ybottom, ytop),
gp = gpar(col = NA, fill = col),
default.units = "native"
)
}
assign("hic_grobs",
addGrob(
gTree = get("hic_grobs", envir = pgEnv),
child = hic_triangle
),
envir = pgEnv
)
}
# =========================================================================
# PARSE PARAMETERS
# =========================================================================
hicInternal <- parseParams(
params = params,
defaultArgs = formals(eval(match.call()[[1]])),
declaredArgs = lapply(match.call()[-1], eval.parent, n = 2),
class = "hicInternal"
)
## Justification
hicInternal$just <- justConversion(just = hicInternal$just)
if (is.null(hicInternal$quiet)) hicInternal$quiet <- FALSE
if (is.null(hicInternal$data)) stop("argument \"data\" is missing, ",
"with no default.", call. = FALSE)
if (is.null(hicInternal$chrom)) stop("argument \"chrom\" is missing, ",
"with no default.", call. = FALSE)
# =========================================================================
# INITIALIZE OBJECT
# =========================================================================
hicPlot <- structure(list(
chrom = hicInternal$chrom,
chromstart = hicInternal$chromstart,
chromend = hicInternal$chromend,
altchrom = hicInternal$altchrom,
altchromstart = hicInternal$altchromstart,
altchromend = hicInternal$altchromend,
assembly = hicInternal$assembly,
resolution = hicInternal$resolution,
x = hicInternal$x, y = hicInternal$y,
width = hicInternal$width,
height = hicInternal$height,
just = hicInternal$just,
color_palette = NULL,
colorTrans = hicInternal$colorTrans,
zrange = hicInternal$zrange,
half = hicInternal$half,
grobs = NULL
), class = "hicSquare")
attr(x = hicPlot, which = "plotted") <- hicInternal$draw
# =========================================================================
# PARSE ASSEMBLY
# =========================================================================
hicPlot$assembly <- parseAssembly(assembly = hicPlot$assembly)
# =========================================================================
# CATCH ERRORS
# =========================================================================
check_placement(object = hicPlot)
errorcheck_plotHicSquare(
hic = hicInternal$data,
hicPlot = hicPlot,
norm = hicInternal$norm,
yaxisDir = hicInternal$yaxisDir
)
# =========================================================================
# PARSE UNITS AND Y-COORD
# =========================================================================
hicPlot <- defaultUnits(
object = hicPlot,
default.units = hicInternal$default.units
)
if (!is.null(hicPlot$x) & !is.null(hicPlot$y)){
## Convert width and height to same unit to check that they're the same
width <- convertWidth(hicPlot$width, unitTo = get("page_units",
envir = pgEnv))
height <- convertHeight(hicPlot$height, unitTo = get("page_units",
envir = pgEnv))
if (!identical(width, height)){
stop("Attempting to plot square Hi-C plot with different width and",
" height. Use `plotHicTriangle` or `plotHicRectangle` ",
" for non-square Hi-C plots.", call. = FALSE)
}
}
# =========================================================================
# GENOMIC SCALE
# =========================================================================
if (is.null(hicPlot$chromstart) & is.null(hicPlot$chromend)) {
chromData <- get_wholeChrom(
chrom = hicPlot$chrom,
assembly = hicPlot$assembly
)
hicPlot$chromstart <- chromData[[1]]
hicPlot$chromend <- chromData[[2]]
}
if (!is.null(hicPlot$altchrom)) {
if (is.null(hicPlot$altchromstart) & is.null(hicPlot$altchromend)) {
altchromData <- get_wholeChrom(
chrom = hicPlot$altchrom,
assembly = hicPlot$assembly
)
hicPlot$altchromstart <- altchromData[[1]]
hicPlot$altchromend <- altchromData[[2]]
}
}
# =========================================================================
# SWAP HALVES BASED ON YAXISDIR
# =========================================================================
if (hicInternal$yaxisDir == "decrease" & hicInternal$half == "top"){
hicInternal$half <- "bottom"
} else if (hicInternal$yaxisDir == "decrease" & hicInternal$half == "bottom"){
hicInternal$half <- "top"
}
# =========================================================================
# ADJUST RESOLUTION
# =========================================================================
if (hicPlot$resolution == "auto") {
hicPlot <- adjust_resolution(
hic = hicInternal$data,
hicPlot = hicPlot
)
} else {
hicPlot <- hic_limit(
hic = hicInternal$data,
hicPlot = hicPlot
)
}
# =========================================================================
# READ IN DATA
# =========================================================================
hic <- read_data(
hic = hicInternal$data,
hicPlot = hicPlot,
norm = hicInternal$norm,
assembly = hicPlot$assembly,
type = hicInternal$matrix,
quiet = hicInternal$quiet
)
# =========================================================================
# SUBSET DATA
# =========================================================================
hic <- subset_data(hic = hic, hicPlot = hicPlot)
# =========================================================================
# MAKE SYMMETRIC
# =========================================================================
hicFlip <- hic[, c("y", "x", "counts")]
colnames(hicFlip) <- c("x", "y", "counts")
hic <- unique(rbind(hic, hicFlip))
colnames(hic) <- c("x", "y", "counts")
# =========================================================================
# SET ZRANGE AND SCALE DATA
# =========================================================================
hicPlot <- set_zrange(hic = hic, hicPlot = hicPlot)
hic$counts[hic$counts <= hicPlot$zrange[1]] <- hicPlot$zrange[1]
hic$counts[hic$counts >= hicPlot$zrange[2]] <- hicPlot$zrange[2]
# =========================================================================
# CONVERT NUMBERS TO COLORS
# =========================================================================
## if we don't have an appropriate zrange (even after setting it
## based on a null zrange), can't scale to colors
if (!is.null(hicPlot$zrange) & length(unique(hicPlot$zrange)) == 2) {
## Log color scale
if (grepl("log", hicInternal$colorTrans) == TRUE) {
logBase <- utils::type.convert(gsub("log", "",
hicInternal$colorTrans),
as.is = TRUE)
if (is.na(logBase)) {
logBase <- exp(1)
}
## Won't scale to log if negative values
if (any(hic$counts < 0)) {
stop("Negative values in Hi-C data. Cannot scale colors on a ",
"log scale. Please set `colorTrans = 'linear'`.", call. = FALSE)
}
hic$counts <- log(hic$counts, base = logBase)
hic$color <- mapColors(vector = hic$counts,
palette = hicInternal$palette,
range = log(hicPlot$zrange, logBase)
)
} else {
hic$color <- mapColors(vector = hic$counts,
palette = hicInternal$palette,
range = hicPlot$zrange
)
}
hicPlot$color_palette <- hicInternal$palette
}
# =========================================================================
# VIEWPORTS
# =========================================================================
## Get viewport xscale and yscale
scale <- vp_scale(hicPlot = hicPlot, yaxisDir = hicInternal$yaxisDir)
## If placing information is provided but plot == TRUE, set up it's own
## viewport separate from bb_makepage
## Not translating into page_coordinates
if (is.null(hicPlot$x) | is.null(hicPlot$y)) {
vp <- viewport(
height = unit(1, "snpc"), width = unit(1, "snpc"),
x = unit(0.5, "npc"), y = unit(0.5, "npc"),
clip = "on",
xscale = scale[[1]], yscale = scale[[2]],
just = "center",
name = "hicSquare1"
)
if (hicInternal$draw == TRUE) {
grid.newpage()
}
} else {
## Get viewport name
currentViewports <- current_viewports()
vp_name <- paste0(
"hicSquare",
length(grep(
pattern = "hicSquare",
x = currentViewports
)) + 1
)
addViewport(vp_name)
## Convert coordinates into same units as page
page_coords <- convert_page(object = hicPlot)
## Make viewport
vp <- viewport(
height = page_coords$height, width = page_coords$width,
x = page_coords$x, y = page_coords$y,
clip = "on",
xscale = scale[[1]], yscale = scale[[2]],
just = hicInternal$just,
name = vp_name
)
}
# =========================================================================
# INITIALIZE GTREE FOR GROBS WITH BACKGROUND
# =========================================================================
backgroundGrob <- rectGrob(gp = gpar(
fill = hicInternal$bg,
col = NA
), name = "background")
assign("hic_grobs", gTree(vp = vp, children = gList(backgroundGrob)),
envir = pgEnv
)
# =========================================================================
# MAKE GROBS
# =========================================================================
if (!is.null(hicPlot$chromstart) & !is.null(hicPlot$chromend)) {
if (nrow(hic) > 0) {
## Determine which grobs will be squares [[1]] and which
## will be triangles [[2]]
shapes <- hic_shapes(
hic = hic, hicPlot = hicPlot,
half = hicInternal$half
)
if (!is.null(shapes[[1]])) {
## Make square grobs and add to grob gTree
hic_squares <- rectGrob(
x = shapes[[1]]$x,
y = shapes[[1]]$y,
just = c("left", "bottom"),
width = hicPlot$resolution,
height = hicPlot$resolution,
gp = gpar(col = NA, fill = shapes[[1]]$color),
default.units = "native"
)
assign("hic_grobs",
addGrob(
gTree = get("hic_grobs", envir = pgEnv),
child = hic_squares
),
envir = pgEnv
)
}
## Make triangle grobs and add to grob gTree
if (!is.null(shapes[[2]])) {
invisible(apply(shapes[[2]], 1, hic_diagonal,
hicPlot = hicPlot,
half = hicInternal$half
))
}
} else {
if (!is.na(hicPlot$resolution)){
warning("No data found in region.", call. = FALSE)
}
}
}
# =========================================================================
# IF PLOT == TRUE, DRAW GROBS
# =========================================================================
if (hicInternal$draw == TRUE) {
grid.draw(get("hic_grobs", envir = pgEnv))
}
# =========================================================================
# ADD GROBS TO OBJECT
# =========================================================================
hicPlot$grobs <- get("hic_grobs", envir = pgEnv)
# =========================================================================
# RETURN OBJECT
# =========================================================================
if (is.null(hicPlot$altchrom)) {
hicPlot$altchrom <- hicPlot$chrom
hicPlot$altchromstart <- hicPlot$chromstart
hicPlot$altchromend <- hicPlot$chromend
}
message("hicSquare[", vp$name, "]")
invisible(hicPlot)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.