diff --git a/DESCRIPTION b/DESCRIPTION index 060214e..abe6ebb 100644 --- a/DESCRIPTION +++ b/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] () Maintainer: Andreas Gammelgaard Damsbo Repository: CRAN -Date/Publication: 2023-01-24 10:20:09 UTC +Date/Publication: 2023-04-13 12:20:02 UTC diff --git a/MD5 b/MD5 index 4df0826..70041f0 100644 --- a/MD5 +++ b/MD5 @@ -1,52 +1,66 @@ -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 @@ -54,4 +68,6 @@ c0f46e97cca78288e01a6d6649feb062 *tests/testthat/test-ci_plot.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 diff --git a/NAMESPACE b/NAMESPACE index 8f7ff6c..5b214ef 100644 --- a/NAMESPACE +++ b/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) @@ -12,13 +14,21 @@ 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) diff --git a/NEWS.md b/NEWS.md index 3536ea2..6330f32 100644 --- a/NEWS.md +++ b/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. diff --git a/R/ci_plot.R b/R/ci_plot.R index adf5507..471ed5d 100644 --- a/R/ci_plot.R +++ b/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, diff --git a/R/contrast_text.R b/R/contrast_text.R new file mode 100644 index 0000000..ea82615 --- /dev/null +++ b/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) +} + diff --git a/R/ds2dd.R b/R/ds2dd.R new file mode 100644 index 0000000..a4ecc44 --- /dev/null +++ b/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 + } + + + diff --git a/R/generic_stroke.R b/R/generic_stroke.R index 02fddce..a558389 100644 --- a/R/generic_stroke.R +++ b/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, diff --git a/R/label_select.R b/R/label_select.R index 84177b9..0356e60 100644 --- a/R/label_select.R +++ b/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]]})))] } diff --git a/R/metadata.R b/R/metadata.R new file mode 100644 index 0000000..5be2f1d --- /dev/null +++ b/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" + diff --git a/R/write_ical.R b/R/write_ical.R new file mode 100644 index 0000000..21516c7 --- /dev/null +++ b/R/write_ical.R @@ -0,0 +1,173 @@ + + +#' Write ical object +#' +#' This function creates an ical file based on a data frame with mixed events. +#' Export as .ics file using `calendar::ic_write()`. +#' +#' @param df A data frame with the calendar data +#' @param date The name of the event date column in the data frame +#' @param date.end The name of the end date column in the data frame +#' @param title The name of the title column in the data frame +#' @param time.start The name of the start time column in the data frame +#' @param time.end The name of the end time column in the data frame +#' @param place The name of the place column in the data frame +#' @param place.def Default location to use when place is NA +#' @param time.def Default start time to use when time.start is NA +#' @param time.dur Default duration of the event in minutes, if time.end is NA +#' @param descr Name of description/notes column if any. +#' @param link Name of link column, if any. +#' @param t.zone A character string of time zone for events. The string must be +#' a time zone that is recognized by the user's OS. +#' +#' @return ical object +#' +#' @examples +#' df <- data.frame( +#' date = c("2020-02-10", "2020-02-11"), +#' date.end = c("2020-02-13",NA), +#' title = c("Conference", "Lunch"), +#' start = c("12:00:00", NA), +#' time.end = c("13:00:00", NA), +#' note = c("Hi there","Remember to come"), +#' link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/") +#' ) +#' +#' write_ical( +#' df, +#' date = "date", +#' date.end = "date.end", +#' title = "title", +#' time.start = "start", +#' time.end = "time.end", +#' place.def = "Conference Room", +#' descr = "note", +#' link = "link" +#' ) +#' +#' @export +#' +#' @importFrom lubridate ymd hms dminutes +#' @importFrom dplyr if_else +#' @importFrom calendar ic_guid ic_write +#' +#' @seealso +#' [calendar package](https://github.com/ATFutures/calendar/) +#' [icalendar standard webpage](https://icalendar.org) +#' +#' +write_ical <- + function(df, + date = "date", + date.end = NA, + title = "title", + time.start = "start", + time.end = "end", + place = NA, + place.def = NA, + time.def = "10:00:00", + time.dur = 60, + descr = NA, + link = NA, + t.zone = "CET") { + if (!date %in% colnames(df)) { + stop("Supplied date is not a valid column name") + } + + if (!title %in% colnames(df)) { + stop("Supplied title is not a valid column name") + } + + if (any(is.na(df[,title]))) { + stop("Missing title values are not allowed") + } + + if (is.character(place) & !place %in% colnames(df)) { + stop("Supplied place is not a valid column name") + } + + if (is.character(time.start) & !time.start %in% colnames(df)) { + stop("Supplied time.start is not a valid column name") + } + + if (is.character(time.end) & !time.end %in% colnames(df)) { + stop("Supplied time.end is not a valid column name") + } + + # Both ifelse() and dplyr::if_else() has problems and gives errors + # handling NA's, as everything is evaluated. + # This is my take on a approach by row. + df <- do.call(rbind, + lapply( + split(df, + seq_len(nrow(df))), + function(i) { + if (is.na(i[time.start])) { + i$start_time <- + lubridate::ymd(i[, date], tz = t.zone) + + lubridate::hms(time.def) + } + else if (!is.na(i[, time.start])) { + i$start_time <- + lubridate::ymd(i[, date], tz = t.zone) + + lubridate::hms(i[, time.start]) + } + + if (is.character(date.end) & + is.na(i[, time.end]) & + !is.na(i[, date.end])) { + stop("time.end is missing for some date.end") + } + else if (is.character(date.end) & + !is.na(i[, time.end]) & + !is.na(i[, date.end])) { + i$end_time <- + lubridate::ymd(i[, date.end], tz = t.zone) + + lubridate::hms(i[, time.end]) + } + else if (!is.na(i[, time.end])) { + i$end_time <- + lubridate::ymd(i[, date], tz = t.zone) + + lubridate::hms(i[, time.end]) + } else { + i$end_time <- + i$start_time + lubridate::dminutes(time.dur) + } + + i + + })) + + place_meet <- rep(NA, nrow(df)) + + if (!is.na(place)) { + place_meet <- df[, place] + } + + place_meet[is.na(place_meet)] <- place.def + + df_mod <- data.frame( + SUMMARY = df[, title], + DTSTART = df[, "start_time"], + DTEND = df[, "end_time"], + UID = replicate(nrow(df), calendar::ic_guid()), + stringsAsFactors = FALSE + ) + + if (!all(is.na(place_meet))) { + df_mod <- data.frame(df_mod, + LOCATION = place_meet) + } + + if (!is.na(link)) { + df_mod <- data.frame(df_mod, + URL = df[, link]) + } + + if (!is.na(descr)) { + df_mod <- data.frame(df_mod, + DESCRIPTION = df[, descr]) + } + + calendar::ical(df_mod) + } diff --git a/README.md b/README.md index 96c0533..9d03be8 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,11 @@ +[![GitHub R package version](https://img.shields.io/github/r-package/v/agdamsbo/stRoke)](https://github.com/agdamsbo/stRoke) +[![CRAN/METACRAN](https://img.shields.io/cran/v/stRoke)](https://CRAN.R-project.org/package=stRoke) +[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.7572023.svg)](https://doi.org/10.5281/zenodo.7572023) [![Github Actions](https://github.com/agdamsbo/stRoke/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/agdamsbo/stRoke/actions/workflows/R-CMD-check.yaml) [![Page deployed](https://github.com/agdamsbo/stRoke/actions/workflows/pages/pages-build-deployment/badge.svg)](https://github.com/agdamsbo/stRoke/actions/workflows/pages/pages-build-deployment) -[![codecov](https://codecov.io/github/agdamsbo/stRoke/branch/main/graph/badge.svg?token=U0RBZYSKG5)](https://codecov.io/github/agdamsbo/stRoke) +[![Codecov test coverage](https://codecov.io/gh/agdamsbo/stRoke/branch/main/graph/badge.svg)](https://app.codecov.io/gh/agdamsbo/stRoke?branch=main) +[![CRAN downloads](https://cranlogs.r-pkg.org/badges/grand-total/stRoke)](https://cran.r-project.org/package=stRoke) # stRoke package @@ -16,7 +20,13 @@ This package is [shared on GitHub](https://github.com/agdamsbo/stRoke), and you # Installation -The package can be installed from GitHub: +The package can be installed directly from CRAN: + +``` +install.packages("stRoke") +``` + +The latest version in development can be installed from GitHub: ``` remotes::install_github("agdamsbo/stRoke") diff --git a/build/vignette.rds b/build/vignette.rds index f49f265..f2876a8 100644 Binary files a/build/vignette.rds and b/build/vignette.rds differ diff --git a/data/metadata_names.rda b/data/metadata_names.rda new file mode 100644 index 0000000..cb869c8 Binary files /dev/null and b/data/metadata_names.rda differ diff --git a/inst/WORDLIST b/inst/WORDLIST index 9da1026..7bbe7d5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,18 +1,23 @@ Andreas Changelog +Codecov DDMMYY DOI +DataDictionary Gammelgaard Github Kraglund +METACRAN NA's OLR ORCID OpenAI's +REDCap REDCapRITS RStudio Randomisation STROKEAHA +StackOverflow Sys TALOS Vectorised @@ -23,6 +28,7 @@ al annonymized bstfun calc +characterstrings chatgpt christophergandrud ci @@ -37,6 +43,7 @@ ddmmyyxxxx difftime dk doi +ds eeptools eg et @@ -50,15 +57,26 @@ gpttools grotta grottaBar gtsummary +https +ical +icalendar +ics inteRgrate +jan jss lm lst +luminance mRS +og olr recognised +rgb sapply +stackoverflow +teppo vapply vec winP xxxx +zenodo diff --git a/inst/doc/ds2dd.R b/inst/doc/ds2dd.R new file mode 100644 index 0000000..256f6f9 --- /dev/null +++ b/inst/doc/ds2dd.R @@ -0,0 +1,38 @@ +## ---- include = FALSE--------------------------------------------------------- +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +## ----setup-------------------------------------------------------------------- +library(stRoke) + +## ----------------------------------------------------------------------------- +data("talos") +ds <- talos +# As the data set lacks an ID column, one is added +ds$id <- seq_len(nrow(ds)) + +## ----------------------------------------------------------------------------- +datadictionary <- ds2dd(ds,record.id = "id",include.column.names = TRUE) + +## ----eval=FALSE--------------------------------------------------------------- +# write.csv(datadictionary$DataDictionary,"datadictionary.csv") + +## ----eval=FALSE--------------------------------------------------------------- +# REDCapR::redcap_metadata_write( +# datadictionary$DataDictionary, +# redcap_uri = keyring::key_get("DB_URI"), +# token = keyring::key_get("DB_TOKEN") +# ) + +## ----eval=FALSE--------------------------------------------------------------- +# # new column names are applied +# colnames(ds) <- datadictionary$`Column names` +# +# REDCapR::redcap_write( +# ds, +# redcap_uri = keyring::key_get("DB_URI"), +# token = keyring::key_get("DB_TOKEN") +# ) + diff --git a/inst/doc/ds2dd.Rmd b/inst/doc/ds2dd.Rmd new file mode 100644 index 0000000..34f2464 --- /dev/null +++ b/inst/doc/ds2dd.Rmd @@ -0,0 +1,87 @@ +--- +title: "ds2dd" +date: "`r Sys.Date()`" +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") +ds <- talos +# As the data set lacks an ID column, one is added +ds$id <- seq_len(nrow(ds)) +``` + +## Step 2 - Create the DataDictionary + +```{r} +datadictionary <- ds2dd(ds,record.id = "id",include.column.names = TRUE) +``` + +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. + +The function will transform column names to lower case and substitute spaces for underscores. The output is a list with the DataDictionary and a vector of new column names for the dataset to fit the meta data. + +## Step 3 - Meta data 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,"datadictionary.csv") +``` + +### Upload with `REDCapR` + +```{r eval=FALSE} +REDCapR::redcap_metadata_write( + datadictionary$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). + +## Step 4 - Data upload + +The same two options are available for data upload as meta data upload: manual or through `REDCapR`. + +Only the latter is shown here. + +```{r eval=FALSE} +# new column names are applied +colnames(ds) <- datadictionary$`Column names` + +REDCapR::redcap_write( + ds, + redcap_uri = keyring::key_get("DB_URI"), + token = keyring::key_get("DB_TOKEN") +) +``` + diff --git a/inst/doc/ds2dd.html b/inst/doc/ds2dd.html new file mode 100644 index 0000000..4461553 --- /dev/null +++ b/inst/doc/ds2dd.html @@ -0,0 +1,425 @@ + + + + + + + + + + + + + + + +ds2dd + + + + + + + + + + + + + + + + + + + + + + + + + + +

