see NEWS.md

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 23.1.7
-Date: 2023-01-23 11:49:57 UTC
-SHA: ef2dabc8f563a1b442d67997bd21500f13bf3003
+Version: 23.1.8
+Date: 2023-01-27 08:40:38 UTC
+SHA: 32be68177d94e20b66c8f0915aa195c0c2c7eda5

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: stRoke
 Title: Clinical Stroke Research
-Version: 23.1.8
+Version: 23.4.1
 Authors@R: 
     person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154"))
@@ -30,6 +30,7 @@ Imports:
     calendar,
     dplyr,
     ggplot2,
+    grDevices,
     gtsummary,
     lubridate,
     MASS,

NAMESPACE

@@ -2,9 +2,11 @@
 
 export(age_calc)
 export(ci_plot)
+export(contrast_text)
 export(cpr_check)
 export(cpr_dob)
 export(cpr_female)
+export(ds2dd)
 export(files_filter)
 export(generic_stroke)
 export(index_plot)
@@ -21,6 +23,7 @@ importFrom(calendar,ic_write)
 importFrom(dplyr,if_else)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
+importFrom(grDevices,col2rgb)
 importFrom(gtsummary,add_overall)
 importFrom(gtsummary,tbl_summary)
 importFrom(lubridate,dminutes)

NEWS.md

@@ -1,8 +1,21 @@
+# stRoke 23.4.1
+
+### Functions:
+
+* NEW: ds2dd() creates a REDCap data dictionary based on a data set for easy upload. A new vignette will be provided for example use. A separate vignette has been added.
+
+### Notes:
+
+* With newer additions to the package, these functions clearly has their potential use also outside stroke research.
+* A new vector with REDCap metadata headers has been added. Can be called with data(metadata_names).
+
+
 # stRoke 23.1.8
 
 ### Functions:
 
 * write_ical() is an easy to use implementation of the package `library(calendar)` for easy conversion of spreadsheets to ical object. Export an .ics file using `calendar::ic_write()`. 
+* contrast_text() calculates the best contrast text color for a given background color. For use in graphics.
 
 ### Notes:
 

R/contrast_text.R

@@ -0,0 +1,49 @@
+
+
+#' @title Contrast Text 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 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.
+#' @param method A character string that specifies the method for calculating 
+#' the luminance. Three different methods are available: 
+#' c("relative","perceived","perceived_2")
+#' @details
+#' This function aids in deciding the font color to print on a given background.
+#' 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
+#' @return A character string that contains the best contrast text color.
+#' @examples
+#' contrast_text(c("#F2F2F2", "blue"))
+#' 
+#' contrast_text(c("#F2F2F2", "blue"), method="relative")
+#' @export
+#' 
+#' @importFrom grDevices col2rgb
+#'
+contrast_text <- function(background,
+                            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)
+  } else if (method == "perceived") {
+    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
+  )
+}
+

R/ds2dd.R

