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
#' @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 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 threshold A numeric value between 0 and 1 that is used to determine
#' the luminance threshold of the background color for text color.
@ -15,7 +17,8 @@
#' The function is based on the example provided by teppo:
#' https://stackoverflow.com/a/66669838/21019325.
#' 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.
#' @examples
#' contrast_text(c("#F2F2F2", "blue"))
@ -31,19 +34,19 @@ contrast_text <- function(background,
threshold = 0.5,
method = "perceived_2") {
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") {
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") {
luminance <- c(sqrt(colSums((
c(.299, .587, .114) * grDevices::col2rgb(background)
) ^ 2)) / 255)
}
ifelse(
luminance < threshold,
ifelse(luminance < threshold,
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", {
expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"), units = "years"))
expect_error(age_calc(as.Date("1982-01-01"), as.Date("2000-01-01"), units = "seconds"))
expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"),
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", {
expect_equal(contrast_text("#FFFFFF"), "black")
expect_equal(contrast_text("#000000"), "white")
expect_equal(contrast_text("#FFFFFF", light_text="blue", dark_text="green"), "green")
expect_equal(contrast_text("#000000", light_text="blue", dark_text="green"), "blue")
expect_equal(contrast_text("#FFFFFF", light_text="blue", dark_text="green"),
"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))
test_that("ds2dd gives desired output", {
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 = 7),"data.frame")
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 = 7), "data.frame")
})
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", {
expect_error(ds2dd(talos))
expect_error(ds2dd(talos,form.name = c("basis","incl")))
expect_error(ds2dd(talos,field.type = c("text","dropdown")))
expect_error(ds2dd(talos,field.label = c("Name","Age")))
expect_error(ds2dd(talos, form.name = c("basis", "incl")))
expect_error(ds2dd(talos, field.type = c("text", "dropdown")))
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", {
expect_equal(ncol(ds2dd(talos, record.id="id")),18)
expect_s3_class(ds2dd(talos, record.id="id"),"data.frame")
expect_equal(ncol(ds2dd(talos, record.id = "id")), 18)
expect_s3_class(ds2dd(talos, record.id = "id"), "data.frame")
})