ds2dd

+

2023-04-13

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

+
data("talos")
+ds <- talos
+# As the data set lacks an ID column, one is added
+ds$id <- seq_len(nrow(ds))
+
+
+

Step 2 - Create the DataDictionary

+
datadictionary <- ds2dd(ds,record.id = "id",include.column.names = TRUE)
+

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.

+

The function will transform column names to lower case and substitute +spaces for underscores. The output is a list with the DataDictionary and +a vector of new column names for the dataset to fit the meta data.

+
+
+

Step 3 - Meta data 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

+
write.csv(datadictionary$DataDictionary,"datadictionary.csv")
+
+
+

Upload with REDCapR

+
REDCapR::redcap_metadata_write(
+  datadictionary$DataDictionary,
+  redcap_uri = keyring::key_get("DB_URI"),
+  token = keyring::key_get("DB_TOKEN")
+)
+

In the “REDCap R +Handbook” more is written on interfacing with REDCap in R using the +library(keyring)to store credentials in chapter +1.1.

+
+
+
+

Step 4 - Data upload

+

The same two options are available for data upload as meta data +upload: manual or through REDCapR.

+

Only the latter is shown here.

+
# new column names are applied
+colnames(ds) <- datadictionary$`Column names`
+
+REDCapR::redcap_write(
+  ds,
+  redcap_uri = keyring::key_get("DB_URI"),
+  token = keyring::key_get("DB_TOKEN")
+)
+
+
+ + + + + + + + + + + diff --git a/inst/doc/toolbox.Rmd b/inst/doc/toolbox.Rmd index 67d3f23..5e9f075 100644 --- a/inst/doc/toolbox.Rmd +++ b/inst/doc/toolbox.Rmd @@ -1,5 +1,6 @@ --- title: "Toolbox" +date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Toolbox} @@ -24,7 +25,7 @@ My own toolbox in my small workshop is a mix of some old, worn, well proven tool I have tried to collect tools and functions from other packages that I use regularly in addition to functions that I have written myself to fill use cases, that I have not been able to find solutions to elsewhere. -In documenting and testing the package, I have used [OpenAI's](https://beta.openai.com/overview) chatgpt with [gpttools](https://jameshwade.github.io/gpttools/). The chatgpt is an interesting tool, that is in no way perfect, but it helps with tedious tasks. Both `gpttools` and [`gptstudio`](https://michelnivard.github.io/gptstudio/) are interesting implementations in R and RStudio. +In documenting and testing the package, I have used [OpenAI's](https://platform.openai.com/overview) chatgpt with [gpttools](https://jameshwade.github.io/gpttools/). The chatgpt is an interesting tool, that is in no way perfect, but it helps with tedious tasks. Both `gpttools` and [`gptstudio`](https://michelnivard.github.io/gptstudio/) are interesting implementations in R and RStudio. ## CPR manipulations {#cpr-intro} diff --git a/inst/doc/toolbox.html b/inst/doc/toolbox.html index d3f40d7..6b73fba 100644 --- a/inst/doc/toolbox.html +++ b/inst/doc/toolbox.html @@ -11,6 +11,7 @@ + Toolbox @@ -337,6 +338,7 @@

Toolbox

+

2023-04-13

@@ -350,7 +352,7 @@

A toolbox

I use regularly in addition to functions that I have written myself to fill use cases, that I have not been able to find solutions to elsewhere.

-

In documenting and testing the package, I have used OpenAI’s chatgpt with gpttools. The chatgpt +

In documenting and testing the package, I have used OpenAI’s chatgpt with gpttools. The chatgpt is an interesting tool, that is in no way perfect, but it helps with tedious tasks. Both gpttools and gptstudio are interesting implementations in R and RStudio.

@@ -458,12 +460,12 @@

generic_stroke()

variables = c("hypertension", "diabetes", "civil")) #> Waiting for profiling to be done... #> $`Table 1` -#> <div id="khrgrwoefe" style="padding-left:0px;padding-right:0px;padding-top:10px;padding-bottom:10px;overflow-x:auto;overflow-y:auto;width:auto;height:auto;"> +#> <div id="npykwtdbbe" style="padding-left:0px;padding-right:0px;padding-top:10px;padding-bottom:10px;overflow-x:auto;overflow-y:auto;width:auto;height:auto;"> #> <style>html { #> font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, Oxygen, Ubuntu, Cantarell, 'Helvetica Neue', 'Fira Sans', 'Droid Sans', Arial, sans-serif; #> } #> -#> #khrgrwoefe .gt_table { +#> #npykwtdbbe .gt_table { #> display: table; #> border-collapse: collapse; #> margin-left: auto; @@ -488,7 +490,7 @@

