This commit is contained in:
AG Damsbo 2023-04-12 19:55:40 +02:00
parent 0445b0806b
commit 0e15b425d7
4 changed files with 53 additions and 34 deletions

View File

@ -1,9 +1,11 @@
#' @title Contrast Text Color #' @title Contrast Text Color
#' @description Calculates the best contrast text color for a given background color. #' @description Calculates the best contrast text color for a given
#' background color.
#' @param background A hex/named color value that represents the background. #' @param background A hex/named color value that represents the background.
#' @param light_text A hex/named color value that represents the light text color. #' @param light_text A hex/named color value that represents the light text
#' color.
#' @param dark_text A hex/named color value that represents the dark text color. #' @param dark_text A hex/named color value that represents the dark text color.
#' @param threshold A numeric value between 0 and 1 that is used to determine #' @param threshold A numeric value between 0 and 1 that is used to determine
#' the luminance threshold of the background color for text color. #' the luminance threshold of the background color for text color.
@ -15,7 +17,8 @@
#' The function is based on the example provided by teppo: #' The function is based on the example provided by teppo:
#' https://stackoverflow.com/a/66669838/21019325. #' https://stackoverflow.com/a/66669838/21019325.
#' The different methods provided are based on the methods outlined in the #' The different methods provided are based on the methods outlined in the
#' StackOverflow thread: https://stackoverflow.com/questions/596216/formula-to-determine-perceived-brightness-of-rgb-color #' StackOverflow thread:
#' https://stackoverflow.com/questions/596216/formula-to-determine-perceived-brightness-of-rgb-color
#' @return A character string that contains the best contrast text color. #' @return A character string that contains the best contrast text color.
#' @examples #' @examples
#' contrast_text(c("#F2F2F2", "blue")) #' contrast_text(c("#F2F2F2", "blue"))
@ -31,19 +34,19 @@ contrast_text <- function(background,
threshold = 0.5, threshold = 0.5,
method = "perceived_2") { method = "perceived_2") {
if (method == "relative") { if (method == "relative") {
luminance <- c(c(.2126, .7152, .0722) %*% grDevices::col2rgb(background) / 255) luminance <-
c(c(.2126, .7152, .0722) %*% grDevices::col2rgb(background) / 255)
} else if (method == "perceived") { } else if (method == "perceived") {
luminance <- c(c(.299, .587, .114) %*% grDevices::col2rgb(background) / 255) luminance <-
c(c(.299, .587, .114) %*% grDevices::col2rgb(background) / 255)
} else if (method == "perceived_2") { } else if (method == "perceived_2") {
luminance <- c(sqrt(colSums(( luminance <- c(sqrt(colSums((
c(.299, .587, .114) * grDevices::col2rgb(background) c(.299, .587, .114) * grDevices::col2rgb(background)
) ^ 2)) / 255) ) ^ 2)) / 255)
} }
ifelse( ifelse(luminance < threshold,
luminance < threshold,
light_text, light_text,
dark_text dark_text)
)
} }

View File

@ -65,6 +65,8 @@ test_that("age_calc throws an error when wrong format", {
}) })
test_that("age_calc throws an error when wrong format", { test_that("age_calc throws an error when wrong format", {
expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"), units = "years")) expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"),
expect_error(age_calc(as.Date("1982-01-01"), as.Date("2000-01-01"), units = "seconds")) units = "years"))
expect_error(age_calc(as.Date("1982-01-01"), as.Date("2000-01-01"),
units = "seconds"))
}) })

View File

@ -5,6 +5,8 @@ library(testthat)
test_that("contrast_text() returns the correct text color", { test_that("contrast_text() returns the correct text color", {
expect_equal(contrast_text("#FFFFFF"), "black") expect_equal(contrast_text("#FFFFFF"), "black")
expect_equal(contrast_text("#000000"), "white") expect_equal(contrast_text("#000000"), "white")
expect_equal(contrast_text("#FFFFFF", light_text="blue", dark_text="green"), "green") expect_equal(contrast_text("#FFFFFF", light_text="blue", dark_text="green"),
expect_equal(contrast_text("#000000", light_text="blue", dark_text="green"), "blue") "green")
expect_equal(contrast_text("#000000", light_text="blue", dark_text="green"),
"blue")
}) })

View File

@ -1,28 +1,40 @@
talos$id <- seq_len(nrow(talos)) talos$id <- seq_len(nrow(talos))
test_that("ds2dd gives desired output", { test_that("ds2dd gives desired output", {
expect_equal(ncol(ds2dd(talos, record.id="id")),18) expect_equal(ncol(ds2dd(talos, record.id = "id")), 18)
expect_s3_class(ds2dd(talos, record.id="id"),"data.frame") expect_s3_class(ds2dd(talos, record.id = "id"), "data.frame")
expect_s3_class(ds2dd(talos,record.id = 7),"data.frame") expect_s3_class(ds2dd(talos, record.id = 7), "data.frame")
}) })
test_that("ds2dd gives output with list of length two", { test_that("ds2dd gives output with list of length two", {
expect_equal(length(ds2dd(talos, record.id="id",include.column.names = TRUE)),2) expect_equal(length(ds2dd(
talos,
record.id = "id",
include.column.names = TRUE
)), 2)
}) })
test_that("ds2dd gives correct errors", { test_that("ds2dd gives correct errors", {
expect_error(ds2dd(talos)) expect_error(ds2dd(talos))
expect_error(ds2dd(talos,form.name = c("basis","incl"))) expect_error(ds2dd(talos, form.name = c("basis", "incl")))
expect_error(ds2dd(talos,field.type = c("text","dropdown"))) expect_error(ds2dd(talos, field.type = c("text", "dropdown")))
expect_error(ds2dd(talos,field.label = c("Name","Age"))) expect_error(ds2dd(talos, field.label = c("Name", "Age")))
}) })
colnames(talos) <- c("rtreat", "mRS 1", "mRS 6", "hypertension", "diabetes", "civil", "id") colnames(talos) <-
c("rtreat",
"mRS 1",
"mRS 6",
"hypertension",
"diabetes",
"civil",
"id")
test_that("ds2dd correctly renames", { test_that("ds2dd correctly renames", {
expect_equal(ncol(ds2dd(talos, record.id="id")),18) expect_equal(ncol(ds2dd(talos, record.id = "id")), 18)
expect_s3_class(ds2dd(talos, record.id="id"),"data.frame") expect_s3_class(ds2dd(talos, record.id = "id"), "data.frame")
}) })