Nothing
# Draws boxes for each row of slice
# Author : Sylvain Mareschal <maressyl@gmail.com>
# License : GPL3 http://www.gnu.org/licenses/gpl.html
draw.steps = function(
slice,
start,
end,
startColumns = "start",
endColumns = "end",
maxDepth = 100,
label = TRUE,
labelStrand = FALSE,
labelCex = 1,
labelSrt = 0,
labelAdj = "center",
labelOverflow = TRUE,
labelFamily = "sans",
labelColor = "#000000",
fillColor = "#BBBBBB",
border = "#666666",
cex.lab = 1,
spacing = 0.1,
bty = "o",
fg = "#000000",
...
) {
# Coercions
if(is.numeric(start)) start <- as.integer(start)
if(is.numeric(end)) end <- as.integer(end)
# Checks
if(!is.integer(start)) stop("'start' must be integer or numeric")
if(!is.integer(end)) stop("'end' must be integer or numeric")
if(!is.data.frame(slice)) stop("'slice' must be a data.frame")
if(!"start" %in% names(slice)) stop("'slice' needs a 'start' column")
if(!"end" %in% names(slice)) stop("'slice' needs a 'end' column")
# Background
draw.bg(
start = start,
end = end,
cex.lab = cex.lab,
bty = bty,
fg = fg,
...
)
errorMessage <- NA
if(nrow(slice) == 0) {
# No element
errorMessage <- "No feature in the region"
} else {
# Collision boxes
boxes <- data.frame(
start.plot = as.integer(slice[[ startColumns[1] ]]),
end.plot = as.integer(slice[[ endColumns[1] ]]),
label = slice$name,
stringsAsFactors = FALSE
)
# Compute collision
boxes <- yline(
boxes = boxes,
start = start,
end = end,
label = label,
labelStrand = labelStrand,
labelCex = labelCex,
labelSrt = labelSrt,
labelAdj = labelAdj,
labelOverflow = labelOverflow,
maxDepth = maxDepth
)
# Break if an error occured
if(is(boxes, "error")) {
# Pass error
errorMessage <- boxes
} else {
# boxes = slice
slice$plotLine <- boxes$yline
# Maximal depth used
maxLine <- max(boxes$yline) + 1L
## FEATURE PLOTING ##
# Box filling
if(is.function(fillColor)) {
environment(fillColor) <- environment()
fillColor <- fillColor()
}
# Box border
if(is.function(border)) {
environment(border) <- environment()
border <- border()
} else if(identical(border, "fillColor")) {
border <- fillColor
}
# X coordinates
x <- NULL
for(i in 1:length(startColumns)) x <- cbind(x, slice[[ startColumns[i] ]], slice[[ startColumns[i] ]])
for(i in length(endColumns):1) x <- cbind(x, slice[[ endColumns[i] ]], slice[[ endColumns[i] ]])
# Y coordinates
y <- NULL
step <- 1 / length(startColumns)
for(i in 1:length(startColumns)) y <- c(y, step*(i-1), step*i)
step <- 1 / length(endColumns)
for(i in length(endColumns):1) y <- c(y, step*i, step*(i-1))
# Plot polygons
for(i in 1:nrow(slice)) {
graphics::polygon(
x = x[i,],
y = (y * (1 - spacing) + spacing / 2 + slice[i,"plotLine"]) / maxLine,
border = rep(border, length=nrow(slice))[i],
col = rep(fillColor, length=nrow(slice))[i]
)
}
# Box labels
if(isTRUE(label)) {
# Background
charHeight <- graphics::yinch(graphics::par("cin")[2]) * labelCex
graphics::rect(
xleft = boxes$start.lab,
xright = boxes$end.lab,
ybottom = (boxes$yline + 0.1) / maxLine,
ytop = (boxes$yline + 0.1) / maxLine + charHeight,
col = "#FFFFFF",
border = border
)
# Add strand to labels (collision already accounts for it)
if(isTRUE(labelStrand)) {
boxes[ boxes$strand == "-" , "label" ] <- sprintf("< %s", boxes[ boxes$strand == "-" , "label" ])
boxes[ boxes$strand == "+" , "label" ] <- sprintf("%s >", boxes[ boxes$strand == "+" , "label" ])
}
# Label color
if(is.function(labelColor)) {
environment(labelColor) <- environment()
labelColor <- labelColor()
}
# Plotting arguments
args <- with(
boxes[ (isTRUE(label) && isTRUE(labelOverflow)) | !boxes$overflow ,],
list(
x = (boxes$start.lab + boxes$end.lab) / 2,
y = (boxes$yline + 0.1) / maxLine + charHeight/2,
label = label,
col = labelColor,
adj = c(0.5, 0.5),
cex = labelCex,
srt = labelSrt
)
)
# Font family
if(labelFamily == "Hershey") { args$vfont <- c("sans serif", "bold")
} else { args$family <- labelFamily
}
# Execute plotting
do.call(graphics::text, args)
}
}
}
# Plot only a message
if(!is.na(errorMessage)) {
graphics::text(
x = mean(graphics::par("usr")[1:2]),
y = mean(graphics::par("usr")[3:4]),
label = errorMessage,
col = fg,
adj = c(0.5, 0.5),
cex = cex.lab
)
}
# Surrounding box
graphics::box(
which = "plot",
col = fg,
bty = bty
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.