generic_stroke()

#> border-left-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_heading { +#> #npykwtdbbe .gt_heading { #> background-color: #FFFFFF; #> text-align: center; #> border-bottom-color: #FFFFFF; @@ -500,12 +502,12 @@

generic_stroke()

#> border-right-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_caption { +#> #npykwtdbbe .gt_caption { #> padding-top: 4px; #> padding-bottom: 4px; #> } #> -#> #khrgrwoefe .gt_title { +#> #npykwtdbbe .gt_title { #> color: #333333; #> font-size: 125%; #> font-weight: initial; @@ -517,7 +519,7 @@

generic_stroke()

#> border-bottom-width: 0; #> } #> -#> #khrgrwoefe .gt_subtitle { +#> #npykwtdbbe .gt_subtitle { #> color: #333333; #> font-size: 85%; #> font-weight: initial; @@ -529,13 +531,13 @@

generic_stroke()

#> border-top-width: 0; #> } #> -#> #khrgrwoefe .gt_bottom_border { +#> #npykwtdbbe .gt_bottom_border { #> border-bottom-style: solid; #> border-bottom-width: 2px; #> border-bottom-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_col_headings { +#> #npykwtdbbe .gt_col_headings { #> border-top-style: solid; #> border-top-width: 2px; #> border-top-color: #D3D3D3; @@ -550,7 +552,7 @@

