spelling

.Rbuildignore

@@ -1,3 +1,5 @@
+^renv$
+^renv\.lock$
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\.github$

.github/workflows/rhub.yaml

@@ -0,0 +1,95 @@
+# R-hub's generic GitHub Actions workflow file. It's canonical location is at
+# https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml
+# You can update this file to a newer version using the rhub2 package:
+#
+# rhub::rhub_setup()
+#
+# It is unlikely that you need to modify this file manually.
+
+name: R-hub
+run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}"
+
+on:
+  workflow_dispatch:
+    inputs:
+      config:
+        description: 'A comma separated list of R-hub platforms to use.'
+        type: string
+        default: 'linux,windows,macos'
+      name:
+        description: 'Run name. You can leave this empty now.'
+        type: string
+      id:
+        description: 'Unique ID. You can leave this empty now.'
+        type: string
+
+jobs:
+
+  setup:
+    runs-on: ubuntu-latest
+    outputs:
+      containers: ${{ steps.rhub-setup.outputs.containers }}
+      platforms: ${{ steps.rhub-setup.outputs.platforms }}
+
+    steps:
+    # NO NEED TO CHECKOUT HERE
+    - uses: r-hub/actions/setup@v1
+      with:
+        config: ${{ github.event.inputs.config }}
+      id: rhub-setup
+
+  linux-containers:
+    needs: setup
+    if: ${{ needs.setup.outputs.containers != '[]' }}
+    runs-on: ubuntu-latest
+    name: ${{ matrix.config.label }}
+    strategy:
+      fail-fast: false
+      matrix:
+        config: ${{ fromJson(needs.setup.outputs.containers) }}
+    container:
+      image: ${{ matrix.config.container }}
+
+    steps:
+      - uses: r-hub/actions/checkout@v1
+      - uses: r-hub/actions/platform-info@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/setup-deps@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/run-check@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+
+  other-platforms:
+    needs: setup
+    if: ${{ needs.setup.outputs.platforms != '[]' }}
+    runs-on: ${{ matrix.config.os }}
+    name: ${{ matrix.config.label }}
+    strategy:
+      fail-fast: false
+      matrix:
+        config: ${{ fromJson(needs.setup.outputs.platforms) }}
+
+    steps:
+      - uses: r-hub/actions/checkout@v1
+      - uses: r-hub/actions/setup-r@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}
+      - uses: r-hub/actions/platform-info@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/setup-deps@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}
+      - uses: r-hub/actions/run-check@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}

DESCRIPTION

@@ -1,11 +1,11 @@
 Package: stRoke
 Title: Clinical Stroke Research
-Version: 23.9.1
+Version: 24.10.1
 Authors@R: 
     person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154"))
-Description: This is an R-toolbox of custom functions for convenient data management 
-    and analysis in clinical health research and teaching.
+Description: A collection of tools for clinical trial data management and 
+    analysis in research and teaching.
     The package is mainly collected for personal use, but any use beyond that is encouraged.
     This package has migrated functions from 'agdamsbo/daDoctoR', and new functions has been added.
     Version follows months and year. See NEWS/Changelog for release notes.
@@ -17,16 +17,18 @@ BugReports: https://github.com/agdamsbo/stRoke/issues
 License: GPL-3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 LazyData: true
 Suggests:
-    covr,
-    devtools,
     knitr,
     rmarkdown,
+    testthat,
+    here,
     spelling,
-    testthat (>= 3.0.0)
-Language: en-US
+    usethis,
+    pak,
+    roxygen2,
+    devtools
 Config/testthat/edition: 3
 Imports: 
     calendar,
@@ -39,7 +41,10 @@ Imports:
     rankinPlot,
     stats,
     tidyr,
-    utils
+    utils,
+    tibble,
+    tidyselect
 Depends: 
     R (>= 2.10)
 VignetteBuilder: knitr
+Language: en-US

NAMESPACE

@@ -15,6 +15,7 @@ export(files_filter)
 export(generic_stroke)
 export(index_plot)
 export(label_select)
+export(mfi_domains)
 export(n_chunks)
 export(pase_calc)
 export(quantile_cut)

NEWS.md

