| @@ -37,14 +37,23 @@ static_plot <- function(d, title = "", | |||
| text_size = 7, title_size = 25, ...) { | |||
| if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1) | |||
| d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) | |||
| if (!".textcolor" %in% names(d)) | |||
| d <- d %>% mutate(.textcolor = set_text_color(.color)) | |||
| if (".col" %in% names(d)) { | |||
| d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) | |||
| } else { | |||
| # tidyr | |||
| d <- d %>% mutate(.item_id = .id_long) | |||
| } | |||
| ggplot(d, aes(x = .x, group = .item_id, y = .y, fill = .color, alpha = .alpha)) + | |||
| geom_tile(width = 0.9, height = 0.9) + | |||
| coord_equal() + | |||
| geom_text(data = d %>% filter(!is.na(.val)), aes(label = .val), color = "white", | |||
| geom_text(data = d %>% filter(!is.na(.val)), aes(label = .val, color = .textcolor), | |||
| family = text_family, size = text_size) + | |||
| scale_fill_identity() + | |||
| scale_color_identity() + | |||
| scale_alpha_identity() + | |||
| labs(title = title) + | |||
| theme_void() + | |||
| @@ -114,6 +114,8 @@ process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...) { | |||
| #' @param color_other color for "inactive" values | |||
| #' @param color_missing color for missing values | |||
| #' @param color_fun the function to generate the colors | |||
| #' @param text_color the color for the text inside the tiles, | |||
| #' defaults to white/black depending on tile color | |||
| #' @param ... | |||
| #' | |||
| #' @return the processed data_frame with a new column .color | |||
| @@ -123,7 +125,8 @@ process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...) { | |||
| add_color <- function(x, ids, by, | |||
| color_header = "#737373", color_other = "#d0d0d0", | |||
| color_missing = "#ffffff", | |||
| color_fun = scales::brewer_pal(type = "qual", "Set1"), ...) { | |||
| color_fun = scales::brewer_pal(type = "qual", "Set1"), | |||
| text_color = NA, ...) { | |||
| colors <- c(color_header, color_fun(length(ids))) | |||
| names(colors) <- c(".header", ids) | |||
| @@ -134,6 +137,13 @@ add_color <- function(x, ids, by, | |||
| ifelse(.col %in% by, | |||
| colors[.id], | |||
| color_other)), | |||
| .color = ifelse(.id == ".header", color_header, .color)) | |||
| .color = ifelse(.id == ".header", color_header, .color), | |||
| .textcolor = text_color) | |||
| if (is.na(text_color)) | |||
| res <- res %>% mutate(.textcolor = set_text_color(.color)) | |||
| return(res) | |||
| } | |||
| set_text_color <- function(a) ifelse(mean(col2rgb(a)) > 127, "black", "white") | |||
| @@ -6,7 +6,8 @@ | |||
| \usage{ | |||
| add_color(x, ids, by, color_header = "#737373", | |||
| color_other = "#d0d0d0", color_missing = "#ffffff", | |||
| color_fun = scales::brewer_pal(type = "qual", "Set1"), ...) | |||
| color_fun = scales::brewer_pal(type = "qual", "Set1"), | |||
| text_color = NA, ...) | |||
| } | |||
| \arguments{ | |||
| \item{x}{a processed data_frame} | |||
| @@ -23,6 +24,9 @@ add_color(x, ids, by, color_header = "#737373", | |||
| \item{color_fun}{the function to generate the colors} | |||
| \item{text_color}{the color for the text inside the tiles, | |||
| defaults to white/black depending on tile color} | |||
| \item{...}{} | |||
| } | |||
| \value{ | |||