generic_stroke()

#> border-right-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_col_heading { +#> #npykwtdbbe .gt_col_heading { #> color: #333333; #> background-color: #FFFFFF; #> font-size: 100%; @@ -570,7 +572,7 @@

generic_stroke()

#> overflow-x: hidden; #> } #> -#> #khrgrwoefe .gt_column_spanner_outer { +#> #npykwtdbbe .gt_column_spanner_outer { #> color: #333333; #> background-color: #FFFFFF; #> font-size: 100%; @@ -582,15 +584,15 @@

generic_stroke()

#> padding-right: 4px; #> } #> -#> #khrgrwoefe .gt_column_spanner_outer:first-child { +#> #npykwtdbbe .gt_column_spanner_outer:first-child { #> padding-left: 0; #> } #> -#> #khrgrwoefe .gt_column_spanner_outer:last-child { +#> #npykwtdbbe .gt_column_spanner_outer:last-child { #> padding-right: 0; #> } #> -#> #khrgrwoefe .gt_column_spanner { +#> #npykwtdbbe .gt_column_spanner { #> border-bottom-style: solid; #> border-bottom-width: 2px; #> border-bottom-color: #D3D3D3; @@ -602,7 +604,7 @@

generic_stroke()

#> width: 100%; #> } #> -#> #khrgrwoefe .gt_group_heading { +#> #npykwtdbbe .gt_group_heading { #> padding-top: 8px; #> padding-bottom: 8px; #> padding-left: 5px; @@ -628,7 +630,7 @@

