added rhub v2

.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

@@ -33,7 +33,9 @@ Suggests:
     styler,
     devtools,
     roxygen2,
-    spelling
+    spelling,
+    glue,
+    rhub
 License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true
@@ -52,11 +54,13 @@ Imports:
     shiny,
     openxlsx2,
     haven,
-    readODS
+    readODS,
+    zip
 Collate: 
     'utils.r'
     'process_user_input.r'
     'REDCap_split.r'
+    'create_instrument_meta.R'
     'ds2dd.R'
     'ds2dd_detailed.R'
     'easy_redcap.R'

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(REDCap_split)
 export(clean_redcap_name)
+export(create_instrument_meta)
 export(d2w)
 export(ds2dd)
 export(ds2dd_detailed)

NEWS.md

@@ -4,6 +4,10 @@
 
 * Fix: `read_redcap_tables()`: field names testing allows to include "[form_name]_complete" fields.
 
+* Fix: `ds2dd_detailed()`: default record ID name is now "record_id", the REDCap default. Default is still to use the first column name. Support was added to interpret column name prefix or suffix as instrument names. See the examples.
+
+* New: `create_instrument_meta()`: creates zip with instrument files to allow adding new instruments to project in production. Takes data dictionary as input and creates a zip for each instrument specified by the `form_name` column.
+
 ### Documentation and more
 
 * Dependencies: In order to deploy `shiny_cast()` with `shinylive`, I need to remove `curl` as a dependency. To accomplish this, the `shiny_deploy()` helper functions has been moved to the package [`pacakge.aid`](https://github.com/agdamsbo/package.aid). This is for a rainy day: https://r-wasm.github.io/rwasm/. The whole shiny part may be migrated to its own project to try to separate things and be easy on dependencies. Time will tell.

R/create_instrument_meta.R

@@ -0,0 +1,50 @@
+#' Create zips file with necessary content based on data set
+#'
+#' @description
+#' Metadata can be added by editing the data dictionary of a project in the
+#' initial design phase. If you want to later add new instruments, this can be
+#' used to add instrument(s) to a project in production.
+#'
+#' @param data metadata for the relevant instrument.
+#' Could be from `ds2dd_detailed()`
+#' @param dir destination dir for the instrument zip. Default is the current WD.
+#' @param record.id flag to omit the first row of the data dictionary assuming
+#' this is the record_id field which should not be included in the instrument.
+#' Default is TRUE.
+#'
+#' @return list
+#' @export
+#'
+#' @examples
+#' data <- iris |>
+#'   ds2dd_detailed(add.auto.id = TRUE,
+#'   form.name=sample(c("b","c"),size = 6,replace = TRUE,prob=rep(.5,2))) |>
+#'   purrr::pluck("meta")
+#' # data |> create_instrument_meta()
+#'
+#' data <- iris |>
+#'   ds2dd_detailed(add.auto.id = FALSE) |>
+#'   purrr::pluck("data")
+#' names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
+#' replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
+#' data <- data |> ds2dd_detailed(form.sep="__")
+#' # data |>
+#' #   purrr::pluck("meta") |>
+#' #   create_instrument_meta(record.id = FALSE)
+create_instrument_meta <- function(data,
+                                   dir = here::here(""),
+                                   record.id = TRUE) {
+  if (record.id) {
+    data <- data[-1,]
+  }
+  temp_dir <- tempdir()
+  split(data,data$form_name) |> purrr::imap(function(.x,.i){
+    utils::write.csv(.x, paste0(temp_dir, "/instrument.csv"), row.names = FALSE, na = "")
+    writeLines("REDCapCAST", paste0(temp_dir, "/origin.txt"))
+    zip::zip(paste0(dir, "/", .i, Sys.Date(), ".zip"),
+             files = c("origin.txt", "instrument.csv"),
+             root = temp_dir
+    )
+  })
+
+}

R/ds2dd_detailed.R

@@ -2,7 +2,8 @@ utils::globalVariables(c(
   "stats::setNames",
   "field_name",
   "field_type",
-  "select_choices_or_calculations"
+  "select_choices_or_calculations",
+  "field_label"
 ))
 #' Try at determining which are true time only variables
 #'
@@ -114,6 +115,11 @@ hms2character <- function(data) {
 #' @param add.auto.id flag to add id column
 #' @param form.name manually specify form name(s). Vector of length 1 or
 #' ncol(data). Default is NULL and "data" is used.
+#' @param form.sep If supplied dataset has form names as suffix or prefix to the
+#' column/variable names, the seperator can be specified. If supplied, the
+#' form.sep is ignored. Default is NULL.
+#' @param form.prefix Flag to set if form is prefix (TRUE) or suffix (FALSE) to
+#' the column names. Assumes all columns have pre- or suffix if specified.
 #' @param field.type manually specify field type(s). Vector of length 1 or
 #' ncol(data). Default is NULL and "text" is used for everything but factors,
 #' which wil get "radio".
@@ -139,27 +145,35 @@ hms2character <- function(data) {
 #' @export
 #'
 #' @examples
-#' data <- redcapcast_data
+#' data <- REDCapCAST::redcapcast_data
 #' data |> ds2dd_detailed(validate.time = TRUE)
 #' data |> ds2dd_detailed()
 #' iris |> ds2dd_detailed(add.auto.id = TRUE)
 #' mtcars |> ds2dd_detailed(add.auto.id = TRUE)
+#' data <- iris |>
+#'   ds2dd_detailed(add.auto.id = TRUE) |>
+#'   purrr::pluck("data")
+#' names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
+#' replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
+#' data |> ds2dd_detailed(form.sep="__")
 ds2dd_detailed <- function(data,
                            add.auto.id = FALSE,
                            date.format = "dmy",
                            form.name = NULL,
+                           form.sep = NULL,
+                           form.prefix = TRUE,
                            field.type = NULL,
                            field.label = NULL,
                            field.label.attr = "label",
                            field.validation = NULL,
-                           metadata = metadata_names,
+                           metadata = names(REDCapCAST::redcapcast_meta),
                            validate.time = FALSE,
                            time.var.sel.pos = "[Tt]i[d(me)]",
                            time.var.sel.neg = "[Dd]at[eo]") {
   ## Handles the odd case of no id column present
   if (add.auto.id) {
     data <- dplyr::tibble(
-      default_trial_id = seq_len(nrow(data)),
+      record_id = seq_len(nrow(data)),
       data
     )
     message("A default id column has been added")
@@ -212,10 +226,24 @@ ds2dd_detailed <- function(data,
     stats::setNames(metadata) |>
     dplyr::tibble()
 
-  dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
+  ## form_name and field_name
 
-  ## form_name
+  if (!is.null(form.sep)) {
-  if (is.null(form.name)) {
+    if (form.sep!=""){
+    suppressMessages(nms <- strsplit(names(data), split = form.sep) |>
+      dplyr::bind_cols())
+    ## Assumes form.sep only occurs once and form.prefix defines if form is prefix or suffix
+    dd$form_name <- clean_redcap_name(dplyr::slice(nms,ifelse(form.prefix, 1, 2)))
+    ## The other split part is used as field names
+    dd$field_name <- dplyr::slice(nms,ifelse(!form.prefix, 1, 2)) |> as.character()
+    } else {
+      dd$form_name <- "data"
+      dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
+    }
+  } else if (is.null(form.sep)) {
+    ## if no form name prefix, the colnames are used as field_names
+    dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
+  } else if (is.null(form.name)) {
     dd$form_name <- "data"
   } else {
     if (length(form.name) == 1 || length(form.name) == nrow(dd)) {
@@ -229,7 +257,7 @@ ds2dd_detailed <- function(data,
 
   if (is.null(field.label)) {
     if (data.source == "dta") {
-      label <- data |>
+      dd$field_label <- data |>
         lapply(function(x) {
           if (haven::is.labelled(x)) {
             attributes(x)[[field.label.attr]]
@@ -238,13 +266,11 @@ ds2dd_detailed <- function(data,
           }
         }) |>
         (\(x)do.call(c, x))()
-    } else {
-      label <- data |> colnames()
     }
 
     dd <-
-      dd |> dplyr::mutate(field_label = dplyr::if_else(is.na(label),
+      dd |> dplyr::mutate(field_label = dplyr::if_else(is.na(field_label),
-        field_name, label
+        field_name, field_label
       ))
   } else {
     if (length(field.label) == 1 || length(field.label) == nrow(dd)) {
@@ -349,7 +375,7 @@ ds2dd_detailed <- function(data,
         sel.neg = time.var.sel.neg
       ) |>
       hms2character() |>
-      (\(x)stats::setNames(x, tolower(names(x))))(),
+      stats::setNames(dd$field_name),
     meta = dd
   )
 }

inst/WORDLIST

@@ -16,7 +16,7 @@ REDCapR
 REDCapRITS
 THe
 UI
-Whishes
+WD
 al
 api
 attr
@@ -25,6 +25,7 @@ da
 dafault
 datetime
 demonstrational
+dir
 dmy
 doi
 dplyr
@@ -50,10 +51,13 @@ param
 pegeler
 perl
 pos
+pre
 readr
-rsconnect
 sel
+sep
+seperator
 shinyapps
+shinylive
 stRoke
 stata
 strsplit

man/create_instrument_meta.Rd

@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/create_instrument_meta.R
+\name{create_instrument_meta}
+\alias{create_instrument_meta}
+\title{Create zips file with necessary content based on data set}
+\usage{
+create_instrument_meta(data, dir = here::here(""), record.id = TRUE)
+}
+\arguments{
+\item{data}{metadata for the relevant instrument.
+Could be from `ds2dd_detailed()`}
+
+\item{dir}{destination dir for the instrument zip. Default is the current WD.}
+
+\item{record.id}{flag to omit the first row of the data dictionary assuming
+this is the record_id field which should not be included in the instrument.
+Default is TRUE.}
+}
+\value{
+list
+}
+\description{
+Metadata can be added by editing the data dictionary of a project in the
+initial design phase. If you want to later add new instruments, this can be
+used to add instrument(s) to a project in production.
+}
+\examples{
+data <- iris |>
+  ds2dd_detailed(add.auto.id = TRUE,
+  form.name=sample(c("b","c"),size = 6,replace = TRUE,prob=rep(.5,2))) |>
+  purrr::pluck("meta")
+# data |> create_instrument_meta()
+
+data <- iris |>
+  ds2dd_detailed(add.auto.id = FALSE) |>
+  purrr::pluck("data")
+names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
+replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
+data <- data |> ds2dd_detailed(form.sep="__")
+# data |>
+#   purrr::pluck("meta") |>
+#   create_instrument_meta(record.id = FALSE)
+}

man/ds2dd_detailed.Rd

@@ -9,11 +9,13 @@ ds2dd_detailed(
   add.auto.id = FALSE,
   date.format = "dmy",
   form.name = NULL,
+  form.sep = NULL,
+  form.prefix = TRUE,
   field.type = NULL,
   field.label = NULL,
   field.label.attr = "label",
   field.validation = NULL,
-  metadata = metadata_names,
+  metadata = names(REDCapCAST::redcapcast_meta),
   validate.time = FALSE,
   time.var.sel.pos = "[Tt]i[d(me)]",
   time.var.sel.neg = "[Dd]at[eo]"
@@ -30,6 +32,13 @@ dmy.}
 \item{form.name}{manually specify form name(s). Vector of length 1 or
 ncol(data). Default is NULL and "data" is used.}
 
+\item{form.sep}{If supplied dataset has form names as suffix or prefix to the
+column/variable names, the seperator can be specified. If supplied, the
+form.sep is ignored. Default is NULL.}
+
+\item{form.prefix}{Flag to set if form is prefix (TRUE) or suffix (FALSE) to
+the column names. Assumes all columns have pre- or suffix if specified.}
+
 \item{field.type}{manually specify field type(s). Vector of length 1 or
 ncol(data). Default is NULL and "text" is used for everything but factors,
 which wil get "radio".}
@@ -74,9 +83,15 @@ Ensure, that the data set is formatted with as much information as possible.
 `field.type` can be supplied
 }
 \examples{
-data <- redcapcast_data
+data <- REDCapCAST::redcapcast_data
 data |> ds2dd_detailed(validate.time = TRUE)
 data |> ds2dd_detailed()
 iris |> ds2dd_detailed(add.auto.id = TRUE)
 mtcars |> ds2dd_detailed(add.auto.id = TRUE)
+data <- iris |>
+  ds2dd_detailed(add.auto.id = TRUE) |>
+  purrr::pluck("data")
+names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
+replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
+data |> ds2dd_detailed(form.sep="__")
 }

renv.lock

@@ -392,7 +392,7 @@
     },
     "htmltools": {
       "Package": "htmltools",
-      "Version": "0.5.8",
+      "Version": "0.5.8.1",
       "Source": "Repository",
       "Repository": "CRAN",
       "Requirements": [
@@ -404,7 +404,7 @@
         "rlang",
         "utils"
       ],
-      "Hash": "149431ee39aba5bdc264112c8ff94444"
+      "Hash": "81d371a9cc60640e74e4ab6ac46dcedc"
     },
     "httpuv": {
       "Package": "httpuv",
@@ -611,9 +611,9 @@
     },
     "promises": {
       "Package": "promises",
-      "Version": "1.2.1",
+      "Version": "1.3.0",
       "Source": "Repository",
-      "Repository": "RSPM",
+      "Repository": "CRAN",
       "Requirements": [
         "R6",
         "Rcpp",
@@ -623,7 +623,7 @@
         "rlang",
         "stats"
       ],
-      "Hash": "0d8a15c9d000970ada1ab21405387dee"
+      "Hash": "434cd5388a3979e74be5c219bcd6e77d"
     },
     "purrr": {
       "Package": "purrr",