@@ -0,0 +1,80 @@
+utils::globalVariables(c("metadata_names"))
+#' Data set to data dictionary function
+#'
+#' @param ds data set
+#' @param record.id name or column number of id variable, moved to first row of 
+#' data dictionary, character of integer. Default is "record_id".
+#' @param form.name vector of form names, character string, length 1 or length
+#' equal to number of variables. Default is "basis".
+#' @param field.type vector of field types, character string, length 1 or length
+#' equal to number of variables. Default is "text.
+#' @param field.label vector of form names, character string, length 1 or length
+#' equal to number of variables. Default is NULL and is then identical to field
+#' names.
+#' @param include.column.names Flag to give detailed output including new
+#' column names for original data set for upload.
+#'
+#' @return data.frame or list of data.frame and vector
+#' @export
+#'
+#' @examples
+#' talos$id <- seq_len(nrow(talos))
+#' ds2dd(talos, record.id="id",include.column.names=FALSE)
+
+ds2dd <-
+  function(ds,
+           record.id = "record_id",
+           form.name = "basis",
+           field.type = "text",
+           field.label = NULL,
+           include.column.names = FALSE) {
+    dd <- data.frame(matrix(ncol = length(metadata_names), nrow = ncol(ds)))
+    colnames(dd) <- metadata_names
+    
+    if (is.character(record.id) & !record.id %in% colnames(ds)) {
+      stop("Provided record.id is not a variable name in provided data set.")
+    }
+    
+    # renaming to lower case and substitute spaces with underscore
+    field.name <- gsub(" ", "_", tolower(colnames(ds)))
+    
+    # handles both character and integer
+    colsel <-
+      colnames(ds) == colnames(ds[record.id])
+    
+    if (summary(colsel)[3] != 1) {
+      stop("Provided record.id has to be or refer to a uniquely named column.")
+    }
+    
+    dd[, "field_name"] <-
+      c(field.name[colsel], field.name[!colsel])
+    
+    if (length(form.name) > 1 & length(form.name) != ncol(ds)) {
+      stop(
+        "Provided form.name should be of length 1 (value is reused) or equal 
+        length as number of variables in data set."
+      )
+    }
+    dd[, "form_name"] <- form.name
+    
+    if (length(field.type) > 1 & length(field.type) != ncol(ds)) {
+      stop(
+        "Provided field.type should be of length 1 (value is reused) or equal 
+        length as number of variables in data set."
+      )
+    }
+    
+    dd[, "field_type"] <- field.type
+    
+    if (is.null(field.label)) {
+      dd[, "field_label"] <- dd[, "field_name"]
+    } else
+      dd[, "field_label"] <- field.label
+    
+    if (include.column.names){
+      list("DataDictionary"=dd,"Column names"=field.name)
+    } else dd
+  }
+
+
+

R/metadata.R

@@ -0,0 +1,11 @@
+#' Vector of REDCap metadata headers
+#'
+#'
+#' @format Vector of length 18 with REDCap metadata headers:
+#' \describe{
+#'   \item{metadata_names}{characterstrings}
+#' }
+#' @seealso \url{https://www.project-redcap.org/}
+#' @usage data(metadata_names)
+"metadata_names"
+

inst/WORDLIST

@@ -14,6 +14,7 @@ REDCapRITS
 RStudio
 Randomisation
 STROKEAHA
+StackOverflow
 Sys
 TALOS
 Vectorised
@@ -51,6 +52,7 @@ gpttools
 grotta
 grottaBar
 gtsummary
+https
 ical
 icalendar
 ics
@@ -59,10 +61,14 @@ jan
 jss
 lm
 lst
+luminance
 mRS
 olr
 recognised
+rgb
 sapply
+stackoverflow
+teppo
 vapply
 vec
 winP

man/contrast_text.Rd

@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/contrast_text.R
+\name{contrast_text}
+\alias{contrast_text}
+\title{Contrast Text Color}
+\usage{
+contrast_text(
+  background,
+  light_text = "white",
+  dark_text = "black",
+  threshold = 0.5,
+  method = "perceived_2"
+)
+}
+\arguments{
+\item{background}{A hex/named color value that represents the background.}
+
+\item{light_text}{A hex/named color value that represents the light text color.}
+
+\item{dark_text}{A hex/named color value that represents the dark text color.}
+
+\item{threshold}{A numeric value between 0 and 1 that is used to determine
+the luminance threshold of the background color for text color.}
+
+\item{method}{A character string that specifies the method for calculating
+the luminance. Three different methods are available:
+c("relative","perceived","perceived_2")}
+}
+\value{
+A character string that contains the best contrast text color.
+}
+\description{
+Calculates the best contrast text color for a given background color.
+}
+\details{
+This function aids in deciding the font color to print on a given background.
+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
+}
+\examples{
+contrast_text(c("#F2F2F2", "blue"))
+
+contrast_text(c("#F2F2F2", "blue"), method="relative")
+}

man/ds2dd.Rd