generic_stroke()

#> text-align: left; #> } #> -#> #khrgrwoefe .gt_empty_group_heading { +#> #npykwtdbbe .gt_empty_group_heading { #> padding: 0.5px; #> color: #333333; #> background-color: #FFFFFF; @@ -643,15 +645,15 @@

generic_stroke()

#> vertical-align: middle; #> } #> -#> #khrgrwoefe .gt_from_md > :first-child { +#> #npykwtdbbe .gt_from_md > :first-child { #> margin-top: 0; #> } #> -#> #khrgrwoefe .gt_from_md > :last-child { +#> #npykwtdbbe .gt_from_md > :last-child { #> margin-bottom: 0; #> } #> -#> #khrgrwoefe .gt_row { +#> #npykwtdbbe .gt_row { #> padding-top: 8px; #> padding-bottom: 8px; #> padding-left: 5px; @@ -670,7 +672,7 @@

generic_stroke()

#> overflow-x: hidden; #> } #> -#> #khrgrwoefe .gt_stub { +#> #npykwtdbbe .gt_stub { #> color: #333333; #> background-color: #FFFFFF; #> font-size: 100%; @@ -683,7 +685,7 @@

generic_stroke()

#> padding-right: 5px; #> } #> -#> #khrgrwoefe .gt_stub_row_group { +#> #npykwtdbbe .gt_stub_row_group { #> color: #333333; #> background-color: #FFFFFF; #> font-size: 100%; @@ -697,11 +699,11 @@

generic_stroke()

#> vertical-align: top; #> } #> -#> #khrgrwoefe .gt_row_group_first td { +#> #npykwtdbbe .gt_row_group_first td { #> border-top-width: 2px; #> } #> -#> #khrgrwoefe .gt_summary_row { +#> #npykwtdbbe .gt_summary_row { #> color: #333333; #> background-color: #FFFFFF; #> text-transform: inherit; @@ -711,16 +713,16 @@

generic_stroke()

#> padding-right: 5px; #> } #> -#> #khrgrwoefe .gt_first_summary_row { +#> #npykwtdbbe .gt_first_summary_row { #> border-top-style: solid; #> border-top-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_first_summary_row.thick { +#> #npykwtdbbe .gt_first_summary_row.thick { #> border-top-width: 2px; #> } #> -#> #khrgrwoefe .gt_last_summary_row { +#> #npykwtdbbe .gt_last_summary_row { #> padding-top: 8px; #> padding-bottom: 8px; #> padding-left: 5px; @@ -730,7 +732,7 @@

generic_stroke()

#> border-bottom-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_grand_summary_row { +#> #npykwtdbbe .gt_grand_summary_row { #> color: #333333; #> background-color: #FFFFFF; #> text-transform: inherit; @@ -740,7 +742,7 @@

generic_stroke()

#> padding-right: 5px; #> } #> -#> #khrgrwoefe .gt_first_grand_summary_row { +#> #npykwtdbbe .gt_first_grand_summary_row { #> padding-top: 8px; #> padding-bottom: 8px; #> padding-left: 5px; @@ -750,11 +752,11 @@

generic_stroke()

#> border-top-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_striped { +#> #npykwtdbbe .gt_striped { #> background-color: rgba(128, 128, 128, 0.05); #> } #> -#> #khrgrwoefe .gt_table_body { +#> #npykwtdbbe .gt_table_body { #> border-top-style: solid; #> border-top-width: 2px; #> border-top-color: #D3D3D3; @@ -763,7 +765,7 @@

generic_stroke()