@@ -1,3 +1,18 @@
+# stRoke 24.10.1
+
+This version marks a significant change in the contents and focus of this package. Going forward I will include functions with a focus on handling clinical trial data from my own stroke research.
+Other functions for general data management an project management has been migrated to the [`project.aid`](https://agdamsbo.github.io/project.aid/) package, which is moving towards CRAN submission. Install dev-version with `pak::pak("agdamsbo/project.aid")`.
+
+### Functions:
+
+* UPDATE: `pase_calc()` updated for uniform column naming in output as well as streamlining the function a bit.
+
+* Moving: The following functions are moved to `agdamsbo/project.aid` to focus on (stroke) trial related functions: `str_extract()`, `add_padding()`, `age_calc()`, `chunks_of_n()`, `contrast_text()`, `files_filter()`, `quantile_cut()`, `write_ical()`.
+
+* NEW: `mfi_calc()` calculates domain scores from the MFI questionnaire. Takes data frame of 20 ordered as the questionnaire. Default is to reverse questions with reverse scoring.
+
+Checks set up with `rhub` v2
+
 # stRoke 23.9.1
 
 ### Functions:

R/add_padding.R

@@ -1,16 +1,18 @@
-#' Add padding to string
+#' MOVED Add padding to string
 #'
 #' @param d vector of strings or numbers
 #' @param length final string length
 #' @param after if padding should be added after as opposed to default before
 #' @param pad padding string of length 1
+#' @param lead leading string for all. Number or character vector. Cycled.
+#' @param tail tailing string for all. Number or character vector. Cycled.
 #'
 #' @return vector or character strings of same length.
 #' @export
 #'
 #' @examples
-#' add_padding(sample(1:200,5))
-add_padding <- function(d,length=NULL,after=FALSE,pad="0"){
+#' add_padding(sample(1:200,5),tail="AA",lead=c(2,3,"e"))
+add_padding <- function(d,length=NULL,after=FALSE,pad="0",lead=NULL,tail=NULL){
   if (!is.vector(d)) {
     stop("Please supply vector")
   }
@@ -31,8 +33,11 @@ add_padding <- function(d,length=NULL,after=FALSE,pad="0"){
     paste(rep(pad,i),collapse="")}))
   
   if (after) {
-    paste0(d,ps)
+    out <- paste0(d,ps)
   } else {
-    paste0(ps,d)
+    out <- paste0(ps,d)
   }
+  
+  paste0(lead,out,tail)
+
 }

R/chunks_of_n.R

@@ -1,4 +1,4 @@
-#' Split to chunks of size n
+#' MOVED Split to chunks of size n
 #'
 #' @param d data. Can be vector or data frame.
 #' @param n number of chunks

R/ci_plot.R

