Преглед изворни кода

allow textcolor

pull/10/head
David пре 7 година
родитељ
комит
1f20c8bb29
3 измењених фајлова са 28 додато и 5 уклоњено
  1. +11
    -2
      R/plot_helpers.R
  2. +12
    -2
      R/process_data_helpers.R
  3. +5
    -1
      man/add_color.Rd

+ 11
- 2
R/plot_helpers.R Прегледај датотеку

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() +

+ 12
- 2
R/process_data_helpers.R Прегледај датотеку

#' @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")

+ 5
- 1
man/add_color.Rd Прегледај датотеку

\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{

Loading…
Откажи
Сачувај