mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-21 13:00:23 +01:00
updated vignette and formatting
This commit is contained in:
parent
0c3286cb2f
commit
4e7af7d01f
@ -33,9 +33,11 @@ shiny_cast <- function(...) {
|
||||
#' file_extension(list.files(here::here(""))[[2]])[[1]]
|
||||
#' file_extension(c("file.cd..ks", "file"))
|
||||
file_extension <- function(filenames) {
|
||||
sub(pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "",
|
||||
sub(
|
||||
pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "",
|
||||
filenames,
|
||||
perl = TRUE)
|
||||
perl = TRUE
|
||||
)
|
||||
}
|
||||
|
||||
#' Flexible file import based on extension
|
||||
@ -74,4 +76,3 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
|
||||
|
||||
df
|
||||
}
|
||||
|
||||
|
@ -1,4 +1,3 @@
|
||||
library(REDCapCAST)
|
||||
library(bslib)
|
||||
library(shiny)
|
||||
library(openxlsx2)
|
||||
@ -7,9 +6,14 @@ library(readODS)
|
||||
library(readr)
|
||||
library(dplyr)
|
||||
library(here)
|
||||
library(devtools)
|
||||
if (!requireNamespace("REDCapCAST")){
|
||||
devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never")
|
||||
}
|
||||
library(REDCapCAST)
|
||||
|
||||
|
||||
server <- function(input, output, session) {
|
||||
|
||||
v <- shiny::reactiveValues(
|
||||
file = NULL
|
||||
)
|
||||
@ -88,12 +92,15 @@ server <- function(input, output, session) {
|
||||
|
||||
output_staging$meta <- output_staging$data <- NA
|
||||
|
||||
shiny::observeEvent(input$upload.meta,{ upload_meta() })
|
||||
shiny::observeEvent(input$upload.meta, {
|
||||
upload_meta()
|
||||
})
|
||||
|
||||
shiny::observeEvent(input$upload.data,{ upload_data() })
|
||||
shiny::observeEvent(input$upload.data, {
|
||||
upload_data()
|
||||
})
|
||||
|
||||
upload_meta <- function() {
|
||||
|
||||
shiny::req(input$uri)
|
||||
|
||||
shiny::req(input$api)
|
||||
@ -106,7 +113,6 @@ server <- function(input, output, session) {
|
||||
}
|
||||
|
||||
upload_data <- function() {
|
||||
|
||||
shiny::req(input$uri)
|
||||
|
||||
shiny::req(input$api)
|
||||
@ -122,4 +128,8 @@ server <- function(input, output, session) {
|
||||
|
||||
output$upload.data.print <- renderText(output_staging$data)
|
||||
|
||||
# session$onSessionEnded(function() {
|
||||
# # cat("Session Ended\n")
|
||||
# unlink("www",recursive = TRUE)
|
||||
# })
|
||||
}
|
||||
|
@ -19,20 +19,27 @@ ui <-
|
||||
".ods"
|
||||
)
|
||||
),
|
||||
shiny::helpText("Have a look at the preview panels to show download options."),
|
||||
shiny::actionButton(
|
||||
inputId = "load_data",
|
||||
label = "Load data",
|
||||
icon = shiny::icon("circle-down")
|
||||
),
|
||||
shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."),
|
||||
# For some odd reason this only unfolds when the preview panel is shown..
|
||||
# This has been solved by adding an arbitrary button to load data
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.uploaded=='yes'",
|
||||
shiny::helpText("Below you can download the dataset formatted for upload and the
|
||||
corresponding data dictionary for a new data base, if you want to upload manually."),
|
||||
# condition = "output.uploaded=='yes'",
|
||||
condition = "input.load_data",
|
||||
# shiny::helpText("Below you can download the dataset formatted for upload and the
|
||||
# corresponding data dictionary for a new data base, if you want to upload manually."),
|
||||
# Button
|
||||
shiny::downloadButton("downloadData", "Download renamed data"),
|
||||
shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"),
|
||||
|
||||
# Button
|
||||
shiny::downloadButton("downloadMeta", "Download data dictionary"),
|
||||
shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"),
|
||||
|
||||
# Button
|
||||
shiny::downloadButton("downloadInstrument", "Download as instrument"),
|
||||
shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"),
|
||||
|
||||
# Horizontal line ----
|
||||
shiny::tags$hr(),
|
||||
@ -108,3 +115,4 @@ ui <-
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
@ -23,25 +23,70 @@ REDCapCAST::shiny_cast()
|
||||
The app primarily wraps one function: `ds2dd_detailed()`.
|
||||
|
||||
```{r}
|
||||
REDCap_split(
|
||||
library(REDCapCAST)
|
||||
ds <- REDCap_split(
|
||||
records = redcapcast_data,
|
||||
metadata = redcapcast_meta,
|
||||
forms = "all"
|
||||
) |>
|
||||
sanitize_split() |>
|
||||
redcap_wider() |>
|
||||
ds2dd_detailed()|>
|
||||
purrr::pluck("data") |>
|
||||
readr::type_convert(
|
||||
col_types = readr::cols(.default = readr::col_guess()))
|
||||
redcap_wider()
|
||||
str(ds)
|
||||
```
|
||||
|
||||
```{r}
|
||||
ds|>
|
||||
ds2dd_detailed()|>
|
||||
purrr::pluck("data") |>
|
||||
str()
|
||||
```
|
||||
|
||||
```{r}
|
||||
ds|>
|
||||
ds2dd_detailed()|>
|
||||
purrr::pluck("meta") |>
|
||||
head(10)
|
||||
```
|
||||
|
||||
Different data formats are accepted, which all mostly implements the `readr::col_guess()` functionality to parse column classes.
|
||||
|
||||
To ensure uniformity in data import this parsing has been implemented on its own to use with `ds2dd_detailed()` or any other data set for that matter:
|
||||
|
||||
```{r}
|
||||
ds_parsed <- redcapcast_data |>
|
||||
dplyr::mutate(dplyr::across(dplyr::everything(),as.character)) |>
|
||||
parse_data()
|
||||
str(ds_parsed)
|
||||
```
|
||||
|
||||
It will ignore specified columns, which is neat for numeric-looking strings like cpr-with a leading 0:
|
||||
|
||||
```{r}
|
||||
redcapcast_data |>
|
||||
dplyr::mutate(dplyr::across(dplyr::everything(),as.character)) |>
|
||||
readr::type_convert(
|
||||
col_types = readr::cols(.default = readr::col_guess()))
|
||||
parse_data(ignore.vars = c("record_id","cpr")) |>
|
||||
str()
|
||||
```
|
||||
|
||||
|
||||
```{r}
|
||||
|
||||
```
|
||||
|
||||
|
||||
Column classes can be passed to `parse_data()`.
|
||||
|
||||
Making a few crude assumption for factorising data, `numchar2fct()` factorises numerical and character vectors based on a set threshold for unique values:
|
||||
|
||||
```{r}
|
||||
mtcars |> str()
|
||||
mtcars |>
|
||||
numchar2fct(numeric.threshold = 6) |>
|
||||
str()
|
||||
```
|
||||
|
||||
```{r}
|
||||
ds_parsed|>
|
||||
numchar2fct(numeric.threshold = 2) |>
|
||||
str()
|
||||
```
|
||||
|
Loading…
Reference in New Issue
Block a user