@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ds2dd.R
+\name{ds2dd}
+\alias{ds2dd}
+\title{Data set to data dictionary function}
+\usage{
+ds2dd(
+  ds,
+  record.id = "record_id",
+  form.name = "basis",
+  field.type = "text",
+  field.label = NULL,
+  include.column.names = FALSE
+)
+}
+\arguments{
+\item{ds}{data set}
+
+\item{record.id}{name or column number of id variable, moved to first row of
+data dictionary, character of integer. Default is "record_id".}
+
+\item{form.name}{vector of form names, character string, length 1 or length
+equal to number of variables. Default is "basis".}
+
+\item{field.type}{vector of field types, character string, length 1 or length
+equal to number of variables. Default is "text.}
+
+\item{field.label}{vector of form names, character string, length 1 or length
+equal to number of variables. Default is NULL and is then identical to field
+names.}
+
+\item{include.column.names}{Flag to give detailed output including new
+column names for original data set for upload.}
+}
+\value{
+data.frame or list of data.frame and vector
+}
+\description{
+Data set to data dictionary function
+}
+\examples{
+talos$id <- seq_len(nrow(talos))
+ds2dd(talos, record.id="id",include.column.names=FALSE)
+}

man/metadata_names.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/metadata.R
+\docType{data}
+\name{metadata_names}
+\alias{metadata_names}
+\title{Vector of REDCap metadata headers}
+\format{
+Vector of length 18 with REDCap metadata headers:
+\describe{
+\item{metadata_names}{characterstrings}
+}
+}
+\usage{
+data(metadata_names)
+}
+\description{
+Vector of REDCap metadata headers
+}
+\seealso{
+\url{https://www.project-redcap.org/}
+}
+\keyword{datasets}

tests/testthat/test-contrast_text.R

@@ -0,0 +1,10 @@
+# Unit test for contrast_text()
+
+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")
+})

tests/testthat/test-ds2dd.R

@@ -0,0 +1,28 @@
+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")
+})
+
+test_that("ds2dd gives output with list of length two", {
+  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")))
+})
+
+
+
+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")
+})

vignettes/ds2dd.Rmd

@@ -0,0 +1,65 @@
+---
+title: "Data set to data dictionary (ds2dd)"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{ds2dd}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+```{r setup}
+library(stRoke)
+```
+
+# Easy data set to data base workflow
+
+This function can be used as a simple tool for creating at data base metadata file for REDCap (called a DataDictionary) based on a given data set file.
+
+## Step 1 - Load your data set
+
+Here we'll use the sample TALOS dataset included with the package.
+
+```{r}
+data("talos")
+# As the data set lacks an ID column, one is added
+talos$id <- seq_len(nrow(talos))
+```
+
+## Step 2 - Create the DataDictionary
+
+```{r}
+datadictionary <- ds2dd(talos,record.id = "id")
+```
+
+Now additional specifications to the DataDictionary can be made manually, or it can be uploaded and modified manually in the graphical user interface on the web page.
+
+## Step 3 - Upload
+
+Now the DataDictionary can be exported as a spreadsheet and uploaded or it can be uploaded using the `REDCapR` package (only projects with "Development" status).
+
+Use one of the two approaches below:
+
+### Manual upload
+
+```{r eval=FALSE}
+write.csv(datadictionary,"datadictionary.csv")
+```
+
+### Upload with `REDCapR`
+
+```{r eval=FALSE}
+REDCapR::redcap_metadata_write(
+  datadictionary,
+  redcap_uri = keyring::key_get("DB_URI"),
+  token = keyring::key_get("DB_TOKEN")
+)
+```
+
+In the ["REDCap R Handbook"](https://agdamsbo.github.io/redcap-r-handbook/) more is written on interfacing with REDCap in R using the `library(keyring)`to store credentials in [chapter 1.1](https://agdamsbo.github.io/redcap-r-handbook/access.html#sec-getting-access).

vignettes/toolbox.Rmd

@@ -1,8 +1,8 @@
 ---
-title: "Toolbox"
+title: "Toolbox introduction"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{Toolbox}
+  %\VignetteIndexEntry{Introduction}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---