@@ -42,8 +42,8 @@ ci_plot <-
            title = NULL, 
            method = "auto") {
     
-    if (!method %in% c("auto", "model"))
-      stop("Method has to either 'auto' or 'model'")
+    if (!method %in% c("auto", "model")){
+      stop("Method has to either 'auto' or 'model'")}
     
     if (method == "auto") {
       if (!is.factor(ds[, y]))

R/contrast_text.R

@@ -1,6 +1,4 @@
-
-
-#' @title Contrast Text Color
+#' MOVED 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.

R/files_filter.R

@@ -1,6 +1,6 @@
 
 
-#' @title Filter files in a folder
+#' MOVED Filter files in a folder
 #' @description This function filters files in a folder based on the 
 #' provided filter.
 #' @param folder.path character. Path of the folder to be filtered

R/generic_stroke.R

@@ -36,13 +36,13 @@ generic_stroke <-
       gtsummary::add_overall()
     
     x <- table(df[, c(group, score, strata)])
-    f1 <- rankinPlot::grottaBar(
+    f1 <- suppressWarnings(rankinPlot::grottaBar(
       x = x,
       groupName = group,
       scoreName = score,
       strataName = strata,
       colourScheme = "custom"
-    )
+    ))
     
     df[, score] <- factor(df[, score], ordered = TRUE)
     

R/metadata.R

@@ -5,7 +5,7 @@
 #' \describe{
 #'   \item{metadata_names}{characterstrings}
 #' }
-#' @seealso \url{https://www.project-redcap.org/}
+#' @seealso project-redcap(dot)org (currently the certificate is broken)
 #' @usage data(metadata_names)
 "metadata_names"
 

R/mfi_calc.R

@@ -0,0 +1,80 @@
+utils::globalVariables(c("ndx"))
+#' Reverses relevant MFI subscores
+#'
+#' @param d data frame or tibble
+#' @param var numeric vector of indices of columns to reverse
+#'
+#' @return data.frame or tibble depending on input
+#'
+#' @examples
+#' # rep_len(sample(1:5),length.out = 100) |> matrix(ncol=10) |> multi_rev(2:4)
+multi_rev <- function(d, var){
+  # Forcing and coercing to numeric
+  dm <- d |> as.matrix() |> 
+    as.numeric()|> 
+    matrix(ncol=ncol(d)) |> 
+    data.frame()
+  
+  # Reversing everything (fast enough not to subset)
+  dr <- range(dm,na.rm=TRUE) |> sum()-dm
+  
+  # Inserting reversed scores in correct places
+  for (i in var){
+    dm[i] <- dr[i]
+  }
+  
+  if (tibble::is_tibble(d)){
+    tibble::tibble(dm)
+  } else {
+      dm
+    }
+
+}
+
+#' MFI domain score calculator
+#'
+#' @param ds data set of MFI scores, 20 columns
+#' @param reverse.vars variables/columns to reverse
+#' @param reverse reverse scoring
+#'
+#' @return tibble of domain scores
+#' @export
+#'
+#' @examples
+#' mfi_mess <- data.frame(matrix(
+#' sample(c(" 1. ", "2. -A", "3.", " 4  ", "5.", NA),200,replace=TRUE),ncol=20))
+#' mfi_mess |> mfi_domains()
+mfi_domains <-
+  function(ds,
+           reverse = TRUE,
+           reverse.vars = c(2, 5, 9, 10, 13, 14, 16, 17, 18, 19)) {
+    
+  if(ncol(ds)!=20){
+    stop("The supplied dataset should only contain the 20 MFI subscores")}
+  
+  # Subscore indexes
+  indexes <- list(
+    data.frame(grp="gen", ndx=c(1, 5, 12, 16)),
+    data.frame(grp="phy", ndx=c(2, 8, 14, 20)),
+    data.frame(grp="act", ndx=c(3, 6, 10, 17)),
+    data.frame(grp="mot", ndx=c(4, 9, 15, 18)),
+    data.frame(grp="men", ndx=c(7, 11, 13, 19))
+  ) |> dplyr::bind_rows() |> dplyr::arrange(ndx)
+  
+  # Removes padding and converts to numeric
+  ds_n <- ds |> dplyr::mutate_if(is.factor, as.character) |> 
+    dplyr::mutate(dplyr::across(tidyselect::everything(),
+                  # Removes everything but the leading alphanumeric character
+                  # Data should be cleaned accordingly
+                  ~str_extract(d=.,pattern="[[:alnum:]]")))
+  
+  # Assumes reverse scores are not correctly reversed
+  if (reverse){ds_n <- ds_n |> multi_rev(var=reverse.vars)}
+  
+  # Domain wise summations
+  split.default(ds_n, factor(indexes$grp)) |> 
+    lapply(function(x){
+      apply(x, MARGIN = 1, sum, na.ignore=FALSE)
+    }) |> dplyr::bind_cols()
+  
+  }

R/pase_calc.R

@@ -3,6 +3,7 @@
 #' Calculates PASE score from raw questionnaire data.
 #' @param ds data set
 #' @param adjust_work flag to set whether to include 10b type 1. 
+#' @param consider.missing character vector of values considered missing.
 #' Default is TRUE.
 #'
 #' @return data.frame
@@ -27,10 +28,16 @@
 #' 
 #' @examples
 #' summary(pase_calc(stRoke::pase)[,13])
+#' str(pase_calc(stRoke::pase))
 #' 
-pase_calc <- function(ds, adjust_work = FALSE) {
+pase_calc <- function(ds, 
+                      adjust_work = FALSE, 
+                      consider.missing = c("Not available")) {
   
-  if (ncol(ds) != 21) stop("supplied data set has to contain exactly 21 columns")
+  if (ncol(ds) != 21) {
+    stop("supplied data set has to contain exactly 21 columns.
+         Formatting should follow the stRoke::pase data set.")
+    }
   
   pase <- ds
   
@@ -41,10 +48,20 @@ pase_calc <- function(ds, adjust_work = FALSE) {
   pase <- do.call(data.frame, lapply(pase, as.character))
   
   ## Missings and incompletes
+  # Cosidered missing if all data is missing
   missings <- apply(apply(ds, 2, is.na), 1, all)
+  
+  # Considered incomplete if any entry in main answers is missing
+  mains <- grep("([0-9]{2}|(09[a-d]))$",colnames(pase))
+  
+  if (length(mains)!=13){
+    stop("The supplied dataset does not contain expected variable names.
+         Please run str(stRoke::pase) and format your data accordingly.")
+    }
+  
   incompletes <-
-    apply(sapply(ds[, c(1, 3, 5, 7, 9, 11, 13:20)], function(x) {
-      x == "Not available" | is.na(x)
+    apply(sapply(ds[, mains], function(x) {
+      x %in% consider.missing | is.na(x)
     }), 1, any)
   
   names(pase) <- c(
@@ -78,7 +95,7 @@ pase_calc <- function(ds, adjust_work = FALSE) {
   
   ## PASE 2-6
   
-  pase_weigths <- list(
+  pase_weights <- list(
     "1" = c(
       "1" = 0.11,
       "2" = 0.32,
@@ -104,37 +121,45 @@ pase_calc <- function(ds, adjust_work = FALSE) {
   
   pase_score_26 <- lapply(seq_along(pase_list[2:6]), function(x) {
     df <- pase_list[2:6][[x]]
-    score <- c()
+    # score <- c()
     
     ## =====================
     ## Checking labelling
-    if (!all(range(suppressWarnings(as.numeric(substr(
-      df[, 1], 1, 1
-    ))), na.rm = TRUE) == c(0, 3))) {
-      stop("Labelling of 02-06 should start with a number ranging 1-4")
+    if (!all(stRoke::str_extract(df[, 1], "^[0-3]") |> 
+             as.numeric() |> 
+             range(na.rm = TRUE) == c(0, 3))) {
+      stop("Labelling of 02-06 should start with a number ranging 0-3")
     }
+    
+    if (!all(stRoke::str_extract(df[, 2], "^[1-4]") |> 
+             as.numeric() |> 
+             range(na.rm = TRUE) == c(1, 4))) {
+      stop("Labelling of 02-06 subscores should start with a number ranging 1-4")
+    }
+    
     ## =====================
     
-    for (i in seq_len(nrow(df))) {
-      # Setting categories from numbers
-      n1 <- suppressWarnings(as.numeric(substr(df[, 1][i], 1, 1)))
+    ## Extracting the first string element in main entry
+    n1 <- stRoke::str_extract(df[, 1],"^[0-3]") |> as.numeric()
+    ## Extracting the first string element in subentry
+    n2 <- stRoke::str_extract(df[, 2],"^[1-4]") |> as.numeric()
+    
+    score <- c()
+    for (i in seq_along(n1)) {
       
-      # Using if statement to calculate row wise
-      if (n1 %in% c(1:3)) {
-        # Second category
-        n2 <- suppressWarnings(as.numeric(substr(df[, 2][i], 1, 1)))
-        score[i] <- pase_weigths[[n1]][n2] * pase_multip_26[x] 
-        
-      } else if (n1 %in% 0) {
-        score[i] <- 0
+      ind1 <- match(n1[i],seq_along(pase_weights))
+      
+      if (is.na(ind1)){
+        score[i] <- n1[i]
       } else {
-        score[i] <- NA
+        score[i] <- pase_weights[[ind1]][n2[i]] * pase_multip_26[x] 
       }
+      
     }
     score
   })
   
-  names(pase_score_26) <- paste0("score_", names(pase_list[2:6]))
+  names(pase_score_26) <- paste0("pase_score_", names(pase_list[2:6]))
   
   ## PASE 7-9d
   pase_multip_79 <- c(25, 25, 30, 36, 20, 35)
@@ -147,7 +172,7 @@ pase_calc <- function(ds, adjust_work = FALSE) {
     ) * pase_multip_79))
   
   names(pase_score_79) <-
-    paste0("score_", sub("pase", "", names(pase_score_79)))
+    paste0("pase_score_", sub("pase","",names(pase_score_79)))
   
   ## PASE 10
   ## Completely ignores if 10b is not completed
@@ -157,15 +182,15 @@ pase_calc <- function(ds, adjust_work = FALSE) {
     # Only includes work time if 10b is != 1
     pase_score_10[substr(pase_list[[10]][[3]],1,1) == "1"] <- 0
     # Consequently consider "Not available" in 10b as incomplete
-    incompletes[ds[,21] == "Not available" & !incompletes & !is.na(incompletes)] <- TRUE
+    incompletes[ds[,21] %in% consider.missing & !incompletes & !is.na(incompletes)] <- TRUE
   }
   
   pase_score <- cbind(pase_score_26, pase_score_79, pase_score_10)
   
   data.frame(
     pase_score,
-    score_sum = rowSums(pase_score, na.rm = TRUE),
-    score_missings = missings,
-    score_incompletes = incompletes
+    pase_score_sum = rowSums(pase_score, na.rm = TRUE),
+    pase_score_missings = missings,
+    pase_score_incompletes = incompletes
   )
 }

R/quantile_cut.R

@@ -1,4 +1,4 @@
-#' Easy function for splitting numeric variable in quantiles
+#' MOVED Easy function for splitting numeric variable in quantiles
 #'
 #' Using base/stats functions cut() and quantile().
 #'

R/str_extract.R

@@ -1,5 +1,7 @@
 #' Extract string based on regex pattern
-#'
+#' 
+#' DEPRECATION: moved to `agdamsbo/project.aid`
+#' 
 #' Use base::strsplit to 
 #' @param d vector of character strings
 #' @param pattern regex pattern to match

R/write_ical.R

@@ -1,6 +1,6 @@
 
 
-#' Write ical object
+#' MOVED 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()`.

cran-comments.md

@@ -1,23 +1,6 @@
-> results$cran_summary()
-For a CRAN submission we recommend that you fix all NOTEs, WARNINGs and ERRORs.
-## Test environments
-- R-hub windows-x86_64-devel (r-devel)
-- R-hub ubuntu-gcc-release (r-release)
-- R-hub fedora-clang-devel (r-devel)
+── R CMD check results ───────────────────────────────────────────────────────────────────────── stRoke 24.10.1 ────
+Duration: 28.4s
 
-## R CMD check results
-❯ On windows-x86_64-devel (r-devel)
-  checking for non-standard things in the check directory ... NOTE
-  Found the following files/directories:
-    ''NULL''
+0 errors ✔ | 0 warnings ✔ | 0 notes ✔
 
-❯ On windows-x86_64-devel (r-devel)
-  checking for detritus in the temp directory ... NOTE
-  Found the following files/directories:
-    'lastMiKTeXException'
-
-❯ On ubuntu-gcc-release (r-release), fedora-clang-devel (r-devel)
-  checking HTML version of manual ... NOTE
-  Skipping checking HTML validation: no command 'tidy' found
-
-0 errors ✔ | 0 warnings ✔ | 3 notes ✖
+R CMD check succeeded

data-raw/cprs.R

@@ -5,4 +5,4 @@ usethis::use_data(cprs, overwrite = TRUE)
 cprs <- data.frame(cpr=sample(c("2310450637", "010115-4000", "0101896000",
                                 "010189-3000","300450-1030","010150-4021",
                                 "011085-AKE3","0101EJ-ATW3"),200,TRUE))
-save(cprs,file="cprs.rda")
+save(cprs,file="data/cprs.rda")

inst/WORDLIST

@@ -1,24 +1,21 @@
 Andreas
-CMD
 Changelog
 Codecov
 DDMMYY
 DOI
-DataDictionary
 Gammelgaard
 Github
 Kraglund
 Labelling
 METACRAN
+MFI
 NA's
 OLR
 ORCID
-OpenAI's
 PASE
 REDCap
 REDCapCAST
 REDCapRITS
-RStudio
 Randomisation
 STROKEAHA
 StackOverflow
@@ -30,11 +27,10 @@ XXXX
 Zou
 agdamsbo
 al
-annonymized
+anonymized
 bstfun
 calc
 characterstrings
-chatgpt
 christophergandrud
 ci
 codecov
@@ -45,6 +41,7 @@ cprs
 daDoctoR
 ddmmyy
 ddmmyyxxxx
+dev
 difftime
 dk
 doi
@@ -81,7 +78,9 @@ rgb
 sapply
 stackoverflow
 strsplit
+subscores
 teppo
+tibble
 vapply
 vec
 winP

man/add_padding.Rd

@@ -2,9 +2,16 @@
 % Please edit documentation in R/add_padding.R
 \name{add_padding}
 \alias{add_padding}
-\title{Add padding to string}
+\title{MOVED Add padding to string}
 \usage{
-add_padding(d, length = NULL, after = FALSE, pad = "0")
+add_padding(
+  d,
+  length = NULL,
+  after = FALSE,
+  pad = "0",
+  lead = NULL,
+  tail = NULL
+)
 }
 \arguments{
 \item{d}{vector of strings or numbers}
@@ -14,13 +21,17 @@ add_padding(d, length = NULL, after = FALSE, pad = "0")
 \item{after}{if padding should be added after as opposed to default before}
 
 \item{pad}{padding string of length 1}
+
+\item{lead}{leading string for all. Number or character vector. Cycled.}
+
+\item{tail}{tailing string for all. Number or character vector. Cycled.}
 }
 \value{
 vector or character strings of same length.
 }
 \description{
-Add padding to string
+MOVED Add padding to string
 }
 \examples{
-add_padding(sample(1:200,5))
+add_padding(sample(1:200,5),tail="AA",lead=c(2,3,"e"))
 }

man/chunks_of_n.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/chunks_of_n.R
 \name{chunks_of_n}
 \alias{chunks_of_n}
-\title{Split to chunks of size n}
+\title{MOVED Split to chunks of size n}
 \usage{
 chunks_of_n(d, n, label = NULL, even = FALSE, pattern = NULL)
 }
@@ -22,7 +22,7 @@ frame, will assume first column is name.}
 List of length n
 }
 \description{
-Split to chunks of size n
+MOVED Split to chunks of size n
 }
 \examples{
 tail(chunks_of_n(seq_len(100),7),3)

man/contrast_text.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/contrast_text.R
 \name{contrast_text}
 \alias{contrast_text}
-\title{Contrast Text Color}
+\title{MOVED Contrast Text Color}
 \usage{
 contrast_text(
   background,

man/files_filter.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/files_filter.R
 \name{files_filter}
 \alias{files_filter}
-\title{Filter files in a folder}
+\title{MOVED Filter files in a folder}
 \usage{
 files_filter(folder.path, filter.by, full.names = TRUE)
 }

man/metadata_names.Rd

@@ -17,6 +17,6 @@ data(metadata_names)
 Vector of REDCap metadata headers
 }
 \seealso{
-\url{https://www.project-redcap.org/}
+project-redcap(dot)org (currently the certificate is broken)
 }
 \keyword{datasets}

man/mfi_domains.Rd

@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/mfi_calc.R
+\name{mfi_domains}
+\alias{mfi_domains}
+\title{MFI domain score calculator}
+\usage{
+mfi_domains(
+  ds,
+  reverse = TRUE,
+  reverse.vars = c(2, 5, 9, 10, 13, 14, 16, 17, 18, 19)
+)
+}
+\arguments{
+\item{ds}{data set of MFI scores, 20 columns}
+
+\item{reverse}{reverse scoring}
+
+\item{reverse.vars}{variables/columns to reverse}
+}
+\value{
+tibble of domain scores
+}
+\description{
+MFI domain score calculator
+}
+\examples{
+mfi_mess <- data.frame(matrix(
+sample(c(" 1. ", "2. -A", "3.", " 4  ", "5.", NA),200,replace=TRUE),ncol=20))
+mfi_mess |> mfi_domains()
+}

man/multi_rev.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/mfi_calc.R
+\name{multi_rev}
+\alias{multi_rev}
+\title{Reverses relevant MFI subscores}
+\usage{
+multi_rev(d, var)
+}
+\arguments{
+\item{d}{data frame or tibble}
+
+\item{var}{numeric vector of indices of columns to reverse}
+}
+\value{
+data.frame or tibble depending on input
+}
+\description{
+Reverses relevant MFI subscores
+}
+\examples{
+# rep_len(sample(1:5),length.out = 100) |> matrix(ncol=10) |> multi_rev(2:4)
+}

man/pase_calc.Rd

@@ -4,12 +4,14 @@
 \alias{pase_calc}
 \title{PASE score calculator}
 \usage{
-pase_calc(ds, adjust_work = FALSE)
+pase_calc(ds, adjust_work = FALSE, consider.missing = c("Not available"))
 }
 \arguments{
 \item{ds}{data set}
 
-\item{adjust_work}{flag to set whether to include 10b type 1.
+\item{adjust_work}{flag to set whether to include 10b type 1.}
+
+\item{consider.missing}{character vector of values considered missing.
 Default is TRUE.}
 }
 \value{
@@ -41,5 +43,6 @@ set \code{TRUE}.
 }
 \examples{
 summary(pase_calc(stRoke::pase)[,13])
+str(pase_calc(stRoke::pase))
 
 }

man/quantile_cut.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/quantile_cut.R
 \name{quantile_cut}
 \alias{quantile_cut}
-\title{Easy function for splitting numeric variable in quantiles}
+\title{MOVED Easy function for splitting numeric variable in quantiles}
 \usage{
 quantile_cut(
   x,

man/stRoke-package.Rd

@@ -8,7 +8,7 @@
 \description{
 \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
 
-This is an R-toolbox of custom functions for convenient data management and analysis in clinical health research and teaching. The package is mainly collected for personal use, but any use beyond that is encouraged. This package has migrated functions from 'agdamsbo/daDoctoR', and new functions has been added. Version follows months and year. See NEWS/Changelog for release notes. This package includes sampled data from the TALOS trial (Kraglund et al (2018) \doi{10.1161/STROKEAHA.117.020067}). The win_prob() function is based on work by Zou et al (2022) \doi{10.1161/STROKEAHA.121.037744}. The age_calc() function is based on work by Becker (2020) \doi{10.18637/jss.v093.i02}.
+A collection of tools for clinical trial data management and analysis in research and teaching. The package is mainly collected for personal use, but any use beyond that is encouraged. This package has migrated functions from 'agdamsbo/daDoctoR', and new functions has been added. Version follows months and year. See NEWS/Changelog for release notes. This package includes sampled data from the TALOS trial (Kraglund et al (2018) \doi{10.1161/STROKEAHA.117.020067}). The win_prob() function is based on work by Zou et al (2022) \doi{10.1161/STROKEAHA.121.037744}. The age_calc() function is based on work by Becker (2020) \doi{10.18637/jss.v093.i02}.
 }
 \seealso{
 Useful links:

man/str_extract.Rd

@@ -15,6 +15,9 @@ str_extract(d, pattern)
 vector of character strings
 }
 \description{
+DEPRECATION: moved to \code{agdamsbo/project.aid}
+}
+\details{
 Use base::strsplit to
 }
 \examples{

man/write_ical.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/write_ical.R
 \name{write_ical}
 \alias{write_ical}
-\title{Write ical object}
+\title{MOVED Write ical object}
 \usage{
 write_ical(
   df,

stRoke.Rproj

@@ -15,4 +15,4 @@ LaTeX: pdfLaTeX
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
-PackageRoxygenize: rd,collate,namespace
+PackageRoxygenize: rd,collate,namespace,vignette

tests/spelling.R

@@ -1,3 +0,0 @@
-if(requireNamespace('spelling', quietly = TRUE))
-  spelling::spell_check_test(vignettes = TRUE, error = FALSE,
-                             skip_on_cran = TRUE)

tests/testthat/test-add_padding.R

@@ -1,17 +0,0 @@
-test_that("chunks_of_n returns correct", {
-  expect_length(add_padding(sample(1:200,5)),5)
-  
-  expect_equal(nchar(add_padding(sample(1:200,5),5)), rep(5,5))
-  
-  expect_equal(nchar(add_padding(
-    sample(1:200, 5), length = 5, after = TRUE
-  )), rep(5, 5))
-  
-  
-  ## Errors
-  expect_error(add_padding(matrix(sample(1:200,5)),5))
-  
-  expect_error(add_padding(matrix(sample(1:200,5)),5,pad = "123"))
-  
-  
-})

tests/testthat/test-age_calc.R

@@ -1,72 +0,0 @@
-test_that("age_calc works for vectors of length 1 (scalars)", {
-  result <- age_calc(as.Date("1945-10-23"), as.Date("2018-09-30"))
-  expect_equal(round(result), 73)
-})
-
-################################################################################
-
-# 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"),
-                        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"),
-                        units = "years"))
-})
-
-test_that("age_calc works correctly for months", {
-  expect_equal(age_calc(as.Date("2000-01-01"), as.Date("2020-01-01"),
-                        units = "months"), 240)
-})
-
-test_that("age_calc works correctly for months", {
-  expect_equal(round(age_calc(
-    as.Date("2000-07-07"), as.Date("2020-01-01"), units = "months"
-  )), 234)
-})
-
-test_that("age_calc works correctly for days", {
-  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"),
-                         units = "days"), 1)
-})
-
-test_that("age_calc works correctly with leap years and precise set to TRUE", {
-  expect_equal(age_calc(
-    as.Date("2000-02-29"),
-    as.Date("2020-02-29"),
-    units = "years",
-    precise = TRUE
-  ),
-  20)
-})
-
-test_that("age_calc throws an error when enddate is before dob", {
-  expect_equal(age_calc(
-    as.Date("2000-01-01"),
-    as.Date("2014-05-11"),
-    precise = FALSE,
-    units = "years"
-  ),
-  14)
-})
-
-test_that("age_calc throws an error when wrong unit", {
-  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"))
-})

tests/testthat/test-chunks.R

@@ -1,69 +0,0 @@
-library(testthat)
-test_that("chunks_of_n returns correct", {
-  expect_length(chunks_of_n(seq_len(100), 7),15)
-  
-  expect_equal(lengths(chunks_of_n(seq_len(30), 7, even = TRUE), 
-                       use.names = FALSE), c(6, 6, 6, 6, 6))
-  
-  # This is the example from the function, but I believe it fails in GitHub testing
-  ds <- data.frame(nm = paste0("Sub",
-                               add_padding(rownames(stRoke::talos))),
-                   stRoke::talos)
-  
-  # ds <- data.frame(nm = paste0("Sub",rownames(stRoke::talos)), 
-                   # stRoke::talos)
-  
-  expect_equal(head(names(chunks_of_n(ds, 7, 
-                                      pattern = "Sub[0-9]{3}", label = "grp")),
-                    1),"grp-Sub038-Sub011")
-  
-  expect_equal(
-    ds[order(ds$nm),] |> 
-      chunks_of_n(7, pattern = "Sub([0-9]+)", label = "grp") |>  
-      head(1) |> names(),
-    "grp-Sub001-Sub020"
-  )
-  
-  expect_equal(
-    ds[order(ds$nm),] |> 
-      chunks_of_n(7, pattern = "Sub[0-9]{3}", label = "grp") |>  
-      head(1) |> names(),
-    "grp-Sub001-Sub020"
-  )
-  
-  ## Errors
-  expect_error(chunks_of_n(list(ds), 7, pattern = "Sub[0-9]{3}", label = "grp"))
-  
-  
-})
-
-test_that("n_chunks returns correct", {
-  expect_length(n_chunks(seq_len(100), 7),7)
-  
-  expect_equal(lengths(n_chunks(seq_len(30), 7, even = TRUE), 
-                       use.names = FALSE), rep(5,6))
-  
-  ## This is the example from the function, but I believe it fails in GitHub testing
-  ds <- data.frame(nm = paste0("Sub",
-                               add_padding(rownames(stRoke::talos))),
-                   stRoke::talos)
-  
-  # ds <- data.frame(nm = paste0("Sub",rownames(stRoke::talos)), 
-  #                  stRoke::talos)
-  
-  expect_equal(head(names(n_chunks(ds, 7, 
-                                      pattern = "Sub([0-9]+)", label = "grp")),
-                    1),"grp-Sub038-Sub603")
-  
-  expect_equal(
-    ds[order(ds$nm), ] |> 
-      n_chunks(7, pattern = "Sub([0-9]+)", label = "grp") |>  
-      head(1) |> names(),
-    "grp-Sub001-Sub072"
-  )
-  
-  ## Errors
-  expect_error(n_chunks(list(ds), 7, pattern = "Sub([0-9]+)", label = "grp"))
-  
-  
-})

tests/testthat/test-contrast_text.R

@@ -1,60 +0,0 @@
-# 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")
-})
-
-################################################################################
-
-# library(devtools)
-# 
-# install_github("MangoTheCat/visualTest")
-# library(visualTest)
-# 
-# test_that("New test of color_plot()", {
-#   par(bg=NULL)
-#   colors <- colors()[34:53]
-#   
-#   # old <- getwd()
-#   # setwd("/Users/au301842/stRoke/tests/testthat")
-#   # setwd(old)
-#   
-#   png(filename = "data/test1.png")
-#   color_plot(colors,method="relative")
-#   dev.off()
-#   
-#   # getFingerprint("data/test1.png")
-#   
-#   expect_equal(getFingerprint("data/test1.png"), "AD07D27813E1D867")
-#   # isSimilar(tmp, "AD07D27813E1D867", threshold = 8)
-#   
-#   #############################
-#   
-#   # colors <- colors()[51:70]
-#   png(filename = "data/test2.png")
-#   color_plot(colors,labels = TRUE, borders = FALSE,cex_label = .5, ncol = 3, method="perceived_2")
-#   dev.off()
-#   
-#   # getFingerprint("data/test2.png")
-#   
-#   expect_equal(getFingerprint("data/test2.png"), "8B0B54D4E4AF2BB1")
-#   
-#   #############################
-#   
-#   png(filename = "data/test3.png")
-#   color_plot(colors,labels = FALSE, borders = TRUE, ncol = 6, method="perceived")
-#   dev.off()
-#   
-#   # getFingerprint("data/test3.png")
-#   
-#   expect_equal(getFingerprint("data/test3.png"), "B706F0F1C119CCF8")
-# })
-################################################################################

tests/testthat/test-ds2dd.R

@@ -1,40 +0,0 @@
-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")
-})

tests/testthat/test-files_filter.R

@@ -1,4 +0,0 @@
-test_that("files_filter() correctly filters files", {
-  expect_type(files_filter(getwd(),"tests"),
-              "character")
-})

tests/testthat/test-generic_stroke.R

@@ -2,12 +2,12 @@ test_that("generic_stroke() runs!", {
   iris$ord <-
     factor(sample(1:3, size = nrow(iris), replace = TRUE), ordered = TRUE)
   result <-
-    generic_stroke(
+    suppressMessages(generic_stroke(
       df = iris,
       group = "Species",
       score = "ord",
       variables = colnames(iris)[1:3]
-    )
+    ))
   expect_equal(length(result), 3)
   expect_equal(class(result), "list")
   expect_true("tbl_summary" %in% class(result[[1]]))

tests/testthat/test-quantile_cut.R

@@ -1,62 +0,0 @@
-test_that("quatile_cut() works for detail.list==FALSE", {
-  result <- quantile_cut(iris$Sepal.Length, 3, detail.list = FALSE)
-  expect_equal(length(levels(result)), 3)
-  expect_s3_class(result, "factor")
-})
-
-################################################################################
-
-test_that("quatile_cut() works for inc.outs==TRUE", {
-  result <-
-    quantile_cut(iris$Sepal.Length,
-                 3,
-                 y = iris$Sepal.Length + 3,
-                 inc.outs = FALSE)
-  expect_true(any(is.na(result)))
-  
-  result <-
-    quantile_cut(iris$Sepal.Length,
-                 3,
-                 y = iris$Sepal.Length + 3,
-                 inc.outs = TRUE)
-  expect_false(any(is.na(result)))
-  expect_equal(length(levels(result)), 3)
-  expect_s3_class(result, "factor")
-})
-
-################################################################################
-
-test_that("quatile_cut() works for detail.list==TRUE", {
-  result <- quantile_cut(iris$Sepal.Length, 3, detail.list = TRUE)
-  expect_length(result, 2)
-  expect_type(result, "list")
-})
-
-################################################################################
-
-# Test created using remotes::install_github("JamesHWade/gpttools") 
-# unit test addin.
-test_that("quantile_cut works correctly", {
-  x <- runif(100)
-  groups <- 5
-  y <- runif(100)
-  expect_equal(
-    quantile_cut(x, groups, y, na.rm = TRUE),
-    cut(
-      x,
-      quantile(
-        y,
-        probs = seq(0, 1, 1 / groups),
-        na.rm = TRUE,
-        names = TRUE,
-        type = 7
-      ),
-      include.lowest = TRUE,
-      labels = NULL,
-      ordered_result = FALSE
-    )
-  )
-})
-
-################################################################################
-

tests/testthat/test-str_extract.R

@@ -1,15 +0,0 @@
-# library(testthat)
-test_that("str_extract returns correct", {
-  ls <- do.call(c, lapply(sample(4:8, 20, T), function(i) {
-    paste(sample(letters, i, T), collapse = "")
-  }))
-  
-  ds <- do.call(c, lapply(1:20, function(i) {
-    paste(sample(ls, 1), i, sample(ls, 1), "23", sep = "_")
-  }))
-  
-  expect_equal(nchar(str_extract(ds, "([0-9]+)")),c(rep(1,9),rep(2,11)))
-  
-  expect_error(str_extract(data.frame(ds), "([0-9]+)"))
-  
-})

tests/testthat/test-write_ical.R

@@ -1,92 +0,0 @@
-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"))
-})

vignettes/ds2dd.Rmd

@@ -1,87 +0,0 @@
----
-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")
-)
-```
-

vignettes/toolbox.Rmd

@@ -25,15 +25,13 @@ 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://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}
 
 Note that, if handled, CPR numbers (social security numbers) should be handled with care as they a considered highly sensitive data.
 
 The CPR number is structured as _DDMMYY-XXXX_, with the 1st _X_ designating decade of birth, the last _X_ designate binary gender (not biological sex) dependent on even/uneven as female/male, and the last for digits are used in a modulus calculation to verify the validity of the CPR number. Foreigners and unidentified persons are given temporary CPR numbers including letters.
 
-More information can be found on [cpr.dk](https://cpr.dk).
+More information can be found on [cpr.dk](https://www.cpr.dk).
 
 Note, that all CPR numbers used in examples are publicly known or non-organic.
 
@@ -48,7 +46,7 @@ trunc(age)
 
 ### cpr_check()
 
-Checks validity of CPR numbers according to the [modulus 11 rule](https://cpr.dk/cpr-systemet/opbygning-af-cpr-nummeret). Note that due to limitations in the possible available CPR numbers, this rule [does not apply to all CPR numbers after 2007](https://cpr.dk/cpr-systemet/personnumre-uden-kontrolciffer-modulus-11-kontrol).
+Checks validity of CPR numbers according to the [modulus 11 rule](https://www.cpr.dk/cpr-systemet/opbygning-af-cpr-nummeret). Note that due to limitations in the possible available CPR numbers, this rule [does not apply to all CPR numbers after 2007](https://www.cpr.dk/cpr-systemet/personnumre-uden-kontrolciffer-modulus-11-kontrol).
 
 ```{r cpr_check-example}
 cpr_check(
@@ -108,7 +106,7 @@ ci_plot(
 
 ### generic_stroke()
 
-For learning purposes. Uses annonymized data from the [TALOS trial](https://doi.org/10.1161/STROKEAHA.117.020067) to output a Table 1 (with `gtsummary::tbl_summary()`), plotting the so-called grotta-bars based on mRS scores (with `rankinPlot::grottaBar()`) and a ordinal logistic regression model plot (with `stRoke::ci_plot()`).
+For learning purposes. Uses anonymized data from the [TALOS trial](https://doi.org/10.1161/STROKEAHA.117.020067) to output a Table 1 (with `gtsummary::tbl_summary()`), plotting the so-called grotta-bars based on mRS scores (with `rankinPlot::grottaBar()`) and a ordinal logistic regression model plot (with `stRoke::ci_plot()`).
 
 ```{r generic_stroke-example}
 generic_stroke(stRoke::talos,