#> border-bottom-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_footnotes { +#> #npykwtdbbe .gt_footnotes { #> color: #333333; #> background-color: #FFFFFF; #> border-bottom-style: none; @@ -777,7 +779,7 @@

generic_stroke()

#> border-right-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_footnote { +#> #npykwtdbbe .gt_footnote { #> margin: 0px; #> font-size: 90%; #> padding-left: 4px; @@ -786,7 +788,7 @@

generic_stroke()

#> padding-right: 5px; #> } #> -#> #khrgrwoefe .gt_sourcenotes { +#> #npykwtdbbe .gt_sourcenotes { #> color: #333333; #> background-color: #FFFFFF; #> border-bottom-style: none; @@ -800,7 +802,7 @@

generic_stroke()

#> border-right-color: #D3D3D3; #> } #> -#> #khrgrwoefe .gt_sourcenote { +#> #npykwtdbbe .gt_sourcenote { #> font-size: 90%; #> padding-top: 4px; #> padding-bottom: 4px; @@ -808,64 +810,64 @@

generic_stroke()

#> padding-right: 5px; #> } #> -#> #khrgrwoefe .gt_left { +#> #npykwtdbbe .gt_left { #> text-align: left; #> } #> -#> #khrgrwoefe .gt_center { +#> #npykwtdbbe .gt_center { #> text-align: center; #> } #> -#> #khrgrwoefe .gt_right { +#> #npykwtdbbe .gt_right { #> text-align: right; #> font-variant-numeric: tabular-nums; #> } #> -#> #khrgrwoefe .gt_font_normal { +#> #npykwtdbbe .gt_font_normal { #> font-weight: normal; #> } #> -#> #khrgrwoefe .gt_font_bold { +#> #npykwtdbbe .gt_font_bold { #> font-weight: bold; #> } #> -#> #khrgrwoefe .gt_font_italic { +#> #npykwtdbbe .gt_font_italic { #> font-style: italic; #> } #> -#> #khrgrwoefe .gt_super { +#> #npykwtdbbe .gt_super { #> font-size: 65%; #> } #> -#> #khrgrwoefe .gt_footnote_marks { +#> #npykwtdbbe .gt_footnote_marks { #> font-style: italic; #> font-weight: normal; #> font-size: 75%; #> vertical-align: 0.4em; #> } #> -#> #khrgrwoefe .gt_asterisk { +#> #npykwtdbbe .gt_asterisk { #> font-size: 100%; #> vertical-align: 0; #> } #> -#> #khrgrwoefe .gt_indent_1 { +#> #npykwtdbbe .gt_indent_1 { #> text-indent: 5px; #> } #> -#> #khrgrwoefe .gt_indent_2 { +#> #npykwtdbbe .gt_indent_2 { #> text-indent: 10px; #> } #> -#> #khrgrwoefe .gt_indent_3 { +#> #npykwtdbbe .gt_indent_3 { #> text-indent: 15px; #> } #> -#> #khrgrwoefe .gt_indent_4 { +#> #npykwtdbbe .gt_indent_4 { #> text-indent: 20px; #> } #> -#> #khrgrwoefe .gt_indent_5 { +#> #npykwtdbbe .gt_indent_5 { #> text-indent: 25px; #> } #> </style> diff --git a/man/ci_plot.Rd b/man/ci_plot.Rd index 00792cb..e196432 100644 --- a/man/ci_plot.Rd +++ b/man/ci_plot.Rd @@ -47,8 +47,8 @@ data(talos) 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") } diff --git a/man/contrast_text.Rd b/man/contrast_text.Rd new file mode 100644 index 0000000..6e89f91 --- /dev/null +++ b/man/contrast_text.Rd @@ -0,0 +1,49 @@ +% 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") +} diff --git a/man/ds2dd.Rd b/man/ds2dd.Rd new file mode 100644 index 0000000..8154894 --- /dev/null +++ b/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) +} diff --git a/man/generic_stroke.Rd b/man/generic_stroke.Rd index 31b0f36..390e646 100644 --- a/man/generic_stroke.Rd +++ b/man/generic_stroke.Rd @@ -26,6 +26,6 @@ Please just use this function for illustration purposes. To dos: modify grottaBar and include as own function. } \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")) } diff --git a/man/label_select.Rd b/man/label_select.Rd index 3bfd05e..707e6db 100644 --- a/man/label_select.Rd +++ b/man/label_select.Rd @@ -27,6 +27,9 @@ hypertension~"Known hypertension", 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)) } diff --git a/man/metadata_names.Rd b/man/metadata_names.Rd new file mode 100644 index 0000000..65c3012 --- /dev/null +++ b/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} diff --git a/man/write_ical.Rd b/man/write_ical.Rd new file mode 100644 index 0000000..06bfd3b --- /dev/null +++ b/man/write_ical.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/write_ical.R +\name{write_ical} +\alias{write_ical} +\title{Write ical object} +\usage{ +write_ical( + df, + date = "date", + date.end = NA, + title = "title", + time.start = "start", + time.end = "end", + place = NA, + place.def = NA, + time.def = "10:00:00", + time.dur = 60, + descr = NA, + link = NA, + t.zone = "CET" +) +} +\arguments{ +\item{df}{A data frame with the calendar data} + +\item{date}{The name of the event date column in the data frame} + +\item{date.end}{The name of the end date column in the data frame} + +\item{title}{The name of the title column in the data frame} + +\item{time.start}{The name of the start time column in the data frame} + +\item{time.end}{The name of the end time column in the data frame} + +\item{place}{The name of the place column in the data frame} + +\item{place.def}{Default location to use when place is NA} + +\item{time.def}{Default start time to use when time.start is NA} + +\item{time.dur}{Default duration of the event in minutes, if time.end is NA} + +\item{descr}{Name of description/notes column if any.} + +\item{link}{Name of link column, if any.} + +\item{t.zone}{A character string of time zone for events. The string must be +a time zone that is recognized by the user's OS.} +} +\value{ +ical object +} +\description{ +This function creates an ical file based on a data frame with mixed events. +Export as .ics file using \code{calendar::ic_write()}. +} +\examples{ +df <- data.frame( + date = c("2020-02-10", "2020-02-11"), + date.end = c("2020-02-13",NA), + title = c("Conference", "Lunch"), + start = c("12:00:00", NA), + time.end = c("13:00:00", NA), + note = c("Hi there","Remember to come"), + link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/") +) + +write_ical( + df, + date = "date", + date.end = "date.end", + title = "title", + time.start = "start", + time.end = "time.end", + place.def = "Conference Room", + descr = "note", + link = "link" +) + +} +\seealso{ +\href{https://github.com/ATFutures/calendar/}{calendar package} +\href{https://icalendar.org}{icalendar standard webpage} +} diff --git a/tests/testthat/test-age_calc.R b/tests/testthat/test-age_calc.R index 5832b72..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,10 +56,17 @@ 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")) }) test_that("age_calc throws an error when wrong format", { expect_error(age_calc("2020-01-01", as.Date("2000-01-01"), units = "hours")) }) + +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")) +}) diff --git a/tests/testthat/test-ci_plot.R b/tests/testthat/test-ci_plot.R index ebce41c..b2a4e09 100644 --- a/tests/testthat/test-ci_plot.R +++ b/tests/testthat/test-ci_plot.R @@ -63,3 +63,25 @@ test_that("ci_plot produces a valid plot with method='model'", { "ggplot" )) }) + +test_that("ci_plot throws error on method", { + data(talos) + talos[, "mrs_1"] <- factor(talos[, "mrs_1"], ordered = TRUE) + testthat::expect_error(ci_plot( + ds = talos, + x = "rtreat", + y = "mrs_1", + vars = c("hypertension", "diabetes"),method = "model" + )) +}) + +test_that("ci_plot throws error on wrong method", { + data(talos) + talos[, "mrs_1"] <- factor(talos[, "mrs_1"], ordered = TRUE) + testthat::expect_error(ci_plot( + ds = talos, + x = "rtreat", + y = "mrs_1", + vars = c("hypertension", "diabetes"),method = "wrong" + )) +}) diff --git a/tests/testthat/test-contrast_text.R b/tests/testthat/test-contrast_text.R new file mode 100644 index 0000000..6ceb3be --- /dev/null +++ b/tests/testthat/test-contrast_text.R @@ -0,0 +1,12 @@ +# 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") +}) \ No newline at end of file diff --git a/tests/testthat/test-ds2dd.R b/tests/testthat/test-ds2dd.R new file mode 100644 index 0000000..8dc926c --- /dev/null +++ b/tests/testthat/test-ds2dd.R @@ -0,0 +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") +}) + + +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") +}) diff --git a/tests/testthat/test-write_ical.R b/tests/testthat/test-write_ical.R new file mode 100644 index 0000000..c9909df --- /dev/null +++ b/tests/testthat/test-write_ical.R @@ -0,0 +1,92 @@ +test_that("write_ical() returns a ical object", { + df <- data.frame( + date = c("2020-02-10", "2020-02-11", "2020-02-11"), + date.end = c("2020-02-13",NA,NA), + title = c("Conference", "Lunch", "Walk"), + start = c("12:00:00", NA, "08:00:00"), + time.end = c("13:00:00", NA, "17:30:00"), + note = c("Hi there","Remember to come", ""), + link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/", "") + ) + + expect_s3_class( + write_ical( + df, + date.end = "date.end", + time.end = "time.end", + place.def = "Home", + descr = "note", + link = "link" + ), + "ical" + ) +}) + +test_that("write_ical() returns a ical object", { + df <- data.frame( + date = c("2020-02-10", "2020-02-11", "2020-02-11"), + date.end = c("2020-02-13",NA,NA), + title = c("Conference", "Lunch", "Walk"), + start = c("12:00:00", NA, "08:00:00"), + time.end = c("13:00:00", NA, "17:30:00"), + place = c("Home", "Work", NA), + note = c("Hi there","Remember to come", ""), + link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/", "") + ) + + expect_s3_class( + write_ical( + df, + date.end = "date.end", + time.end = "time.end", + place = "place", + descr = "note", + link = "link" + ), + "ical" + ) +}) + +test_that("write_ical() returns error", { + df <- data.frame( + date = c("2020-02-10", "2020-02-11"), + title = c("Conference", "Lunch"), + start = c("12:00:00", NA), + end = c("13:00:00", NA), + note = c("Hi there","Remember to come"), + link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/") + ) + expect_error(write_ical(df, date = "wrong")) + expect_error(write_ical(df, place = "wrong")) + expect_error(write_ical(df, title = "wrong")) + expect_error(write_ical(df, time.start = "wrong")) + expect_error(write_ical(df, time.end = "wrong")) +}) + +test_that("write_ical() returns error", { + df <- data.frame( + date = c("2020-02-10", "2020-02-11"), + date.end = c(NA,"2020-02-13"), + title = c("Conference", "Lunch"), + start = c("12:00:00", NA), + end = c("13:00:00", NA), + note = c("Hi there","Remember to come"), + link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/") + ) + expect_error(write_ical(df, + date.end = "date.end")) +}) + +test_that("write_ical() returns error", { + df <- data.frame( + date = c("2020-02-10", "2020-02-11"), + date.end = c("2020-02-13",NA), + title = c(NA, "Lunch"), + start = c("12:00:00", NA), + end = c("13:00:00", NA), + note = c("Hi there","Remember to come"), + link = c("https://icalendar.org","https://agdamsbo.github.io/stRoke/") + ) + expect_error(write_ical(df, + date.end = "date.end")) +}) \ No newline at end of file diff --git a/vignettes/ds2dd.Rmd b/vignettes/ds2dd.Rmd new file mode 100644 index 0000000..34f2464 --- /dev/null +++ b/vignettes/ds2dd.Rmd @@ -0,0 +1,87 @@ +--- +title: "ds2dd" +date: "`r Sys.Date()`" +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") +ds <- talos +# As the data set lacks an ID column, one is added +ds$id <- seq_len(nrow(ds)) +``` + +## Step 2 - Create the DataDictionary + +```{r} +datadictionary <- ds2dd(ds,record.id = "id",include.column.names = TRUE) +``` + +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. + +The function will transform column names to lower case and substitute spaces for underscores. The output is a list with the DataDictionary and a vector of new column names for the dataset to fit the meta data. + +## Step 3 - Meta data 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,"datadictionary.csv") +``` + +### Upload with `REDCapR` + +```{r eval=FALSE} +REDCapR::redcap_metadata_write( + datadictionary$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). + +## Step 4 - Data upload + +The same two options are available for data upload as meta data upload: manual or through `REDCapR`. + +Only the latter is shown here. + +```{r eval=FALSE} +# new column names are applied +colnames(ds) <- datadictionary$`Column names` + +REDCapR::redcap_write( + ds, + redcap_uri = keyring::key_get("DB_URI"), + token = keyring::key_get("DB_TOKEN") +) +``` + diff --git a/vignettes/toolbox.Rmd b/vignettes/toolbox.Rmd index 67d3f23..5e9f075 100644 --- a/vignettes/toolbox.Rmd +++ b/vignettes/toolbox.Rmd @@ -1,5 +1,6 @@ --- title: "Toolbox" +date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Toolbox} @@ -24,7 +25,7 @@ My own toolbox in my small workshop is a mix of some old, worn, well proven tool I have tried to collect tools and functions from other packages that I use regularly in addition to functions that I have written myself to fill use cases, that I have not been able to find solutions to elsewhere. -In documenting and testing the package, I have used [OpenAI's](https://beta.openai.com/overview) chatgpt with [gpttools](https://jameshwade.github.io/gpttools/). The chatgpt is an interesting tool, that is in no way perfect, but it helps with tedious tasks. Both `gpttools` and [`gptstudio`](https://michelnivard.github.io/gptstudio/) are interesting implementations in R and RStudio. +In documenting and testing the package, I have used [OpenAI's](https://platform.openai.com/overview) chatgpt with [gpttools](https://jameshwade.github.io/gpttools/). The chatgpt is an interesting tool, that is in no way perfect, but it helps with tedious tasks. Both `gpttools` and [`gptstudio`](https://michelnivard.github.io/gptstudio/) are interesting implementations in R and RStudio. ## CPR manipulations {#cpr-intro}