version 23.4.1

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: stRoke
 Title: Clinical Stroke Research
-Version: 23.1.7
+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"))
@@ -19,17 +19,17 @@ License: GPL-3
 Encoding: UTF-8
 RoxygenNote: 7.2.3
 LazyData: true
-Suggests: knitr, rmarkdown, spelling, testthat (>= 3.0.0)
+Suggests: covr, knitr, rmarkdown, spelling, testthat (>= 3.0.0)
 Language: en-US
 Config/testthat/edition: 3
-Imports: dplyr, ggplot2, gtsummary, MASS, rankinPlot, stats, tidyr,
-        utils
+Imports: calendar, dplyr, ggplot2, grDevices, gtsummary, lubridate,
+        MASS, rankinPlot, stats, tidyr, utils
 Depends: R (>= 3.5.0)
 VignetteBuilder: knitr
 NeedsCompilation: no
-Packaged: 2023-01-23 11:27:19 UTC; au301842
+Packaged: 2023-04-13 11:56:48 UTC; au301842
 Author: Andreas Gammelgaard Damsbo [aut, cre]
     (<https://orcid.org/0000-0002-7559-1154>)
 Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@clin.au.dk>
 Repository: CRAN
-Date/Publication: 2023-01-24 10:20:09 UTC
+Date/Publication: 2023-04-13 12:20:02 UTC

MD5

@@ -1,57 +1,73 @@
-47f15cfdff668788a3e898ac57675aac *DESCRIPTION
-7610a3017230808ab528fd9f26ffa0a3 *NAMESPACE
-7c79981794b064658c960ada4d7a89df *NEWS.md
+31a35ca78b7be5ce02cfa6cf763ad88b *DESCRIPTION
+e1b120d83a90fadd9b0889f9e5469568 *NAMESPACE
+f20a1a61a05771852273cd26203d35dd *NEWS.md
 7b12e6054953e69ede6dfeb21fd2dda1 *R/age_calc.R
-e7133c8b257426831bea708d83619057 *R/ci_plot.R
+b7f7efe5f8368d021b5d70fc1f250382 *R/ci_plot.R
+20ef90495f1368067af9282ad1cdbe72 *R/contrast_text.R
 93ca852adc3e1b7e1e466ee51edd717a *R/cpr_tools.R
 e9209d22d107e54924be938da834c788 *R/cprs.R
+f9a722d290187490589e5766c56bc305 *R/ds2dd.R
 a7e98448a47fab58d2d76cd9b0dc9969 *R/files_filter.R
-ae37e84d3850ef76aa7c82d31d005796 *R/generic_stroke.R
+d3037e01c3b4dd308ba0b368035e3711 *R/generic_stroke.R
 7d15d855a6a7068b49aff59fae2941e8 *R/index_plot.R
-7b6138eec394ab668a284626d56f2133 *R/label_select.R
+f1addfffab7db201c03d179af32e1556 *R/label_select.R
+9cc12b315d8d705bfc1182030a44517c *R/metadata.R
 2057eec351a220bedea2f37add95c783 *R/quantile_cut.R
 357e9c2bc328a76401f8f03b1e891b09 *R/score.R
 c59c97259b127f78899cd409f6b66be7 *R/source_lines.R
 df6cc46bc7fae1a55b713f3d5065b35a *R/stRoke-package.R
 115a60cc61179b8046fdcdc68caa5afe *R/talos.R
 a52e3d5ec69970334fa670ade52a9230 *R/win_prob.R
-13b51128fb783569d501ad5802a076c7 *README.md
+34c5e1e77b53c4a1b03404285233c8cb *R/write_ical.R
+e38f75999bade0aaeb6675a8d306b5ed *README.md
 0c6ad5b3446721162c89589e8077ab1c *build/partial.rdb
-1f92ccb09034d426227aefb018737632 *build/vignette.rds
+a26152661e767a0448c003e9a7c63873 *build/vignette.rds
 9ff58f51afe4d7a525d9fbd96d2a0254 *data/cprs.rda
+43d1033e01812ccfeec3ef43a910b412 *data/metadata_names.rda
 bef9db1e7fcce7320034d5594439af9b *data/score.rda
 563b9b9a9ce471dad2a1b7c5bdfcb2d9 *data/talos.rda
-7197bb8346f154e92f89e2d97a66db67 *inst/WORDLIST
+7ce8d60f05fc847fe627e15db08ff76c *inst/WORDLIST
+9e54884f72fd92d198373f91239993e5 *inst/doc/ds2dd.R
+0d453a0ef1f7480551c56034e3e10142 *inst/doc/ds2dd.Rmd
+fc944a2f4ddc37d1cd2ba9f3039b10a5 *inst/doc/ds2dd.html
 294f93b2e947f77154822473e86f1d3a *inst/doc/toolbox.R
-f295cfd4bc7bfd5ca9d4d52c9f12cafd *inst/doc/toolbox.Rmd
-147e99956c4767337d5c9a7a99a6771f *inst/doc/toolbox.html
+a7b713db8daa62baacaeb66dbe5a8ef1 *inst/doc/toolbox.Rmd
+3da16d397c2c424552f112118e6ef0de *inst/doc/toolbox.html
 d3c74a54cf1e8f7eacce7d01259dea2b *man/age_calc.Rd
-82df41f1b8a28ff9bb9b4138daa40cb6 *man/ci_plot.Rd
+35edd8fdaedf54d1985eeee966285082 *man/ci_plot.Rd
+f11879cb04d1b88555a584925714cac0 *man/contrast_text.Rd
 eadee44e4377d87ebc8eeff7ac3b76ce *man/cpr_check.Rd
 182764319c56d018d0e54ca1d4f65fa5 *man/cpr_dob.Rd
 e4f04600cde865c099c59e21bb32b93a *man/cpr_female.Rd
 318a77f6652b3efc9a5b4254ed72c90b *man/cprs.Rd
+28bdecbfc52ea2d7be575f14fbed7289 *man/ds2dd.Rd
 c6b600284cc4227cd8feb2d223d395c1 *man/figures/hexlogo.png
 48c49fc24d336ed677c0ba7fd84cac70 *man/files_filter.Rd
-2f72665c2bab7c6cea3899c422293349 *man/generic_stroke.Rd
+1260f1279533bafbf6dbf42aa783e360 *man/generic_stroke.Rd
 720709ce457adced4dae83541dce5794 *man/index_plot.Rd
-53e8f164511dc83958d0f36fce739161 *man/label_select.Rd
+d5b4e9b30ccda87e09cdc9d4b8bc22f4 *man/label_select.Rd
+b984296bcf3cd7dc1689fa4ed1cb8240 *man/metadata_names.Rd
 8b410ddb2248c3daadc0a87426fa9689 *man/quantile_cut.Rd
 e06b445017e33cd6b71fd53729574963 *man/score.Rd
 fc3061ff8205ce6cb6c986497c511126 *man/source_lines.Rd
 7b8ca1a8b10c337e6c9643c6bdd52f67 *man/stRoke-package.Rd
 44da65e3085bd5535c23c6696c41ae8c *man/talos.Rd
 a00b1635783d2370dfec1bda36b93f54 *man/win_prob.Rd
+3da0575a0d76bc97362acd41d51ada0c *man/write_ical.Rd
 0622a97a2aaa3c342f09636052c2d7f5 *tests/spelling.R
 08ad1c74a6a5f7c7b475e81a91603cb9 *tests/testthat.R
-3dc66050789e019cf7f2976e0920d595 *tests/testthat/test-age_calc.R
-c0f46e97cca78288e01a6d6649feb062 *tests/testthat/test-ci_plot.R
+5fb6673984f74d0a998e833973d60302 *tests/testthat/test-age_calc.R
+f85369812b788b1f9a84d4db9886865b *tests/testthat/test-ci_plot.R
+a5e72fd19733fe82b0e40956331b8744 *tests/testthat/test-contrast_text.R
 578042a909ee54b84365732273fcf8ed *tests/testthat/test-cpr_tools.R
+5e18ecbf3053fcf3c49c862b4fb234d8 *tests/testthat/test-ds2dd.R
 868d1b4dbf9459348df84331d8227ecd *tests/testthat/test-files_filter.R
 1adb7329ca6529d764aa753d3d7e76d4 *tests/testthat/test-generic_stroke.R
 950a332b0980fa3300b44d7e63d0609b *tests/testthat/test-index_plot.R
 713ece9e8f35122a9b2dc0898a52461c *tests/testthat/test-label_select.R
 75a469448993e4f045c66eaf9aa4c681 *tests/testthat/test-quantile_cut.R
 401d9442b7825e668d7595250befaddc *tests/testthat/test-source_lines.R
 6ca37a1f7de78af8fca45971cc503c34 *tests/testthat/test-win_prob.R
-f295cfd4bc7bfd5ca9d4d52c9f12cafd *vignettes/toolbox.Rmd
+c5d68da922f97cdba699b810801fc51d *tests/testthat/test-write_ical.R
+0d453a0ef1f7480551c56034e3e10142 *vignettes/ds2dd.Rmd
+a7b713db8daa62baacaeb66dbe5a8ef1 *vignettes/toolbox.Rmd

NAMESPACE

@@ -2,23 +2,33 @@
 
 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)
 export(label_select)
 export(quantile_cut)
 export(source_lines)
 export(win_prob)
