gp

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',
+                          light_text = 'white',
-                            dark_text = 'black',
+                          dark_text = 'black',
-                            threshold = 0.5,
+                          threshold = 0.5,
-                            method = "perceived_2") {
+                          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(
+  ifelse(luminance < threshold,
-    luminance < threshold,
+         light_text,
-    light_text,
+         dark_text)
-    dark_text
-  )
 }
 

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("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"))
 })

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("#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")
 })

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_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", {
-  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, 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", {
-  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")
 })