From 0e15b425d75b961a914dc60882218b481d82b0ef Mon Sep 17 00:00:00 2001 From: AG Damsbo Date: Wed, 12 Apr 2023 19:55:40 +0200 Subject: [PATCH] gp --- R/contrast_text.R | 31 +++++++++++++++------------- tests/testthat/test-age_calc.R | 18 ++++++++-------- tests/testthat/test-contrast_text.R | 6 ++++-- tests/testthat/test-ds2dd.R | 32 ++++++++++++++++++++--------- 4 files changed, 53 insertions(+), 34 deletions(-) diff --git a/R/contrast_text.R b/R/contrast_text.R index f9eb34d..ea82615 100644 --- a/R/contrast_text.R +++ b/R/contrast_text.R @@ -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")) @@ -26,24 +29,24 @@ #' @importFrom grDevices col2rgb #' contrast_text <- function(background, - light_text = 'white', - dark_text = 'black', - threshold = 0.5, - method = "perceived_2") { + light_text = 'white', + dark_text = 'black', + 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, - light_text, - dark_text - ) + ifelse(luminance < threshold, + light_text, + dark_text) } diff --git a/tests/testthat/test-age_calc.R b/tests/testthat/test-age_calc.R index 5a22cad..2123d97 100644 --- a/tests/testthat/test-age_calc.R +++ b/tests/testthat/test-age_calc.R @@ -8,17 +8,17 @@ test_that("age_calc works for vectors of length 1 (scalars)", { # Unit Test - gpttools test_that("age_calc works correctly for years", { - expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), + expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), units = "years"), 20) }) test_that("age_calc gives error if enddate < dob", { - expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"), + expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"), units = "years")) }) test_that("age_calc works correctly for months", { - expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), + expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), units = "months"), 240) }) @@ -29,9 +29,9 @@ test_that("age_calc works correctly for months", { }) test_that("age_calc works correctly for days", { - expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), + expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), units = "days"), 7305) - expect_length(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), + expect_length(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"), units = "days"), 1) }) @@ -56,7 +56,7 @@ test_that("age_calc throws an error when enddate is before dob", { }) test_that("age_calc throws an error when wrong unit", { - expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"), + expect_error(age_calc(as.Date("2020-01-01"), as.Date("2000-01-01"), units = "hours")) }) @@ -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")) }) diff --git a/tests/testthat/test-contrast_text.R b/tests/testthat/test-contrast_text.R index 09964c0..6ceb3be 100644 --- a/tests/testthat/test-contrast_text.R +++ b/tests/testthat/test-contrast_text.R @@ -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") }) \ No newline at end of file diff --git a/tests/testthat/test-ds2dd.R b/tests/testthat/test-ds2dd.R index 5ca92d5..8dc926c 100644 --- a/tests/testthat/test-ds2dd.R +++ b/tests/testthat/test-ds2dd.R @@ -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") })