diff --git a/DESCRIPTION b/DESCRIPTION index d1a844b..d71ae08 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NAMESPACE b/NAMESPACE index 2ce376e..b8b67b5 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/ds2dd_detailed.R b/R/ds2dd_detailed.R index ea9fd40..1d41de5 100644 --- a/R/ds2dd_detailed.R +++ b/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 } diff --git a/R/shiny_cast.R b/R/shiny_cast.R index e3ff3a6..5407aad 100644 --- a/R/shiny_cast.R +++ b/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() + ) + ) +} diff --git a/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf b/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf index c352ca3..c653183 100644 --- a/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf +++ b/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 diff --git a/inst/shiny-examples/casting/server.R b/inst/shiny-examples/casting/server.R index 0f449a4..da4edf4 100644 --- a/inst/shiny-examples/casting/server.R +++ b/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") |> - 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." - ) + cast_data_overview() ) output$meta.tbl <- gt::render_gt( dd() |> - 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() - ) - ) + cast_meta_overview() ) # Downloadable csv of dataset ---- diff --git a/man/cast_data_overview.Rd b/man/cast_data_overview.Rd new file mode 100644 index 0000000..0ae382d --- /dev/null +++ b/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 +} diff --git a/man/cast_meta_overview.Rd b/man/cast_meta_overview.Rd new file mode 100644 index 0000000..e3e117f --- /dev/null +++ b/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 +}