Nothing
# xx is a data matrix
ggplot_heatmap <- function(xx,
row_text_angle = 0,
column_text_angle = 45,
scale_fill_gradient_fun =
scale_fill_gradientn(
colors = viridis(
n = 256, alpha = 1, begin = 0,
end = 1, option = "viridis"
),
na.value = "grey50", limits = NULL
),
grid_color = NA,
grid_size = 0.1,
key.title = NULL,
layers,
row_dend_left = FALSE,
label_names = NULL,
fontsize_row = 10,
fontsize_col = 10,
type = c("heatmap", "scatter"),
pointsize = 5,
point_size_mat = NULL,
point_size_name = "Point size",
label_format_fun = function(...) format(..., digits = 4),
custom_hovertext = NULL,
showticklabels = c(TRUE, TRUE),
...) {
theme_clear_grid_heatmap <- theme(
axis.line = element_line(color = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank()
)
type <- match.arg(type)
df <- xx
if (!is.data.frame(df)) df <- as.data.frame(df, check.rows = FALSE)
if (is.null(label_names)) {
if (is.null(dim_names <- names(dimnames(df)))) {
label_names <- c("row", "column", "value")
} else {
label_names <- dim_names
}
} else {
assert_that(length(label_names) == 3)
}
mdf <- melt_df(xx, label_names)
if (!is.null(point_size_mat)) {
ps_label_names <- label_names
ps_label_names[[3]] <- point_size_name
point_size_mat <- melt_df(point_size_mat, ps_label_names)
mdf <- cbind(mdf, point_size_mat[point_size_name])
}
row <- label_names[[1]]
col <- label_names[[2]]
val <- label_names[[3]]
mdf[["text"]] <- paste0(
row, ": ", mdf[[1]], "<br>",
col, ": ", mdf[[2]], "<br>",
val, ": ", label_format_fun(mdf[[3]])
)
if (type == "heatmap") {
geom <- "geom_tile"
aes_mapping <- aes(fill = .data[[val]], text = .data$text)
geom_args <- list(
color = grid_color,
size = grid_size
)
} else if (type == "scatter") {
geom <- "geom_point"
geom_args <- list()
if (!is.null(point_size_mat)) {
mdf[["text"]] <- paste(
mdf[["text"]], "<br>",
point_size_name, ": ", label_format_fun(mdf[[4]])
)
aes_mapping <- aes(
color = .data[[val]],
text = .data$text,
size = .data[[point_size_name]]
)
} else {
geom_args[["size"]] <- grid_size
aes_mapping <- aes(
color = .data[[val]],
text = .data$text
)
}
}
if (!is.null(custom_hovertext)) {
mdf[["text"]] <- paste0(mdf[["text"]], "<br>", custom_hovertext)
}
geom_args[["mapping"]] <- aes_mapping
# TODO:
# http://stackoverflow.com/questions/15921799/draw-lines-around-specific-areas-in-geom-tile
# https://cran.r-project.org/web/packages/viridis/vignettes/intro-to-viridis.html
p <- ggplot(mdf, aes(x = .data[[col]], y = .data[[row]])) +
## Using the text aes produces a warning... Not ideal!
suppressWarnings(do.call(geom, geom_args)) +
scale_fill_gradient_fun +
theme_bw() +
theme_clear_grid_heatmap +
theme(
axis.title = element_blank(),
axis.text.x = if (showticklabels[[1]]) {
element_text(angle = column_text_angle, size = fontsize_col, hjust = 1)
} else {
element_blank()
},
axis.ticks.x = if (showticklabels[[1]]) element_line() else element_blank(),
axis.text.y = if (showticklabels[[2]]) {
element_text(angle = row_text_angle, size = fontsize_row, hjust = 1)
} else {
element_blank()
},
axis.ticks.y = if (showticklabels[[2]]) element_line() else element_blank(),
)
if (type == "scatter") {
p <- p +
coord_cartesian(xlim = c(1, ncol(xx)), ylim = c(1, nrow(xx)))
} else {
p <- p + coord_cartesian(expand = FALSE)
}
## Passed in to allow users to alter (courtesy of GenVisR)
if (!missing(layers)) {
p <- p + layers
}
# p <- p + scale_x_discrete(limits = unique(mdf))
# http://stats.stackexchange.com/questions/5007/how-can-i-change-the-title-of-a-legend-in-ggplot2
p <- p + labs(fill = key.title)
# until this bug is fixed: https://github.com/ropensci/plotly/issues/699
# we are forced to use geom_hline and geom_vline
if (!is.na(grid_color)) {
p <- p + geom_hline(yintercept = c(0:nrow(xx)) + 0.5, color = grid_color) # , size = grid_size # not implemented since it doesn't work with plotly
p <- p + geom_vline(xintercept = c(0:ncol(xx)) + 0.5, color = grid_color) # , size = grid_size # not implemented since it doesn't work with plotly
}
if (row_dend_left) {
p <- p + scale_y_discrete(position = "right") # possible as of ggplot 2.1.0 !
}
p
}
melt_df <- function(x, label_names) {
# heatmap
# xx <- x$matrix$data
df <- as.data.frame(x)
row <- label_names[[1]]
col <- label_names[[2]]
val <- label_names[[3]]
# colnames(df) <- x$matrix$cols
if (!is.null(rownames(x))) {
df[[row]] <- rownames(x)
} else {
df[[row]] <- 1:nrow(x)
}
df[[row]] <- factor(
df[[row]],
levels = df[[row]],
ordered = TRUE
)
mdf <- reshape2::melt(df, id.vars = row)
colnames(mdf)[2:3] <- c(col, val) # rename "variable" and "value"
mdf
}
paste_aes <- function(x) {
paste0("`", x, "`")
}
plotly_heatmap <- function(x,
limits = range(x),
colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"),
row_text_angle = 0,
column_text_angle = 45,
grid.color,
grid.size,
row_dend_left = FALSE,
fontsize_row = 10,
fontsize_col = 10,
key_title = "",
colorbar_xanchor = "left",
colorbar_yanchor = "bottom",
label_names = NULL,
colorbar_xpos = 1.1,
colorbar_ypos = 1,
colorbar_len = 0.3,
colorbar_thickness = 30,
custom_hovertext = NULL,
point_size_mat = NULL,
point_size_name = "Point size",
showticklabels = c(TRUE, TRUE),
label_format_fun = function(...) format(..., digits = 4),
height = NULL,
width = NULL,
plotly_source = "A") {
if (is.function(colors)) colors <- colors(256)
if (is.null(label_names)) {
if (is.null(dim_names <- names(dimnames(x)))) {
label_names <- c("row", "column", "value")
} else {
label_names <- dim_names
}
} else {
assert_that(length(label_names) == 3)
}
if (!is.null(point_size_mat)) {
point_size_mat <- as.matrix(point_size_mat)
}
if (!is.null(custom_hovertext)) {
text_mat <- custom_hovertext
} else {
text_mat <- as.data.frame(x)
text_mat[] <- lapply(
seq_along(text_mat),
function(i) {
lab <- paste0(
label_names[1], ": ", rownames(x), "<br>",
label_names[2], ": ", colnames(x)[i], "<br>",
label_names[3], ": ", label_format_fun(x[, i])
)
if (!is.null(point_size_mat)) {
lab <- paste0(
lab, "<br>",
point_size_name, ": ", label_format_fun(point_size_mat[, i])
)
}
lab
}
)
text_mat <- as.matrix(text_mat)
}
if (is.null(point_size_mat)) {
p <- plot_ly(
z = x, x = 1:ncol(x), y = 1:nrow(x), text = text_mat,
type = "heatmap",
showlegend = FALSE,
colors = colors,
hoverinfo = "text",
zmin = limits[1], zmax = limits[2],
height = height,
width = width,
source = plotly_source
)
} else {
melt <- function(x, cn = colnames(x), rn = rownames(x)) {
xdf <- reshape2::melt(x)
xdf$Var1 <- factor(xdf$Var1, levels = rn)
xdf$Var2 <- factor(xdf$Var2, levels = cn)
xdf
}
xdf <- melt(x)
tdf <- melt(text_mat)
pdf <- melt(point_size_mat)
p <- plot_ly(
x = as.numeric(xdf$Var2),
y = as.numeric(xdf$Var1),
text = tdf$value,
color = xdf$value,
size = pdf$value,
type = "scatter",
mode = "markers",
showlegend = FALSE,
colors = colors,
hoverinfo = "text",
source = plotly_source
)
}
p <- p %>%
layout(
xaxis = list(
tickfont = list(size = fontsize_col),
tickangle = column_text_angle,
tickvals = 1:ncol(x), ticktext = colnames(x),
linecolor = "#ffffff",
range = c(0.5, ncol(x) + 0.5),
showticklabels = showticklabels[[1]]
),
yaxis = list(
tickfont = list(size = fontsize_row),
tickangle = row_text_angle,
tickvals = 1:nrow(x), ticktext = rownames(x),
linecolor = "#ffffff",
range = c(0.5, nrow(x) + 0.5),
showticklabels = showticklabels[[2]]
)
)
p <- plotly::colorbar(
p,
lenmode = "fraction",
title = key_title,
xanchor = colorbar_xanchor,
x = colorbar_xpos,
y = colorbar_ypos,
yanchor = colorbar_yanchor,
len = colorbar_len,
thickness = colorbar_thickness
)
p
}
plotly_dend <- function(dend,
side = c("row", "col"),
flip = FALSE,
dend_hoverinfo = TRUE,
plotly_source = "A") {
if (is.hclust(dend)) {
dend <- as.dendrogram(dend)
}
side <- match.arg(side)
dend_data <- as.ggdend(dend)
segs <- dend_data$segments
## Have to get colors back from dendrogram otherwise plotly will make some up
if (is.null(segs$col) || all(is.na(segs$col))) {
segs$col <- rep(1, length(segs$col))
}
segs$col[is.na(segs$col)] <- "black" # default value for NA is "black"
if (is.numeric(segs$col)) {
segs$col <- factor(segs$col)
}
## Need to somehow convert to colors that plotly will understand
colors <- sort(unique(segs$col))
if (is.numeric(colors)) {
colors <- col2hex(grDevices::palette()[seq_along(colors)])
}
lab_max <- nrow(dend_data$labels)
if (side == "row") {
lab_max <- lab_max + 0.5
}
axis1 <- list(
title = "",
range = c(0, max(segs$y)),
linecolor = "#ffffff",
showgrid = FALSE
)
axis2 <- list(
title = "",
range = c(0, lab_max),
linecolor = "#ffffff",
showgrid = FALSE
)
## Have to change x and y depending on which orientation
if (side == "row") {
add_plot_lines <- function(p) {
p %>%
add_segments(
x = ~y, xend = ~yend, y = ~x, yend = ~xend, color = ~col,
showlegend = FALSE,
colors = colors,
hoverinfo = if (dend_hoverinfo) "x" else "none"
) %>%
layout(
hovermode = "closest",
xaxis = axis1,
yaxis = axis2
)
}
} else {
add_plot_lines <- function(p) {
p %>%
add_segments(
x = ~x, xend = ~xend, y = ~y, yend = ~yend, color = ~col,
showlegend = FALSE,
colors = colors,
hoverinfo = if (dend_hoverinfo) "y" else "none"
) %>%
layout(
hovermode = "closest",
xaxis = axis2,
yaxis = axis1
)
}
}
p <- plot_ly(segs, source = plotly_source) %>% add_plot_lines()
if (flip) {
p <- layout(p, xaxis = list(autorange = "reversed"))
}
p
}
#' @title Side color plots for heatmaps
#' @description
#' Important for creating annotation.
#'
#' @param df A "molten" data.frame as produced by (eg) reshape2::melt
#' @param palette A function which can return colors to be used in the sidebar
#' plot
#' @param scale_title Title of the color scale. Not currently used.
#' @param type Horizontal or vertical plot? Valid values are "column" and "row"
#' @param text_angle the angle of the text of the rows/columns.
#' @param is_colors Use if the values in df are valid colours and should not be mapped
#' to a color scheme, and instead should be plotted directly.
#' @param fontsize Font size (currently unused)
#' @param label_name Name for the mouseover label, usually "row" or "column"
#'
#' @return A ggplot geom_tile object
#'
ggplot_side_color_plot <- function(df,
palette = NULL,
scale_title = paste(type, "side colors"),
type = c("column", "row"),
text_angle = if (type == "column") 0 else 90,
is_colors = FALSE,
fontsize = 10,
label_name = NULL) {
type <- match.arg(type)
if (is.matrix(df)) df <- as.data.frame(df)
assert_that(is.data.frame(df))
if (is.null(label_name)) label_name <- type
## Cooerce to character
df[] <- lapply(df, as.character)
## TODO: Find out why names are dropped when ncol(df) == 1 (Not any more?)
original_dim <- dim(df)
if (is.null(palette)) palette <- default_side_colors
## Custom label
if (type %in% colnames(df)) {
stop("Having", type, "in the colnames of the side_color df will drop data!")
}
df[[type]] <- if (!is.null(rownames(df))) rownames(df) else 1:nrow(df)
df[[type]] <- factor(df[[type]], levels = df[[type]], ordered = TRUE)
df <- reshape2::melt(df, id.vars = type)
df[["value"]] <- factor(df[["value"]])
id_var <- colnames(df)[1]
common_theme <- theme(
panel.background = element_blank(),
axis.ticks = element_blank()
)
## Don't need this hack any more?
# if(original_dim[2] > 1) {
text_element <- element_text(angle = text_angle, hjust = 1, size = fontsize)
# } else text_element <- element_blank()
if (type == "column") {
mapping <- aes(x = .data[[id_var]], y = .data$variable, fill = .data$value)
specific_theme <- theme(
axis.text.x = element_blank(),
axis.text.y = text_element
)
} else {
mapping <- aes(x = .data$variable, y = .data[[id_var]], fill = .data$value)
specific_theme <- theme(
axis.text.x = text_element,
axis.text.y = element_blank(),
legend.position = "top"
)
}
theme <- list(common_theme, specific_theme)
if (is_colors) {
palette <- setNames(unique(df[["value"]]), unique(df[["value"]]))
}
if (is.function(palette)) {
palette <- setNames(palette(nlevels(df[["value"]])), levels(df[["value"]]))
} else if (!all(levels(factor(df[["value"]])) %in% names(palette))) {
stop(paste0(
"Not all levels of the ", type,
"_side_colors are mapped in the ", type, "_side_palette"
))
}
g <- ggplot(df, mapping = mapping) +
geom_tile() +
xlab("") +
ylab("") +
scale_fill_manual(
name = scale_title,
breaks = levels(df[["value"]]),
values = as.character(palette[levels(df[["value"]])])
) +
theme
return(g)
}
default_side_colors <- function(n) {
## Warning if n < 3 in any case
suppressWarnings(
if (n <= 12) {
RColorBrewer::brewer.pal(n, "Paired")[seq_len(n)]
} else if (n <= 20) {
c(
RColorBrewer::brewer.pal(12, "Paired"),
RColorBrewer::brewer.pal(n - 12, "Set2")
)[seq_len(n)]
} else if (n <= 32) {
c(
RColorBrewer::brewer.pal(12, "Paired"),
RColorBrewer::brewer.pal(8, "Set2"),
RColorBrewer::brewer.pal(n - 20, "Set3")
)[seq_len(n)]
} else {
colorspace::rainbow_hcl(n)
}
)
}
## Predict luminosity of cells and change text based on that
## http://stackoverflow.com/questions/12043187/how-to-check-if-hex-color-is-too-black
predict_colors <- function(p,
colorscale_df = p$x$data[[1]]$colorscale %||% p$x$data[[2]]$marker$colorscale,
cell_values = p$x$data[[1]]$z,
plot_method = c("ggplot", "plotly")) {
plot_method <- match.arg(plot_method)
if (is.null(cell_values)) {
cell_values <- as.data.frame(
matrix(
p$x$data[[1]]$marker$size,
ncol = length(unique(p$x$data[[1]]$x)),
nrow = length(unique(p$x$data[[1]]$y))
)
)
}
if (is.null(colorscale_df)) {
stop("Internal error in predicting colours!")
}
cell_values <- as.data.frame(cell_values)
cell_values$row <- seq_len(nrow(cell_values))
cell_values_m <- reshape2::melt(cell_values, id.vars = "row")
cell_values_vector <- cell_values_m$value
## Need to normalise to (0, 1) scale as this is what plotly
## uses internally
if (plot_method == "plotly") {
## Need to convert plotly colors to hex colors
colorscale_df[, 2] <- parse_plotly_color(colorscale_df[, 2])
cell_values_vector <- normalize(as.numeric(cell_values_vector))
## interpolate to 256 colors because that's probably enough
colorscale_df <- data.frame(
stats::approx(as.numeric(colorscale_df[, 1]), n = 256)$y,
grDevices::colorRampPalette(colorscale_df[, 2])(256)
)
## Then need to sort, find nearest neighbour, and map across
cell_values_vector_sort <- sort(cell_values_vector)
nearest_neighbours <- sapply(
cell_values_vector_sort,
function(val) {
max(colorscale_df[as.numeric(colorscale_df[, 1]) <= val, 1])
}
)
names(nearest_neighbours) <- cell_values_vector_sort
cell_values_vector <- nearest_neighbours[as.character(cell_values_vector)]
}
cell_values_vector <- as.character(cell_values_vector)
ind <- match(cell_values_vector, colorscale_df[, 1])
cell_colors <- unlist(colorscale_df[ind, 2])
# apply colors only to non-NA cells
# In the future, it might be worth using na.color
cell_colors <- as.character(cell_colors)
cell_colors[is.na(cell_colors)] <- "#ffffff" # make the default white for NA values
cell_colors_rgb <- colorspace::hex2RGB(cell_colors)
cell_font_colors <- sapply(
seq_len(nrow(cell_colors_rgb@coords)),
function(i) {
col <- cell_colors_rgb@coords[i, ]
luma <- (0.2126 * col[1]) +
(0.7152 * col[2]) +
(0.0722 * col[3])
ifelse(luma < 0.4, "white", "black")
}
)
cell_font_colors
}
parse_plotly_color <- function(color) {
r <- gsub(
"rgb[a]?\\((\\d+),(\\d+),(\\d+)(,\\d+)?)",
"\\1", color
)
g <- gsub(
"rgb[a]?\\((\\d+),(\\d+),(\\d+)(,\\d+)?)",
"\\2", color
)
b <- gsub(
"rgb[a]?\\((\\d+),(\\d+),(\\d+)(,\\d+)?)",
"\\3", color
)
rgb(r, g, b, maxColorValue = 255)
}
## Helper function to generate "normal" colors for dendrograms
## ie black if one k or rainbow_hcl otherwise
k_colors <- function(k) {
if (k > 1) {
colorspace::rainbow_hcl(k)
} else {
"black"
}
}
# Create a plotly colorscale from a list of colors in any format.
discrete_colorscale <- function(colors) {
colors <- rep(colors, each = 100)
seq <- seq(0, 1, length.out = length(colors))
setNames(data.frame(seq, colors), NULL)
}
#' @importFrom stats setNames
plotly_side_color_plot <- function(df,
palette = NULL,
scale_title = paste(type, "side colors"),
type = c("column", "row"),
text_angle = if (type == "column") 0 else 90,
is_colors = FALSE,
label_name = NULL,
colorbar_len = 0.3,
fontsize = 10,
show_legend = TRUE,
plotly_source = "A") {
type <- match.arg(type)
if (is.null(label_name)) label_name <- type
data <- df
data[] <- lapply(df, factor)
# if (type == "column") {
# data <- t(data)
# }
data <- as.data.frame(data, stringsAsFactors = TRUE)
data_vals <- unlist(data)
levels <- levels(data_vals)
levels <- levels[!is.na(levels)]
if (is.null(palette)) palette <- default_side_colors
if (is.function(palette)) {
palette <- setNames(palette(length(levels)), levels)
} else {
palette <- setNames(col2hex(palette), names(palette))
if (!all(levels %in% names(palette))) {
stop(paste0(
"Not all levels of the ", type,
"_side_colors are mapped in the ", type, "_side_palette"
))
}
}
levs2colors <- palette[as.character(levels)]
levs2nums <- setNames(seq_along(levels), levels)
df_nums <- data
df_nums[] <- lapply(
data,
function(col) as.numeric(levs2nums[as.character(col)])
)
df_nums <- as.matrix(df_nums)
if (type == "column") {
df_nums <- t(df_nums)
}
if (ncol(df) == 1) {
key_title <- colnames(df)
} else {
key_title <- paste(
gsub("^(\\w)", "\\U\\1", type, perl = TRUE), "annotation"
)
}
text_mat <- data
text_mat[] <- lapply(
seq_along(text_mat),
function(i) {
if (type == "row") {
paste0(
"variable: ", colnames(data)[i], "<br>",
"value: ", data[, i], "<br>",
label_name, ": ", rownames(data)
)
} else {
paste0(
"variable: ", rownames(data),
"value: ", data[, i], "<br>",
label_name, ": ", colnames(data)[i], "<br>"
)
}
}
)
## Ensure tickvals are in right position when n = 2
offset <- ((length(levels) - 1) / length(levels)) / 2
## https://stackoverflow.com/questions/42524450/using-discrete-custom-color-in-a-plotly-heatmap
p <- plot_ly(
z = df_nums, x = 1:ncol(df_nums), y = 1:nrow(df_nums),
text = as.matrix(text_mat), hoverinfo = "text",
type = "heatmap", showlegend = FALSE, colors = levs2colors,
colorscale = discrete_colorscale(levs2colors),
colorbar = list(
# Capitalise first letter
title = key_title,
tickmode = "array",
## Issue #137
tickvals = seq(
1 + offset,
length(levels) - offset,
length.out = length(levels)
),
ticktext = levels,
len = colorbar_len
),
source = plotly_source
)
if (type == "row") {
p <- p %>% layout(
xaxis = list(
tickfont = list(size = fontsize),
tickangle = text_angle,
tickvals = 1:ncol(df_nums), ticktext = colnames(df_nums),
linecolor = "#ffffff",
range = c(0.5, ncol(df_nums) + 0.5),
showticklabels = TRUE
),
yaxis = list(showticklabels = FALSE)
)
} else {
p <- p %>% layout(
yaxis = list(
tickfont = list(size = fontsize),
tickangle = text_angle,
tickvals = 1:nrow(df_nums), ticktext = rownames(df_nums),
linecolor = "#ffffff",
range = c(0.5, nrow(df_nums) + 0.5),
showticklabels = TRUE
),
xaxis = list(showticklabels = FALSE)
)
}
p
}
#' @import webshot
NULL
# just so to have an excuse for why webshot is in import (the real reason is that plotly has it as suggests while it is used there by plotly::export)
# webshot <- webshot::webshot
# TODO: add roxydoc
# This function gets a heatmaply object and a file, and writes that to a file
# we should later add control over width...
hmly_to_file_1file <- function(hmly, file, width = NULL, height = NULL, ...) {
# tools::file_ext("hithere.png")
# tools::file_ext("hithere.html")
# tools::file_ext("hithere.html.png")
file_extension <- tolower(tools::file_ext(file))
if (!(file_extension %in% c("html", "pdf", "png", "jpeg"))) {
stop(paste(
"file extension must be one of the following:",
"\"html\", \"pdf\", \"png\", or \"jpeg\".",
"Since it was not, your heatmaply was not saved to a file."
))
} else {
if (file_extension == "html") {
# solution to dealing with the folder:
# https://stackoverflow.com/questions/41399795/savewidget-from-htmlwidget-in-r-cannot-save-html-file-in-another-folder
tmp_fp <- file
tmp_fp <- file.path(normalizePath(dirname(tmp_fp)), basename(tmp_fp))
hmly %>% htmlwidgets::saveWidget(file = tmp_fp, selfcontained = TRUE)
}
if (file_extension %in% c("pdf", "png", "jpeg")) {
if (is.null(width)) {
width <- size_default(file_extension, "width")
}
if (is.null(height)) {
height <- size_default(file_extension, "height")
}
tryCatch(
export_orca(hmly, file, width, height),
error = function(e) {
warning <- paste("plotly::orca failed:\n", e)
warning(warning)
export(hmly, file, width, height)
}
)
}
}
invisible(hmly)
}
export_orca <- function(x, file, width, height) {
plotly::orca(
x,
file = file,
width = width,
height = height
)
}
export <- function(x, file, width, height) {
plotly::export(
x,
file = file,
vwidth = width,
vheight = height,
cliprect = "viewport"
)
}
size_default <- function(file_extension, direction = c("width", "height")) {
direction <- match.arg(direction)
## webshot uses viewport size in pixels to control file size, so
## all sizes in pixels
# switch(direction,
# "width" = if (file_extension %in% bitmap_types) 800 else 8,
# "height" = if (file_extension %in% bitmap_types) 500 else 5
# )
switch(direction,
"width" = 800,
"height" = 500
)
}
bitmap_types <- c("png", "jpeg")
hmly_to_file <- Vectorize(hmly_to_file_1file, vectorize.args = "file")
## Copied from gplots
#' @importFrom grDevices col2rgb
col2hex <- function(col) {
colMat <- col2rgb(col)
rgb(
red = colMat[1, ] / 255,
green = colMat[2, ] / 255,
blue = colMat[3, ] / 255
)
}
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.