+export(write_ical)
 import(ggplot2)
 import(utils)
 importFrom(MASS,polr)
+importFrom(calendar,ic_guid)
+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)
+importFrom(lubridate,hms)
+importFrom(lubridate,ymd)
 importFrom(rankinPlot,grottaBar)
 importFrom(stats,as.formula)
 importFrom(stats,binomial)

NEWS.md

@@ -1,5 +1,38 @@
+# 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:
+
+* This is the first update on CRAN.
+
+### Documentation
+
+* Badges, lots of badges
+
+
 # stRoke 23.1.7
 
+### Notes:
+
+* This is the version first published on CRAN as of 24.jan.2023.
+* This is also the version first published to zenodo.org, and with corresponding [doi: 10.5281/zenodo.7572023](https://doi.org/10.5281/zenodo.7572023).
+
 ### Functions:
 
 * redcap_read_tables() has been removed from the package for now. Looking to add it back later as a minimal data acquisition tool.

R/ci_plot.R

@@ -28,10 +28,10 @@ utils::globalVariables(c("vname", "lo", "or", "ord", "up"))
 #' talos[,"mrs_1"]<-factor(talos[,"mrs_1"],ordered=TRUE)
 #' ci_plot(ds = talos, x = "rtreat", y = "mrs_1", 
 #' vars = c("hypertension","diabetes"))
-#' # Model plot
-#' iris$ord<-factor(sample(1:3,size=nrow(iris),replace=TRUE),ordered=TRUE)
-#' lm <- MASS::polr(ord~., data=iris, Hess=TRUE, method="logistic")
-#' ci_plot(ds = lm, method="model")
+#' ## Model plot
+#' # iris$ord<-factor(sample(1:3,size=nrow(iris),replace=TRUE),ordered=TRUE)
+#' # lm <- MASS::polr(ord~., data=iris, Hess=TRUE, method="logistic")
+#' # ci_plot(ds = lm, method="model")
 ci_plot <-
   function(ds,
            x = NULL,

R/contrast_text.R

@@ -0,0 +1,52 @@
+
+
+#' @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/generic_stroke.R

@@ -23,8 +23,8 @@ utils::globalVariables(c("df","group","score","strata"))
 #' @importFrom stats as.formula
 #'
 #' @examples
-#' generic_stroke(df = stRoke::talos, group = "rtreat", score = "mrs_6", 
-#' variables = c("hypertension","diabetes","civil"))
+#' # generic_stroke(df = stRoke::talos, group = "rtreat", score = "mrs_6", 
+#' # variables = c("hypertension","diabetes","civil"))
 generic_stroke <-
   function(df,
            group,

R/label_select.R

@@ -20,8 +20,11 @@
 #' mrs_1~"One month mRS", 
 #' mrs_6~"Six months mRS", 
 #' '[Intercept]'~"Intercept")
-#' stRoke::talos[vars] |> 
-#' gtsummary::tbl_summary(label = label_select(labels_all,vars))
+#' label_select(labels_all,vars)
+#' 
+#' ## With gtsummary::tbl_summary()
+#' #stRoke::talos[vars] |> 
+#' #gtsummary::tbl_summary(label = label_select(labels_all,vars))
 label_select<-function(lst,vec){
   lst[match(vec,unlist(lapply(lst,function(i){i[[2]]})))]
 }

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"
+