| text_size = 7, title_size = 25, ...) { | text_size = 7, title_size = 25, ...) { | ||||
| if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1) | 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)) + | ggplot(d, aes(x = .x, group = .item_id, y = .y, fill = .color, alpha = .alpha)) + | ||||
| geom_tile(width = 0.9, height = 0.9) + | geom_tile(width = 0.9, height = 0.9) + | ||||
| coord_equal() + | 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) + | family = text_family, size = text_size) + | ||||
| scale_fill_identity() + | scale_fill_identity() + | ||||
| scale_color_identity() + | |||||
| scale_alpha_identity() + | scale_alpha_identity() + | ||||
| labs(title = title) + | labs(title = title) + | ||||
| theme_void() + | theme_void() + |
| #' @param color_other color for "inactive" values | #' @param color_other color for "inactive" values | ||||
| #' @param color_missing color for missing values | #' @param color_missing color for missing values | ||||
| #' @param color_fun the function to generate the colors | #' @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 ... | #' @param ... | ||||
| #' | #' | ||||
| #' @return the processed data_frame with a new column .color | #' @return the processed data_frame with a new column .color | ||||
| add_color <- function(x, ids, by, | add_color <- function(x, ids, by, | ||||
| color_header = "#737373", color_other = "#d0d0d0", | color_header = "#737373", color_other = "#d0d0d0", | ||||
| color_missing = "#ffffff", | 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))) | colors <- c(color_header, color_fun(length(ids))) | ||||
| names(colors) <- c(".header", ids) | names(colors) <- c(".header", ids) | ||||
| ifelse(.col %in% by, | ifelse(.col %in% by, | ||||
| colors[.id], | colors[.id], | ||||
| color_other)), | 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) | return(res) | ||||
| } | } | ||||
| set_text_color <- function(a) ifelse(mean(col2rgb(a)) > 127, "black", "white") |
| \usage{ | \usage{ | ||||
| add_color(x, ids, by, color_header = "#737373", | add_color(x, ids, by, color_header = "#737373", | ||||
| color_other = "#d0d0d0", color_missing = "#ffffff", | 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{ | \arguments{ | ||||
| \item{x}{a processed data_frame} | \item{x}{a processed data_frame} | ||||
| \item{color_fun}{the function to generate the colors} | \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{...}{} | \item{...}{} | ||||
| } | } | ||||
| \value{ | \value{ |