# This includes just the plotting functions, none of which are exported
# they are the workers behind the respective plotting *methods*
plot_heatmap <- function(color_matrix, color_title, limits = c(-1,1)) {
value <- x <- y <- Correlation <- NULL # hack job to appease R CMD CHECK as per http://stackoverflow.com/questions/9439256/how-can-i-handle-r-cmd-check-no-visible-binding-for-global-variable-notes-when
if (is.null(limits)) {
max_abs <- max(abs(range(color_matrix)))
limits <- c(-max_abs, max_abs)
}
# Data preparation ====
df <- reshape2::melt(data = color_matrix, varnames = c("x", "y"))
df$x <- factor(df$x)
# Plotting ====
g <- ggplot(data = df, mapping = aes(x = x, y = factor(y), fill = value, label = round(x = value, digits = 2)))
g <- g + geom_tile()
g <- g + scale_fill_gradient2(low = "red",
high = "blue",
mid = "white",
limits = limits, # make sure whole range of values is covered
name = color_title)
g <- g + geom_text()
g <- g + theme(axis.title = element_blank()) # kill axis labels
if (isSymmetric(object = color_matrix)) { # this only makes sense if object is symmetric, otherwise plenty of space
g <- g + theme(axis.text.x = element_text(angle = 90, hjust = -0)) # rotate x axis labels
}
g <- g + scale_x_discrete(position = "top", limits = colnames(color_matrix))
g <- g + scale_y_discrete(limits = rev(rownames(color_matrix)))
return(g)
}
plot_barchart_length <- function(df, x, y, fill, flip) {
g <- ggplot(data = df, mapping = aes_string(y = x, x = y, fill = fill))
g <- g + geom_bar(stat = "identity", position = "dodge") # but not if we're talking loadings
g <- g + scale_y_continuous(limits = c(-1, 1), expand = c(0, 0))
if (flip) {
g <- g + coord_flip()
}
g <- g + theme(legend.position = "bottom")
return(g)
}
plot_barchart_area <- function(df, x, y, fill, flip) {
g <- ggplot(data = df, mapping = aes_string(y = x, x = y, fill = fill))
g <- g + geom_bar(stat = "identity", width = 1)
g <- g + scale_y_continuous(limits = c(0, 1), expand = c(0, 0))
g <- g + coord_flip()
if (flip) {
g <- g + coord_flip()
}
g <- g + theme(legend.position = "bottom")
return(g)
}
plot_piechart_area <- function(df, x, y, fill) {
g <- ggplot(data = df, mapping = aes_string(y = x, fill = fill, x = y))
g <- g + geom_bar(stat = "identity", width = 1)
g <- g + scale_y_continuous(limits = c(0, 1), trans = "sqrt")
g + coord_polar(theta = "x")
return(g)
plotly::ggplotly(g)
}
plot_density <- function(df, x, color = NULL) {
g <- ggplot(data = df, mapping = aes_string(x = x, color = color))
# Extra stuff in case more linetypes (stat summaries) are added
g <- g + geom_density(mapping = aes_string(y = "..density..", linetype = "Observed Data"))
g <- g + scale_linetype_discrete(guide = FALSE) # kill redundant label
g <- g + xlim(-1, 1)
g <- g + xlab(label = get_name(x))
g <- g + scale_color_discrete(name = get_name(color))
return(g)
}
plot_density_stacked <- function(df, x, fill = NULL) {
g <- ggplot(data = df, mapping = aes_string(x = x, color = fill))
g <- g + stat_ecdf(geom = "step", position = "identity")
g <- g + scale_x_continuous(limits = c(0, 1), expand = c(0, 0), trans = "sqrt")
g
}
# helper to get names
get_name <- function(x) {
if (is.null(names(x))) {
return(x)
} else {
return(names(x))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.