documented preview functions and included gt

DESCRIPTION

@@ -29,7 +29,6 @@ Suggests:
     Hmisc,
     knitr,
     rmarkdown,
-    gt,
     ggplot2,
     here,
     styler,
@@ -61,7 +60,8 @@ Imports:
     openxlsx2,
     readODS,
     forcats,
-    vctrs
+    vctrs,
+    gt
 Collate: 
     'REDCapCAST-package.R'
     'utils.r'

NAMESPACE

@@ -13,6 +13,8 @@ S3method(process_user_input,response)
 export(REDCap_split)
 export(as_factor)
 export(case_match_regex_list)
+export(cast_data_overview)
+export(cast_meta_overview)
 export(char2choice)
 export(char2cond)
 export(clean_redcap_name)

R/ds2dd_detailed.R

@@ -197,6 +197,8 @@ ds2dd_detailed <- function(data,
       record_id = seq_len(nrow(data)),
       data
     )
+    # set_attr(data$record_id,label="ID",attr="label")
+
     message("A default id column has been added")
   }
 
@@ -337,12 +339,15 @@ ds2dd_detailed <- function(data,
       )
     )
 
-  list(
+  out <- list(
     data = data |>
       hms2character() |>
       stats::setNames(dd$field_name),
     meta = dd
   )
+
+  class(out) <- c("REDCapCAST",class(out))
+  out
 }
 
 

R/shiny_cast.R

@@ -78,3 +78,69 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
 
   df
 }
+
+#' Overview of REDCapCAST data for shiny
+#'
+#' @param data list with class 'REDCapCAST'
+#'
+#' @return gt object
+#' @export
+cast_data_overview <- function(data){
+  stopifnot("REDCapCAST" %in% class(data))
+  data |>
+    purrr::pluck("data") |>
+    head(20) |>
+    # dplyr::tibble() |>
+    gt::gt() |>
+    gt::tab_style(
+      style = gt::cell_text(weight = "bold"),
+      locations = gt::cells_column_labels(dplyr::everything())
+    ) |>
+    gt::tab_header(
+      title = "Imported data preview",
+      subtitle = "The first 20 subjects of the supplied dataset for reference."
+    )
+}
+
+
+#' Overview of REDCapCAST meta data for shiny
+#'
+#' @param data list with class 'REDCapCAST'
+#'
+#' @return gt object
+#' @export
+cast_meta_overview <- function(data){
+  stopifnot("REDCapCAST" %in% class(data))
+  data |>
+    purrr::pluck("meta") |>
+    # dplyr::tibble() |>
+    dplyr::mutate(
+      dplyr::across(
+        dplyr::everything(),
+        \(.x) {
+          .x[is.na(.x)] <- ""
+          return(.x)
+        }
+      )
+    ) |>
+    dplyr::select(1:8) |>
+    gt::gt() |>
+    gt::tab_style(
+      style = gt::cell_text(weight = "bold"),
+      locations = gt::cells_column_labels(dplyr::everything())
+    ) |>
+    gt::tab_header(
+      title = "Generated metadata",
+      subtitle = "Only the first 8 columns are modified using REDCapCAST. Download the metadata to see everything."
+    ) |>
+    gt::tab_style(
+      style = gt::cell_borders(
+        sides = c("left", "right"),
+        color = "grey80",
+        weight = gt::px(1)
+      ),
+      locations = gt::cells_body(
+        columns = dplyr::everything()
+      )
+    )
+}

inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 11351429
-bundleId: 9391578
+bundleId: 9392220
 url: https://agdamsbo.shinyapps.io/redcapcast/
 version: 1

inst/shiny-examples/casting/server.R

@@ -103,53 +103,12 @@ server <- function(input, output, session) {
 
   output$data.tbl <- gt::render_gt(
     dd() |>
-      purrr::pluck("data") |>
+      cast_data_overview()
-      head(20) |>
-      # dplyr::tibble() |>
-      gt::gt() |>
-      gt::tab_style(
-        style = gt::cell_text(weight = "bold"),
-        locations = gt::cells_column_labels(dplyr::everything())
-      ) |>
-      gt::tab_header(
-        title = "Imported data preview",
-        subtitle = "The first 20 subjects of the supplied dataset for reference."
-      )
   )
 
   output$meta.tbl <- gt::render_gt(
     dd() |>
-      purrr::pluck("meta") |>
+      cast_meta_overview()
-      # dplyr::tibble() |>
-      dplyr::mutate(
-        dplyr::across(
-          dplyr::everything(),
-          \(.x) {
-            .x[is.na(.x)] <- ""
-            return(.x)
-          }
-        )
-      ) |>
-      dplyr::select(1:8) |>
-      gt::gt() |>
-      gt::tab_style(
-        style = gt::cell_text(weight = "bold"),
-        locations = gt::cells_column_labels(dplyr::everything())
-      ) |>
-      gt::tab_header(
-        title = "Generated metadata",
-        subtitle = "Only the first 8 columns are modified using REDCapCAST. Download the metadata to see everything."
-      ) |>
-      gt::tab_style(
-        style = gt::cell_borders(
-          sides = c("left", "right"),
-          color = "grey80",
-          weight = gt::px(1)
-        ),
-        locations = gt::cells_body(
-          columns = dplyr::everything()
-        )
-      )
   )
 
   # Downloadable csv of dataset ----

man/cast_data_overview.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/shiny_cast.R
+\name{cast_data_overview}
+\alias{cast_data_overview}
+\title{Overview of REDCapCAST data for shiny}
+\usage{
+cast_data_overview(data)
+}
+\arguments{
+\item{data}{list with class 'REDCapCAST'}
+}
+\value{
+gt object
+}
+\description{
+Overview of REDCapCAST data for shiny
+}

man/cast_meta_overview.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/shiny_cast.R
+\name{cast_meta_overview}
+\alias{cast_meta_overview}
+\title{Overview of REDCapCAST meta data for shiny}
+\usage{
+cast_meta_overview(data)
+}
+\arguments{
+\item{data}{list with class 'REDCapCAST'}
+}
+\value{
+gt object
+}
+\description{
+Overview of REDCapCAST meta data for shiny
+}