mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 18:09:39 +02:00
Compare commits
3 commits
268038e49e
...
0994cb42ec
| Author | SHA1 | Date | |
|---|---|---|---|
| 0994cb42ec | |||
| a8ab648eda | |||
| 9e8ff6b4a9 |
22 changed files with 782 additions and 816 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -9,3 +9,4 @@ app/rsconnect
|
|||
inst/shiny-examples/casting/functions.R
|
||||
functions.R
|
||||
docs
|
||||
inst/doc
|
||||
|
|
|
|||
|
|
@ -77,6 +77,9 @@ Suggests:
|
|||
usethis,
|
||||
roxygen2,
|
||||
pak,
|
||||
rsconnect
|
||||
rsconnect,
|
||||
knitr,
|
||||
rmarkdown
|
||||
URL: https://github.com/agdamsbo/freesearcheR, https://agdamsbo.github.io/freesearcheR/
|
||||
BugReports: https://github.com/agdamsbo/freesearcheR/issues
|
||||
VignetteBuilder: knitr
|
||||
|
|
|
|||
|
|
@ -36,8 +36,12 @@ export(gg_theme_export)
|
|||
export(gg_theme_shiny)
|
||||
export(grepl_fix)
|
||||
export(import_delim)
|
||||
export(import_dta)
|
||||
export(import_file_server)
|
||||
export(import_file_ui)
|
||||
export(import_ods)
|
||||
export(import_rds)
|
||||
export(import_xls)
|
||||
export(index_embed)
|
||||
export(is_any_class)
|
||||
export(is_consecutive)
|
||||
|
|
|
|||
2
NEWS.md
2
NEWS.md
|
|
@ -6,6 +6,8 @@ First steps towards an updated name (will be FreesearchR), with renamed reposito
|
|||
|
||||
Testing file upload conducted and improved.
|
||||
|
||||
Working on omproving code export.
|
||||
|
||||
# freesearcheR 25.3.1
|
||||
|
||||
First steps towards a more focused and simplified interface.
|
||||
|
|
|
|||
3
QA.md
3
QA.md
|
|
@ -6,3 +6,6 @@ A complete instructions set is not available, but below are a collection of ques
|
|||
|
||||
No! All uploaded data is deleted when the session ends, so only stored for your analyses and the immediately deleted.
|
||||
|
||||
## How do I merge multiple datasets?
|
||||
|
||||
You can merge multiple sheets from ods or xls(x) files on import when a common key variable is present in selected sheets. Multiple file upload/merge is currently not supported.
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'250313_1502'
|
||||
app_version <- function()'250317_2113'
|
||||
|
|
|
|||
415
R/data-import.R
415
R/data-import.R
|
|
@ -1,250 +1,171 @@
|
|||
#' data_import_ui <- function(id, include_title = TRUE) {
|
||||
#' ns <- shiny::NS(id)
|
||||
data_import_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
import_file_ui(
|
||||
id = ns("file_import"),
|
||||
layout_params = "dropdown",
|
||||
title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
m_redcap_readUI(id = ns("redcap_import"))
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='env'",
|
||||
import_globalenv_ui(id = ns("env"), title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = ns("redcap_prev"))
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
data_import_server <- function(id) {
|
||||
module <- function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data_temp = NULL,
|
||||
code = list()
|
||||
)
|
||||
|
||||
data_file <- import_file_server(
|
||||
id = ns("file_import"),
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
shiny::req(data_file$data())
|
||||
|
||||
rv$data_temp <- data_file$data()
|
||||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- data_redcap()
|
||||
})
|
||||
|
||||
from_env <- datamods::import_globalenv_server(
|
||||
id = "env",
|
||||
trigger_return = "change",
|
||||
btn_show_data = FALSE,
|
||||
reset = reactive(input$hidden)
|
||||
)
|
||||
|
||||
shiny::observeEvent(from_env$data(), {
|
||||
shiny::req(from_env$data())
|
||||
|
||||
rv$data_temp <- from_env$data()
|
||||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
return(list(
|
||||
# status = reactive(temporary_rv$status),
|
||||
# name = reactive(temporary_rv$name),
|
||||
# code = reactive(temporary_rv$code),
|
||||
data = shiny::reactive(rv$data_temp)
|
||||
))
|
||||
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = module
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
|
||||
#' Test app for the data-import module
|
||||
#'
|
||||
#' shiny::fluidRow(
|
||||
#' shiny::column(width = 2),
|
||||
#' shiny::column(
|
||||
#' width = 8,
|
||||
#' shiny::h4("Choose your data source"),
|
||||
#' shiny::br(),
|
||||
#' shinyWidgets::radioGroupButtons(
|
||||
#' inputId = "source",
|
||||
#' selected = "env",
|
||||
#' choices = c(
|
||||
#' "File upload" = "file",
|
||||
#' "REDCap server export" = "redcap",
|
||||
#' "Local or sample data" = "env"
|
||||
#' ),
|
||||
#' width = "100%"
|
||||
#' ),
|
||||
#' shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='file'",
|
||||
#' import_file_ui(
|
||||
#' id = "file_import",
|
||||
#' layout_params = "dropdown",
|
||||
#' title = "Choose a datafile to upload",
|
||||
#' file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
#' )
|
||||
#' ),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='redcap'",
|
||||
#' m_redcap_readUI("redcap_import")
|
||||
#' ),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='env'",
|
||||
#' import_globalenv_ui(id = "env", title = NULL)
|
||||
#' ),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='redcap'",
|
||||
#' DT::DTOutput(outputId = "redcap_prev")
|
||||
#' ),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::h5("Specify variables to include"),
|
||||
#' shiny::fluidRow(
|
||||
#' shiny::column(
|
||||
#' width = 6,
|
||||
#' shiny::br(),
|
||||
#' shiny::p("Filter by completeness threshold and manual selection:"),
|
||||
#' shiny::br(),
|
||||
#' shiny::br()
|
||||
#' ),
|
||||
#' shiny::column(
|
||||
#' width = 6,
|
||||
#' shinyWidgets::noUiSliderInput(
|
||||
#' inputId = "complete_cutoff",
|
||||
#' label = NULL,
|
||||
#' min = 0,
|
||||
#' max = 100,
|
||||
#' step = 5,
|
||||
#' value = 70,
|
||||
#' format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
#' color = datamods:::get_primary_color()
|
||||
#' ),
|
||||
#' shiny::helpText("Filter variables with completeness above the specified percentage."),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::uiOutput(outputId = "import_var")
|
||||
#' )
|
||||
#' ),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::actionButton(
|
||||
#' inputId = "act_start",
|
||||
#' label = "Start",
|
||||
#' width = "100%",
|
||||
#' icon = shiny::icon("play"),
|
||||
#' disabled = TRUE
|
||||
#' ),
|
||||
#' shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::column(width = 2)
|
||||
#' )
|
||||
#' )
|
||||
#' }
|
||||
#' @rdname data-import
|
||||
#'
|
||||
#'
|
||||
#' data_import_server <- function(id) {
|
||||
#' module <- function(input, output, session) {
|
||||
#' ns <- session$ns
|
||||
#'
|
||||
#' rv <- shiny::reactiveValues(
|
||||
#' data_original = NULL,
|
||||
#' data_temp = NULL,
|
||||
#' data = NULL,
|
||||
#' code = list()
|
||||
#' )
|
||||
#'
|
||||
#' data_file <- import_file_server(
|
||||
#' id = "file_import",
|
||||
#' show_data_in = "popup",
|
||||
#' trigger_return = "change",
|
||||
#' return_class = "data.frame",
|
||||
#' read_fns = list(
|
||||
#' ods = import_ods,
|
||||
#' dta = function(file) {
|
||||
#' haven::read_dta(
|
||||
#' file = file,
|
||||
#' .name_repair = "unique_quiet"
|
||||
#' )
|
||||
#' },
|
||||
#' # csv = function(file) {
|
||||
#' # readr::read_csv(
|
||||
#' # file = file,
|
||||
#' # na = consider.na,
|
||||
#' # name_repair = "unique_quiet"
|
||||
#' # )
|
||||
#' # },
|
||||
#' csv = import_delim,
|
||||
#' tsv = import_delim,
|
||||
#' txt = import_delim,
|
||||
#' xls = import_xls,
|
||||
#' xlsx = import_xls,
|
||||
#' rds = function(file) {
|
||||
#' readr::read_rds(
|
||||
#' file = file,
|
||||
#' name_repair = "unique_quiet"
|
||||
#' )
|
||||
#' }
|
||||
#' )
|
||||
#' )
|
||||
#'
|
||||
#' shiny::observeEvent(data_file$data(), {
|
||||
#' shiny::req(data_file$data())
|
||||
#' rv$data_temp <- data_file$data()
|
||||
#' rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
#' })
|
||||
#'
|
||||
#' data_redcap <- m_redcap_readServer(
|
||||
#' id = "redcap_import" # ,
|
||||
#' # output.format = "list"
|
||||
#' )
|
||||
#'
|
||||
#' shiny::observeEvent(data_redcap(), {
|
||||
#' # rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
#' rv$data_temp <- data_redcap()
|
||||
#' })
|
||||
#'
|
||||
#' output$redcap_prev <- DT::renderDT(
|
||||
#' {
|
||||
#' DT::datatable(head(data_redcap(), 5),
|
||||
#' # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
#' caption = "First 5 observations"
|
||||
#' )
|
||||
#' },
|
||||
#' server = TRUE
|
||||
#' )
|
||||
#'
|
||||
#' from_env <- datamods::import_globalenv_server(
|
||||
#' id = "env",
|
||||
#' trigger_return = "change",
|
||||
#' btn_show_data = FALSE,
|
||||
#' reset = reactive(input$hidden)
|
||||
#' )
|
||||
#'
|
||||
#' shiny::observeEvent(from_env$data(), {
|
||||
#' shiny::req(from_env$data())
|
||||
#'
|
||||
#' rv$data_temp <- from_env$data()
|
||||
#' # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
#' })
|
||||
#'
|
||||
#' output$import_var <- shiny::renderUI({
|
||||
#' shiny::req(rv$data_temp)
|
||||
#'
|
||||
#' preselect <- names(rv$data_temp)[sapply(rv$data_temp, missing_fraction) <= input$complete_cutoff / 100]
|
||||
#'
|
||||
#' shinyWidgets::virtualSelectInput(
|
||||
#' inputId = "import_var",
|
||||
#' label = "Select variables to include",
|
||||
#' selected = preselect,
|
||||
#' choices = names(rv$data_temp),
|
||||
#' updateOn = "close",
|
||||
#' multiple = TRUE,
|
||||
#' search = TRUE,
|
||||
#' showValueAsTags = TRUE
|
||||
#' )
|
||||
#' })
|
||||
#'
|
||||
#'
|
||||
#' shiny::observeEvent(
|
||||
#' eventExpr = list(
|
||||
#' input$import_var
|
||||
#' ),
|
||||
#' handlerExpr = {
|
||||
#' shiny::req(rv$data_temp)
|
||||
#'
|
||||
#' rv$data_original <- rv$data_temp |>
|
||||
#' dplyr::select(input$import_var) |>
|
||||
#' # janitor::clean_names() |>
|
||||
#' default_parsing()
|
||||
#' }
|
||||
#' )
|
||||
#'
|
||||
#' return(shiny::reactive(rv$data_original))
|
||||
#'
|
||||
#' }
|
||||
#'
|
||||
#' shiny::moduleServer(
|
||||
#' id = id,
|
||||
#' module = module
|
||||
#' )
|
||||
#'
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' #' Test app for the data-import module
|
||||
#' #'
|
||||
#' #' @rdname data-import
|
||||
#' #'
|
||||
#' #' @examples
|
||||
#' #' \dontrun{
|
||||
#' #' data_import_demo_app()
|
||||
#' #' }
|
||||
#' data_import_demo_app <- function() {
|
||||
#' ui <- shiny::fluidPage(
|
||||
#' data_import_ui("data")
|
||||
#' )
|
||||
#' server <- function(input, output, session) {
|
||||
#' data_val <- shiny::reactiveValues(data = NULL)
|
||||
#'
|
||||
#'
|
||||
#' data_val$data <- data_import_server(id = "data")
|
||||
#'
|
||||
#' output$data_summary <- DT::renderDataTable(
|
||||
#' {
|
||||
#' shiny::req(data_val$data)
|
||||
#' data_val$data()
|
||||
#' },
|
||||
#' options = list(
|
||||
#' scrollX = TRUE,
|
||||
#' pageLength = 5
|
||||
#' ),
|
||||
#' )
|
||||
#' }
|
||||
#' shiny::shinyApp(ui, server)
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data_import_demo_app()
|
||||
#' }
|
||||
data_import_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
data_import_ui("data_import"),
|
||||
toastui::datagridOutput2(outputId = "table"),
|
||||
DT::DTOutput("data_summary")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
imported <- shiny::reactive(data_import_server(id = "data_import"))
|
||||
|
||||
# output$data_summary <- DT::renderDataTable(
|
||||
# {
|
||||
# shiny::req(data_val$data)
|
||||
# data_val$data
|
||||
# },
|
||||
# options = list(
|
||||
# scrollX = TRUE,
|
||||
# pageLength = 5
|
||||
# )
|
||||
# )
|
||||
output$table <- toastui::renderDatagrid2({
|
||||
req(imported$data)
|
||||
toastui::datagrid(
|
||||
data = head(imported$data, 5),
|
||||
theme = "striped",
|
||||
colwidths = "guess",
|
||||
minBodyHeight = 250
|
||||
)
|
||||
})
|
||||
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,7 +85,9 @@ import_file_ui <- function(id,
|
|||
buttonLabel = datamods:::i18n("Browse..."),
|
||||
placeholder = datamods:::i18n("No file selected"),
|
||||
accept = file_extensions,
|
||||
width = "100%"
|
||||
width = "100%",
|
||||
## A solution to allow multiple file upload is being considered
|
||||
multiple = FALSE
|
||||
),
|
||||
class = "mb-0"
|
||||
)
|
||||
|
|
@ -145,35 +147,23 @@ import_file_ui <- function(id,
|
|||
)
|
||||
),
|
||||
if (isTRUE(preview_data)) {
|
||||
toastui::datagridOutput2(outputId = ns("table"))
|
||||
}
|
||||
,
|
||||
toastui::datagridOutput2(outputId = ns("table"))
|
||||
},
|
||||
shiny::uiOutput(
|
||||
outputId = ns("container_confirm_btn"),
|
||||
style = "margin-top: 20px;"
|
||||
) ,
|
||||
),
|
||||
tags$div(
|
||||
style = htmltools::css(display = "none"),
|
||||
shiny::checkboxInput(
|
||||
inputId = ns("preview_data"),
|
||||
label = NULL,
|
||||
value = isTRUE(preview_data)
|
||||
)
|
||||
shiny::checkboxInput(
|
||||
inputId = ns("preview_data"),
|
||||
label = NULL,
|
||||
value = isTRUE(preview_data)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' @param read_fns Named list with custom function(s) to read data:
|
||||
#' * the name must be the extension of the files to which the function will be applied
|
||||
#' * the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names),
|
||||
#' passed by user through the interface:
|
||||
#' + `file`: path to the file
|
||||
#' + `sheet`: for Excel files, sheet to read
|
||||
#' + `skip`: number of row to skip
|
||||
#' + `dec`: decimal separator
|
||||
#' + `encoding`: file encoding
|
||||
#' + `na.strings`: character(s) to interpret as missing values.
|
||||
#'
|
||||
#' @export
|
||||
#'
|
||||
|
|
@ -184,16 +174,17 @@ import_file_server <- function(id,
|
|||
show_data_in = c("popup", "modal"),
|
||||
trigger_return = c("button", "change"),
|
||||
return_class = c("data.frame", "data.table", "tbl_df", "raw"),
|
||||
reset = reactive(NULL),
|
||||
read_fns = list()) {
|
||||
if (length(read_fns) > 0) {
|
||||
if (!rlang::is_named(read_fns)) {
|
||||
stop("import_file_server: `read_fns` must be a named list.", call. = FALSE)
|
||||
}
|
||||
if (!all(vapply(read_fns, rlang::is_function, logical(1)))) {
|
||||
stop("import_file_server: `read_fns` must be list of function(s).", call. = FALSE)
|
||||
}
|
||||
}
|
||||
reset = reactive(NULL)) {
|
||||
read_fns <- list(
|
||||
ods = "import_ods",
|
||||
dta = "import_dta",
|
||||
csv = "import_delim",
|
||||
tsv = "import_delim",
|
||||
txt = "import_delim",
|
||||
xls = "import_xls",
|
||||
xlsx = "import_xls",
|
||||
rds = "import_rds"
|
||||
)
|
||||
|
||||
trigger_return <- match.arg(trigger_return)
|
||||
return_class <- match.arg(return_class)
|
||||
|
|
@ -248,10 +239,7 @@ import_file_server <- function(id,
|
|||
{
|
||||
req(input$file)
|
||||
if (is_workbook(input$file$datapath)) shiny::req(input$sheet)
|
||||
# browser()
|
||||
|
||||
# browser()
|
||||
# req(input$skip_rows)
|
||||
extension <- tools::file_ext(input$file$datapath)
|
||||
|
||||
parameters <- list(
|
||||
|
|
@ -262,9 +250,11 @@ import_file_server <- function(id,
|
|||
encoding = input$encoding,
|
||||
na.strings = datamods:::split_char(input$na_label)
|
||||
)
|
||||
parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
|
||||
|
||||
parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))]
|
||||
# parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
|
||||
imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE)
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)))
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "freesearcheR")
|
||||
|
||||
if (inherits(imported, "try-error")) {
|
||||
imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
|
||||
|
|
@ -361,11 +351,19 @@ is_workbook <- function(path) {
|
|||
is_excel(path) || is_ods(path)
|
||||
}
|
||||
|
||||
#' Wrapper of data.table::fread to import delim files with few presets
|
||||
|
||||
# File import functions ---------------------------------------------------
|
||||
|
||||
#' Wrapper to ease data file import
|
||||
#'
|
||||
#' @param file file
|
||||
#' @param encoding encoding
|
||||
#' @param na.strings na.strings
|
||||
#' @param file path to the file
|
||||
#' @param sheet for Excel files, sheet to read
|
||||
#' @param skip number of row to skip
|
||||
#' @param encoding file encoding
|
||||
#' @param na.strings character(s) to interpret as missing values.
|
||||
#'
|
||||
#'
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
|
|
@ -384,6 +382,12 @@ import_delim <- function(file, skip, encoding, na.strings) {
|
|||
)
|
||||
}
|
||||
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_xls <- function(file, sheet, skip, na.strings) {
|
||||
tryCatch(
|
||||
{
|
||||
|
|
@ -409,6 +413,12 @@ import_xls <- function(file, sheet, skip, na.strings) {
|
|||
)
|
||||
}
|
||||
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_ods <- function(file, sheet, skip, na.strings) {
|
||||
tryCatch(
|
||||
{
|
||||
|
|
@ -432,6 +442,30 @@ import_ods <- function(file, sheet, skip, na.strings) {
|
|||
)
|
||||
}
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_dta <- function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_rds <- function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
|
||||
#' @title Create a select input control with icon(s)
|
||||
#'
|
||||
#' @description Extend form controls by adding text or icons before,
|
||||
|
|
@ -515,35 +549,7 @@ import_file_demo_app <- function() {
|
|||
id = "myid",
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
# Custom functions to read data
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
# csv = function(file) {
|
||||
# readr::read_csv(
|
||||
# file = file,
|
||||
# na = consider.na,
|
||||
# name_repair = "unique_quiet"
|
||||
# )
|
||||
# },
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
output$status <- shiny::renderPrint({
|
||||
|
|
|
|||
|
|
@ -143,7 +143,7 @@ m_redcap_readServer <- function(id) {
|
|||
dd_list = NULL,
|
||||
data = NULL,
|
||||
rep_fields = NULL,
|
||||
imported = NULL
|
||||
code = NULL
|
||||
)
|
||||
|
||||
shiny::observeEvent(list(input$api, input$uri), {
|
||||
|
|
@ -340,7 +340,10 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
})
|
||||
code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters)
|
||||
|
||||
code <- rlang::call2("read_redcap_tables",
|
||||
!!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
|
||||
, .ns = "REDCapCAST")
|
||||
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
|
|
@ -375,6 +378,8 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
}
|
||||
|
||||
data_rv$code <- code
|
||||
|
||||
data_rv$data <- out |>
|
||||
dplyr::select(-dplyr::ends_with("_complete")) |>
|
||||
# dplyr::select(-dplyr::any_of(record_id)) |>
|
||||
|
|
@ -390,7 +395,13 @@ m_redcap_readServer <- function(id) {
|
|||
#
|
||||
# })
|
||||
|
||||
return(shiny::reactive(data_rv$data))
|
||||
return(list(
|
||||
status = shiny::reactive(data_rv$data_status),
|
||||
name = shiny::reactive(data_rv$info$project_title),
|
||||
info = shiny::reactive(data_rv$info),
|
||||
code = shiny::reactive(data_rv$code),
|
||||
data = shiny::reactive(data_rv$data)
|
||||
))
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
|
|
@ -543,15 +554,15 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
|
|||
redcap_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
m_redcap_readUI("data"),
|
||||
DT::DTOutput("data_summary")
|
||||
DT::DTOutput("data"),
|
||||
shiny::tags$b("Code:"),
|
||||
shiny::verbatimTextOutput(outputId = "code")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_val <- shiny::reactiveValues(data = NULL)
|
||||
|
||||
data_val <- m_redcap_readServer(id = "data")
|
||||
|
||||
data_val$data <- m_redcap_readServer(id = "data")
|
||||
|
||||
output$data_summary <- DT::renderDataTable(
|
||||
output$data <- DT::renderDataTable(
|
||||
{
|
||||
shiny::req(data_val$data)
|
||||
data_val$data()
|
||||
|
|
@ -561,6 +572,10 @@ redcap_demo_app <- function() {
|
|||
pageLength = 5
|
||||
),
|
||||
)
|
||||
output$code <- shiny::renderPrint({
|
||||
shiny::req(data_val$code)
|
||||
data_val$code()
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -38,6 +38,6 @@ Below are some (the actual list is quite long and growing) of the planned featur
|
|||
|
||||
- [x] Correlation matrix plot for data exploration 2025-2-20
|
||||
|
||||
- [ ] Grotta bars for ordianl outcomes
|
||||
- [x] Grotta bars for ordianl outcomes (and sankey) 2025-3-17
|
||||
|
||||
- [x] Coefficient plotting for regression analyses (forest plot) 2025-2-20
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
#### Current file: R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'250313_1502'
|
||||
app_version <- function()'250317_2113'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -1671,256 +1671,177 @@ allign_axes <- function(...) {
|
|||
#### Current file: R//data-import.R
|
||||
########
|
||||
|
||||
#' data_import_ui <- function(id, include_title = TRUE) {
|
||||
#' ns <- shiny::NS(id)
|
||||
data_import_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
import_file_ui(
|
||||
id = ns("file_import"),
|
||||
layout_params = "dropdown",
|
||||
title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
m_redcap_readUI(id = ns("redcap_import"))
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='env'",
|
||||
import_globalenv_ui(id = ns("env"), title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = ns("redcap_prev"))
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
data_import_server <- function(id) {
|
||||
module <- function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data_temp = NULL,
|
||||
code = list()
|
||||
)
|
||||
|
||||
data_file <- import_file_server(
|
||||
id = ns("file_import"),
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
shiny::req(data_file$data())
|
||||
|
||||
rv$data_temp <- data_file$data()
|
||||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- data_redcap()
|
||||
})
|
||||
|
||||
from_env <- datamods::import_globalenv_server(
|
||||
id = "env",
|
||||
trigger_return = "change",
|
||||
btn_show_data = FALSE,
|
||||
reset = reactive(input$hidden)
|
||||
)
|
||||
|
||||
shiny::observeEvent(from_env$data(), {
|
||||
shiny::req(from_env$data())
|
||||
|
||||
rv$data_temp <- from_env$data()
|
||||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
return(list(
|
||||
# status = reactive(temporary_rv$status),
|
||||
# name = reactive(temporary_rv$name),
|
||||
# code = reactive(temporary_rv$code),
|
||||
data = shiny::reactive(rv$data_temp)
|
||||
))
|
||||
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = module
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
|
||||
#' Test app for the data-import module
|
||||
#'
|
||||
#' shiny::fluidRow(
|
||||
#' shiny::column(width = 2),
|
||||
#' shiny::column(
|
||||
#' width = 8,
|
||||
#' shiny::h4("Choose your data source"),
|
||||
#' shiny::br(),
|
||||
#' shinyWidgets::radioGroupButtons(
|
||||
#' inputId = "source",
|
||||
#' selected = "env",
|
||||
#' choices = c(
|
||||
#' "File upload" = "file",
|
||||
#' "REDCap server export" = "redcap",
|
||||
#' "Local or sample data" = "env"
|
||||
#' ),
|
||||
#' width = "100%"
|
||||
#' ),
|
||||
#' shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='file'",
|
||||
#' import_file_ui(
|
||||
#' id = "file_import",
|
||||
#' layout_params = "dropdown",
|
||||
#' title = "Choose a datafile to upload",
|
||||
#' file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
#' )
|
||||
#' ),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='redcap'",
|
||||
#' m_redcap_readUI("redcap_import")
|
||||
#' ),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='env'",
|
||||
#' import_globalenv_ui(id = "env", title = NULL)
|
||||
#' ),
|
||||
#' shiny::conditionalPanel(
|
||||
#' condition = "input.source=='redcap'",
|
||||
#' DT::DTOutput(outputId = "redcap_prev")
|
||||
#' ),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::h5("Specify variables to include"),
|
||||
#' shiny::fluidRow(
|
||||
#' shiny::column(
|
||||
#' width = 6,
|
||||
#' shiny::br(),
|
||||
#' shiny::p("Filter by completeness threshold and manual selection:"),
|
||||
#' shiny::br(),
|
||||
#' shiny::br()
|
||||
#' ),
|
||||
#' shiny::column(
|
||||
#' width = 6,
|
||||
#' shinyWidgets::noUiSliderInput(
|
||||
#' inputId = "complete_cutoff",
|
||||
#' label = NULL,
|
||||
#' min = 0,
|
||||
#' max = 100,
|
||||
#' step = 5,
|
||||
#' value = 70,
|
||||
#' format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
#' color = datamods:::get_primary_color()
|
||||
#' ),
|
||||
#' shiny::helpText("Filter variables with completeness above the specified percentage."),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::uiOutput(outputId = "import_var")
|
||||
#' )
|
||||
#' ),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::actionButton(
|
||||
#' inputId = "act_start",
|
||||
#' label = "Start",
|
||||
#' width = "100%",
|
||||
#' icon = shiny::icon("play"),
|
||||
#' disabled = TRUE
|
||||
#' ),
|
||||
#' shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
#' shiny::br(),
|
||||
#' shiny::br(),
|
||||
#' shiny::column(width = 2)
|
||||
#' )
|
||||
#' )
|
||||
#' }
|
||||
#' @rdname data-import
|
||||
#'
|
||||
#'
|
||||
#' data_import_server <- function(id) {
|
||||
#' module <- function(input, output, session) {
|
||||
#' ns <- session$ns
|
||||
#'
|
||||
#' rv <- shiny::reactiveValues(
|
||||
#' data_original = NULL,
|
||||
#' data_temp = NULL,
|
||||
#' data = NULL,
|
||||
#' code = list()
|
||||
#' )
|
||||
#'
|
||||
#' data_file <- import_file_server(
|
||||
#' id = "file_import",
|
||||
#' show_data_in = "popup",
|
||||
#' trigger_return = "change",
|
||||
#' return_class = "data.frame",
|
||||
#' read_fns = list(
|
||||
#' ods = import_ods,
|
||||
#' dta = function(file) {
|
||||
#' haven::read_dta(
|
||||
#' file = file,
|
||||
#' .name_repair = "unique_quiet"
|
||||
#' )
|
||||
#' },
|
||||
#' # csv = function(file) {
|
||||
#' # readr::read_csv(
|
||||
#' # file = file,
|
||||
#' # na = consider.na,
|
||||
#' # name_repair = "unique_quiet"
|
||||
#' # )
|
||||
#' # },
|
||||
#' csv = import_delim,
|
||||
#' tsv = import_delim,
|
||||
#' txt = import_delim,
|
||||
#' xls = import_xls,
|
||||
#' xlsx = import_xls,
|
||||
#' rds = function(file) {
|
||||
#' readr::read_rds(
|
||||
#' file = file,
|
||||
#' name_repair = "unique_quiet"
|
||||
#' )
|
||||
#' }
|
||||
#' )
|
||||
#' )
|
||||
#'
|
||||
#' shiny::observeEvent(data_file$data(), {
|
||||
#' shiny::req(data_file$data())
|
||||
#' rv$data_temp <- data_file$data()
|
||||
#' rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
#' })
|
||||
#'
|
||||
#' data_redcap <- m_redcap_readServer(
|
||||
#' id = "redcap_import" # ,
|
||||
#' # output.format = "list"
|
||||
#' )
|
||||
#'
|
||||
#' shiny::observeEvent(data_redcap(), {
|
||||
#' # rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
#' rv$data_temp <- data_redcap()
|
||||
#' })
|
||||
#'
|
||||
#' output$redcap_prev <- DT::renderDT(
|
||||
#' {
|
||||
#' DT::datatable(head(data_redcap(), 5),
|
||||
#' # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
#' caption = "First 5 observations"
|
||||
#' )
|
||||
#' },
|
||||
#' server = TRUE
|
||||
#' )
|
||||
#'
|
||||
#' from_env <- datamods::import_globalenv_server(
|
||||
#' id = "env",
|
||||
#' trigger_return = "change",
|
||||
#' btn_show_data = FALSE,
|
||||
#' reset = reactive(input$hidden)
|
||||
#' )
|
||||
#'
|
||||
#' shiny::observeEvent(from_env$data(), {
|
||||
#' shiny::req(from_env$data())
|
||||
#'
|
||||
#' rv$data_temp <- from_env$data()
|
||||
#' # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
#' })
|
||||
#'
|
||||
#' output$import_var <- shiny::renderUI({
|
||||
#' shiny::req(rv$data_temp)
|
||||
#'
|
||||
#' preselect <- names(rv$data_temp)[sapply(rv$data_temp, missing_fraction) <= input$complete_cutoff / 100]
|
||||
#'
|
||||
#' shinyWidgets::virtualSelectInput(
|
||||
#' inputId = "import_var",
|
||||
#' label = "Select variables to include",
|
||||
#' selected = preselect,
|
||||
#' choices = names(rv$data_temp),
|
||||
#' updateOn = "close",
|
||||
#' multiple = TRUE,
|
||||
#' search = TRUE,
|
||||
#' showValueAsTags = TRUE
|
||||
#' )
|
||||
#' })
|
||||
#'
|
||||
#'
|
||||
#' shiny::observeEvent(
|
||||
#' eventExpr = list(
|
||||
#' input$import_var
|
||||
#' ),
|
||||
#' handlerExpr = {
|
||||
#' shiny::req(rv$data_temp)
|
||||
#'
|
||||
#' rv$data_original <- rv$data_temp |>
|
||||
#' dplyr::select(input$import_var) |>
|
||||
#' # janitor::clean_names() |>
|
||||
#' default_parsing()
|
||||
#' }
|
||||
#' )
|
||||
#'
|
||||
#' return(shiny::reactive(rv$data_original))
|
||||
#'
|
||||
#' }
|
||||
#'
|
||||
#' shiny::moduleServer(
|
||||
#' id = id,
|
||||
#' module = module
|
||||
#' )
|
||||
#'
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' #' Test app for the data-import module
|
||||
#' #'
|
||||
#' #' @rdname data-import
|
||||
#' #'
|
||||
#' #' @examples
|
||||
#' #' \dontrun{
|
||||
#' #' data_import_demo_app()
|
||||
#' #' }
|
||||
#' data_import_demo_app <- function() {
|
||||
#' ui <- shiny::fluidPage(
|
||||
#' data_import_ui("data")
|
||||
#' )
|
||||
#' server <- function(input, output, session) {
|
||||
#' data_val <- shiny::reactiveValues(data = NULL)
|
||||
#'
|
||||
#'
|
||||
#' data_val$data <- data_import_server(id = "data")
|
||||
#'
|
||||
#' output$data_summary <- DT::renderDataTable(
|
||||
#' {
|
||||
#' shiny::req(data_val$data)
|
||||
#' data_val$data()
|
||||
#' },
|
||||
#' options = list(
|
||||
#' scrollX = TRUE,
|
||||
#' pageLength = 5
|
||||
#' ),
|
||||
#' )
|
||||
#' }
|
||||
#' shiny::shinyApp(ui, server)
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data_import_demo_app()
|
||||
#' }
|
||||
data_import_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
data_import_ui("data_import"),
|
||||
toastui::datagridOutput2(outputId = "table"),
|
||||
DT::DTOutput("data_summary")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
imported <- shiny::reactive(data_import_server(id = "data_import"))
|
||||
|
||||
# output$data_summary <- DT::renderDataTable(
|
||||
# {
|
||||
# shiny::req(data_val$data)
|
||||
# data_val$data
|
||||
# },
|
||||
# options = list(
|
||||
# scrollX = TRUE,
|
||||
# pageLength = 5
|
||||
# )
|
||||
# )
|
||||
output$table <- toastui::renderDatagrid2({
|
||||
req(imported$data)
|
||||
toastui::datagrid(
|
||||
data = head(imported$data, 5),
|
||||
theme = "striped",
|
||||
colwidths = "guess",
|
||||
minBodyHeight = 250
|
||||
)
|
||||
})
|
||||
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -2768,7 +2689,9 @@ import_file_ui <- function(id,
|
|||
buttonLabel = datamods:::i18n("Browse..."),
|
||||
placeholder = datamods:::i18n("No file selected"),
|
||||
accept = file_extensions,
|
||||
width = "100%"
|
||||
width = "100%",
|
||||
## A solution to allow multiple file upload is being considered
|
||||
multiple = FALSE
|
||||
),
|
||||
class = "mb-0"
|
||||
)
|
||||
|
|
@ -2828,35 +2751,23 @@ import_file_ui <- function(id,
|
|||
)
|
||||
),
|
||||
if (isTRUE(preview_data)) {
|
||||
toastui::datagridOutput2(outputId = ns("table"))
|
||||
}
|
||||
,
|
||||
toastui::datagridOutput2(outputId = ns("table"))
|
||||
},
|
||||
shiny::uiOutput(
|
||||
outputId = ns("container_confirm_btn"),
|
||||
style = "margin-top: 20px;"
|
||||
) ,
|
||||
),
|
||||
tags$div(
|
||||
style = htmltools::css(display = "none"),
|
||||
shiny::checkboxInput(
|
||||
inputId = ns("preview_data"),
|
||||
label = NULL,
|
||||
value = isTRUE(preview_data)
|
||||
)
|
||||
shiny::checkboxInput(
|
||||
inputId = ns("preview_data"),
|
||||
label = NULL,
|
||||
value = isTRUE(preview_data)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' @param read_fns Named list with custom function(s) to read data:
|
||||
#' * the name must be the extension of the files to which the function will be applied
|
||||
#' * the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names),
|
||||
#' passed by user through the interface:
|
||||
#' + `file`: path to the file
|
||||
#' + `sheet`: for Excel files, sheet to read
|
||||
#' + `skip`: number of row to skip
|
||||
#' + `dec`: decimal separator
|
||||
#' + `encoding`: file encoding
|
||||
#' + `na.strings`: character(s) to interpret as missing values.
|
||||
#'
|
||||
#' @export
|
||||
#'
|
||||
|
|
@ -2867,16 +2778,17 @@ import_file_server <- function(id,
|
|||
show_data_in = c("popup", "modal"),
|
||||
trigger_return = c("button", "change"),
|
||||
return_class = c("data.frame", "data.table", "tbl_df", "raw"),
|
||||
reset = reactive(NULL),
|
||||
read_fns = list()) {
|
||||
if (length(read_fns) > 0) {
|
||||
if (!rlang::is_named(read_fns)) {
|
||||
stop("import_file_server: `read_fns` must be a named list.", call. = FALSE)
|
||||
}
|
||||
if (!all(vapply(read_fns, rlang::is_function, logical(1)))) {
|
||||
stop("import_file_server: `read_fns` must be list of function(s).", call. = FALSE)
|
||||
}
|
||||
}
|
||||
reset = reactive(NULL)) {
|
||||
read_fns <- list(
|
||||
ods = "import_ods",
|
||||
dta = "import_dta",
|
||||
csv = "import_delim",
|
||||
tsv = "import_delim",
|
||||
txt = "import_delim",
|
||||
xls = "import_xls",
|
||||
xlsx = "import_xls",
|
||||
rds = "import_rds"
|
||||
)
|
||||
|
||||
trigger_return <- match.arg(trigger_return)
|
||||
return_class <- match.arg(return_class)
|
||||
|
|
@ -2931,10 +2843,7 @@ import_file_server <- function(id,
|
|||
{
|
||||
req(input$file)
|
||||
if (is_workbook(input$file$datapath)) shiny::req(input$sheet)
|
||||
# browser()
|
||||
|
||||
# browser()
|
||||
# req(input$skip_rows)
|
||||
extension <- tools::file_ext(input$file$datapath)
|
||||
|
||||
parameters <- list(
|
||||
|
|
@ -2945,9 +2854,11 @@ import_file_server <- function(id,
|
|||
encoding = input$encoding,
|
||||
na.strings = datamods:::split_char(input$na_label)
|
||||
)
|
||||
parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
|
||||
|
||||
parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))]
|
||||
# parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
|
||||
imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE)
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)))
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "freesearcheR")
|
||||
|
||||
if (inherits(imported, "try-error")) {
|
||||
imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
|
||||
|
|
@ -3044,11 +2955,19 @@ is_workbook <- function(path) {
|
|||
is_excel(path) || is_ods(path)
|
||||
}
|
||||
|
||||
#' Wrapper of data.table::fread to import delim files with few presets
|
||||
|
||||
# File import functions ---------------------------------------------------
|
||||
|
||||
#' Wrapper to ease data file import
|
||||
#'
|
||||
#' @param file file
|
||||
#' @param encoding encoding
|
||||
#' @param na.strings na.strings
|
||||
#' @param file path to the file
|
||||
#' @param sheet for Excel files, sheet to read
|
||||
#' @param skip number of row to skip
|
||||
#' @param encoding file encoding
|
||||
#' @param na.strings character(s) to interpret as missing values.
|
||||
#'
|
||||
#'
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
|
|
@ -3067,6 +2986,12 @@ import_delim <- function(file, skip, encoding, na.strings) {
|
|||
)
|
||||
}
|
||||
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_xls <- function(file, sheet, skip, na.strings) {
|
||||
tryCatch(
|
||||
{
|
||||
|
|
@ -3092,6 +3017,12 @@ import_xls <- function(file, sheet, skip, na.strings) {
|
|||
)
|
||||
}
|
||||
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_ods <- function(file, sheet, skip, na.strings) {
|
||||
tryCatch(
|
||||
{
|
||||
|
|
@ -3115,6 +3046,30 @@ import_ods <- function(file, sheet, skip, na.strings) {
|
|||
)
|
||||
}
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_dta <- function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
|
||||
#' @name import-file-type
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
import_rds <- function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
|
||||
#' @title Create a select input control with icon(s)
|
||||
#'
|
||||
#' @description Extend form controls by adding text or icons before,
|
||||
|
|
@ -3198,35 +3153,7 @@ import_file_demo_app <- function() {
|
|||
id = "myid",
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
# Custom functions to read data
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
# csv = function(file) {
|
||||
# readr::read_csv(
|
||||
# file = file,
|
||||
# na = consider.na,
|
||||
# name_repair = "unique_quiet"
|
||||
# )
|
||||
# },
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
output$status <- shiny::renderPrint({
|
||||
|
|
@ -3937,7 +3864,7 @@ m_redcap_readServer <- function(id) {
|
|||
dd_list = NULL,
|
||||
data = NULL,
|
||||
rep_fields = NULL,
|
||||
imported = NULL
|
||||
code = NULL
|
||||
)
|
||||
|
||||
shiny::observeEvent(list(input$api, input$uri), {
|
||||
|
|
@ -4134,7 +4061,10 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
})
|
||||
code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters)
|
||||
|
||||
code <- rlang::call2("read_redcap_tables",
|
||||
!!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
|
||||
, .ns = "REDCapCAST")
|
||||
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
|
|
@ -4169,6 +4099,8 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
}
|
||||
|
||||
data_rv$code <- code
|
||||
|
||||
data_rv$data <- out |>
|
||||
dplyr::select(-dplyr::ends_with("_complete")) |>
|
||||
# dplyr::select(-dplyr::any_of(record_id)) |>
|
||||
|
|
@ -4184,7 +4116,13 @@ m_redcap_readServer <- function(id) {
|
|||
#
|
||||
# })
|
||||
|
||||
return(shiny::reactive(data_rv$data))
|
||||
return(list(
|
||||
status = shiny::reactive(data_rv$data_status),
|
||||
name = shiny::reactive(data_rv$info$project_title),
|
||||
info = shiny::reactive(data_rv$info),
|
||||
code = shiny::reactive(data_rv$code),
|
||||
data = shiny::reactive(data_rv$data)
|
||||
))
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
|
|
@ -4337,15 +4275,15 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
|
|||
redcap_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
m_redcap_readUI("data"),
|
||||
DT::DTOutput("data_summary")
|
||||
DT::DTOutput("data"),
|
||||
shiny::tags$b("Code:"),
|
||||
shiny::verbatimTextOutput(outputId = "code")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_val <- shiny::reactiveValues(data = NULL)
|
||||
|
||||
data_val <- m_redcap_readServer(id = "data")
|
||||
|
||||
data_val$data <- m_redcap_readServer(id = "data")
|
||||
|
||||
output$data_summary <- DT::renderDataTable(
|
||||
output$data <- DT::renderDataTable(
|
||||
{
|
||||
shiny::req(data_val$data)
|
||||
data_val$data()
|
||||
|
|
@ -4355,6 +4293,10 @@ redcap_demo_app <- function() {
|
|||
pageLength = 5
|
||||
),
|
||||
)
|
||||
output$code <- shiny::renderPrint({
|
||||
shiny::req(data_val$code)
|
||||
data_val$code()
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
|
@ -6773,7 +6715,7 @@ ui_elements <- list(
|
|||
id = "file_import",
|
||||
layout_params = "dropdown",
|
||||
# title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
|
|
@ -7290,7 +7232,7 @@ ui_elements <- list(
|
|||
"docs" = bslib::nav_item(
|
||||
# shiny::img(shiny::icon("book")),
|
||||
shiny::tags$a(
|
||||
href = "https://agdamsbo.github.io/freesearcheR/",
|
||||
href = "https://agdamsbo.github.io/FreesearchR/",
|
||||
"Docs (external)",
|
||||
target = "_blank",
|
||||
rel = "noopener noreferrer"
|
||||
|
|
@ -7346,7 +7288,7 @@ ui <- bslib::page_fixed(
|
|||
),
|
||||
shiny::p(
|
||||
style = "margin: 1; color: #888;",
|
||||
"AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer")
|
||||
"AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
),
|
||||
)
|
||||
)
|
||||
|
|
@ -7456,34 +7398,7 @@ server <- function(input, output, session) {
|
|||
id = "file_import",
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
# csv = function(file) {
|
||||
# readr::read_csv(
|
||||
# file = file,
|
||||
# na = consider.na,
|
||||
# name_repair = "unique_quiet"
|
||||
# )
|
||||
# },
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
|
|
@ -7492,18 +7407,19 @@ server <- function(input, output, session) {
|
|||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
from_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
shiny::observeEvent(from_redcap$data(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- data_redcap()
|
||||
rv$data_temp <- from_redcap$data()
|
||||
rv$code <- append_list(data = from_redcap$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
output$redcap_prev <- DT::renderDT(
|
||||
{
|
||||
DT::datatable(head(data_redcap(), 5),
|
||||
DT::datatable(head(from_redcap$data(), 5),
|
||||
# DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
caption = "First 5 observations"
|
||||
)
|
||||
|
|
@ -7552,8 +7468,20 @@ server <- function(input, output, session) {
|
|||
|
||||
rv$data_original <- rv$data_temp |>
|
||||
dplyr::select(input$import_var) |>
|
||||
# janitor::clean_names() |>
|
||||
default_parsing()
|
||||
|
||||
rv$code$import <- rv$code$import |>
|
||||
deparse() |>
|
||||
paste(collapse="") |>
|
||||
paste("|>
|
||||
dplyr::select(",paste(input$import_var,collapse=","),") |>
|
||||
freesearcheR::default_parsing()") |>
|
||||
(\(.x){
|
||||
paste0("data <- ",.x)
|
||||
})()
|
||||
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -7590,6 +7518,8 @@ server <- function(input, output, session) {
|
|||
if (isTRUE(input$reset_confirm)) {
|
||||
shiny::req(rv$data_original)
|
||||
rv$data <- rv$data_original
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
},
|
||||
ignoreNULL = TRUE
|
||||
|
|
@ -7647,7 +7577,10 @@ server <- function(input, output, session) {
|
|||
data_r = shiny::reactive(rv$data)
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut())
|
||||
shiny::observeEvent(data_modal_cut(), {
|
||||
rv$data <- data_modal_cut()
|
||||
rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code")
|
||||
})
|
||||
|
||||
######### Modify factor
|
||||
|
||||
|
|
@ -7664,6 +7597,7 @@ server <- function(input, output, session) {
|
|||
shiny::observeEvent(data_modal_update(), {
|
||||
shiny::removeModal()
|
||||
rv$data <- data_modal_update()
|
||||
rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code")
|
||||
})
|
||||
|
||||
######### Create column
|
||||
|
|
@ -7684,6 +7618,7 @@ server <- function(input, output, session) {
|
|||
data_modal_r(),
|
||||
{
|
||||
rv$data <- data_modal_r()
|
||||
rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code")
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -7711,9 +7646,9 @@ server <- function(input, output, session) {
|
|||
}
|
||||
)
|
||||
|
||||
output$code <- renderPrint({
|
||||
attr(rv$data, "code")
|
||||
})
|
||||
# output$code <- renderPrint({
|
||||
# attr(rv$data, "code")
|
||||
# })
|
||||
|
||||
# updated_data <- datamods::update_variables_server(
|
||||
updated_data <- update_variables_server(
|
||||
|
|
@ -7786,33 +7721,16 @@ server <- function(input, output, session) {
|
|||
}
|
||||
)
|
||||
|
||||
# output$filtered_code <- shiny::renderPrint({
|
||||
# out <- gsub(
|
||||
# "filter", "dplyr::filter",
|
||||
# gsub(
|
||||
# "\\s{2,}", " ",
|
||||
# paste0(
|
||||
# capture.output(attr(rv$data_filtered, "code")),
|
||||
# collapse = " "
|
||||
# )
|
||||
# )
|
||||
# )
|
||||
#
|
||||
# out <- strsplit(out, "%>%") |>
|
||||
# unlist() |>
|
||||
# (\(.x){
|
||||
# paste(c("data", .x[-1]), collapse = "|> \n ")
|
||||
# })()
|
||||
#
|
||||
# cat(out)
|
||||
# })
|
||||
|
||||
output$code_import <- shiny::renderPrint({
|
||||
cat(rv$code$import)
|
||||
})
|
||||
|
||||
output$code_data <- shiny::renderPrint({
|
||||
attr(rv$data, "code")
|
||||
ls <- rv$code$modify |> unique()
|
||||
out <- paste("data |> \n",
|
||||
sapply(ls,\(.x) paste(deparse(.x),collapse=",")),
|
||||
collapse="|> \n")
|
||||
cat(out)
|
||||
})
|
||||
|
||||
output$code_filter <- shiny::renderPrint({
|
||||
|
|
|
|||
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 9937654
|
||||
bundleId:
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -97,34 +97,7 @@ server <- function(input, output, session) {
|
|||
id = "file_import",
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
# csv = function(file) {
|
||||
# readr::read_csv(
|
||||
# file = file,
|
||||
# na = consider.na,
|
||||
# name_repair = "unique_quiet"
|
||||
# )
|
||||
# },
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
|
|
@ -133,18 +106,19 @@ server <- function(input, output, session) {
|
|||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
from_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
shiny::observeEvent(from_redcap$data(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- data_redcap()
|
||||
rv$data_temp <- from_redcap$data()
|
||||
rv$code <- append_list(data = from_redcap$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
output$redcap_prev <- DT::renderDT(
|
||||
{
|
||||
DT::datatable(head(data_redcap(), 5),
|
||||
DT::datatable(head(from_redcap$data(), 5),
|
||||
# DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
caption = "First 5 observations"
|
||||
)
|
||||
|
|
@ -193,8 +167,20 @@ server <- function(input, output, session) {
|
|||
|
||||
rv$data_original <- rv$data_temp |>
|
||||
dplyr::select(input$import_var) |>
|
||||
# janitor::clean_names() |>
|
||||
default_parsing()
|
||||
|
||||
rv$code$import <- rv$code$import |>
|
||||
deparse() |>
|
||||
paste(collapse="") |>
|
||||
paste("|>
|
||||
dplyr::select(",paste(input$import_var,collapse=","),") |>
|
||||
freesearcheR::default_parsing()") |>
|
||||
(\(.x){
|
||||
paste0("data <- ",.x)
|
||||
})()
|
||||
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -231,6 +217,8 @@ server <- function(input, output, session) {
|
|||
if (isTRUE(input$reset_confirm)) {
|
||||
shiny::req(rv$data_original)
|
||||
rv$data <- rv$data_original
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
},
|
||||
ignoreNULL = TRUE
|
||||
|
|
@ -288,7 +276,10 @@ server <- function(input, output, session) {
|
|||
data_r = shiny::reactive(rv$data)
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut())
|
||||
shiny::observeEvent(data_modal_cut(), {
|
||||
rv$data <- data_modal_cut()
|
||||
rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code")
|
||||
})
|
||||
|
||||
######### Modify factor
|
||||
|
||||
|
|
@ -305,6 +296,7 @@ server <- function(input, output, session) {
|
|||
shiny::observeEvent(data_modal_update(), {
|
||||
shiny::removeModal()
|
||||
rv$data <- data_modal_update()
|
||||
rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code")
|
||||
})
|
||||
|
||||
######### Create column
|
||||
|
|
@ -325,6 +317,7 @@ server <- function(input, output, session) {
|
|||
data_modal_r(),
|
||||
{
|
||||
rv$data <- data_modal_r()
|
||||
rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code")
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -352,9 +345,9 @@ server <- function(input, output, session) {
|
|||
}
|
||||
)
|
||||
|
||||
output$code <- renderPrint({
|
||||
attr(rv$data, "code")
|
||||
})
|
||||
# output$code <- renderPrint({
|
||||
# attr(rv$data, "code")
|
||||
# })
|
||||
|
||||
# updated_data <- datamods::update_variables_server(
|
||||
updated_data <- update_variables_server(
|
||||
|
|
@ -427,33 +420,16 @@ server <- function(input, output, session) {
|
|||
}
|
||||
)
|
||||
|
||||
# output$filtered_code <- shiny::renderPrint({
|
||||
# out <- gsub(
|
||||
# "filter", "dplyr::filter",
|
||||
# gsub(
|
||||
# "\\s{2,}", " ",
|
||||
# paste0(
|
||||
# capture.output(attr(rv$data_filtered, "code")),
|
||||
# collapse = " "
|
||||
# )
|
||||
# )
|
||||
# )
|
||||
#
|
||||
# out <- strsplit(out, "%>%") |>
|
||||
# unlist() |>
|
||||
# (\(.x){
|
||||
# paste(c("data", .x[-1]), collapse = "|> \n ")
|
||||
# })()
|
||||
#
|
||||
# cat(out)
|
||||
# })
|
||||
|
||||
output$code_import <- shiny::renderPrint({
|
||||
cat(rv$code$import)
|
||||
})
|
||||
|
||||
output$code_data <- shiny::renderPrint({
|
||||
attr(rv$data, "code")
|
||||
ls <- rv$code$modify |> unique()
|
||||
out <- paste("data |> \n",
|
||||
sapply(ls,\(.x) paste(deparse(.x),collapse=",")),
|
||||
collapse="|> \n")
|
||||
cat(out)
|
||||
})
|
||||
|
||||
output$code_filter <- shiny::renderPrint({
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ ui_elements <- list(
|
|||
id = "file_import",
|
||||
layout_params = "dropdown",
|
||||
# title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
|
|
@ -567,7 +567,7 @@ ui_elements <- list(
|
|||
"docs" = bslib::nav_item(
|
||||
# shiny::img(shiny::icon("book")),
|
||||
shiny::tags$a(
|
||||
href = "https://agdamsbo.github.io/freesearcheR/",
|
||||
href = "https://agdamsbo.github.io/FreesearchR/",
|
||||
"Docs (external)",
|
||||
target = "_blank",
|
||||
rel = "noopener noreferrer"
|
||||
|
|
@ -623,7 +623,7 @@ ui <- bslib::page_fixed(
|
|||
),
|
||||
shiny::p(
|
||||
style = "margin: 1; color: #888;",
|
||||
"AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer")
|
||||
"AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
),
|
||||
)
|
||||
)
|
||||
|
|
|
|||
16
man/data-import.Rd
Normal file
16
man/data-import.Rd
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data-import.R
|
||||
\name{data_import_demo_app}
|
||||
\alias{data_import_demo_app}
|
||||
\title{Test app for the data-import module}
|
||||
\usage{
|
||||
data_import_demo_app()
|
||||
}
|
||||
\description{
|
||||
Test app for the data-import module
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
data_import_demo_app()
|
||||
}
|
||||
}
|
||||
46
man/import-file-type.Rd
Normal file
46
man/import-file-type.Rd
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/import-file-ext.R
|
||||
\name{import-file-type}
|
||||
\alias{import-file-type}
|
||||
\alias{import_delim}
|
||||
\alias{import_xls}
|
||||
\alias{import_ods}
|
||||
\alias{import_dta}
|
||||
\alias{import_rds}
|
||||
\title{Wrapper to ease data file import}
|
||||
\usage{
|
||||
import_delim(file, skip, encoding, na.strings)
|
||||
|
||||
import_xls(file, sheet, skip, na.strings)
|
||||
|
||||
import_ods(file, sheet, skip, na.strings)
|
||||
|
||||
import_dta(file)
|
||||
|
||||
import_rds(file)
|
||||
}
|
||||
\arguments{
|
||||
\item{file}{path to the file}
|
||||
|
||||
\item{skip}{number of row to skip}
|
||||
|
||||
\item{encoding}{file encoding}
|
||||
|
||||
\item{na.strings}{character(s) to interpret as missing values.}
|
||||
|
||||
\item{sheet}{for Excel files, sheet to read}
|
||||
}
|
||||
\value{
|
||||
data.frame
|
||||
|
||||
data.frame
|
||||
|
||||
data.frame
|
||||
|
||||
data.frame
|
||||
|
||||
data.frame
|
||||
}
|
||||
\description{
|
||||
Wrapper to ease data file import
|
||||
}
|
||||
|
|
@ -21,8 +21,7 @@ import_file_server(
|
|||
show_data_in = c("popup", "modal"),
|
||||
trigger_return = c("button", "change"),
|
||||
return_class = c("data.frame", "data.table", "tbl_df", "raw"),
|
||||
reset = reactive(NULL),
|
||||
read_fns = list()
|
||||
reset = reactive(NULL)
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
|
|
@ -31,21 +30,6 @@ import_file_server(
|
|||
\item{file_extensions}{File extensions accepted by \code{\link[shiny:fileInput]{shiny::fileInput()}}, can also be MIME type.}
|
||||
|
||||
\item{layout_params}{How to display import parameters : in a dropdown button or inline below file input.}
|
||||
|
||||
\item{read_fns}{Named list with custom function(s) to read data:
|
||||
\itemize{
|
||||
\item the name must be the extension of the files to which the function will be applied
|
||||
\item the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names),
|
||||
passed by user through the interface:
|
||||
\itemize{
|
||||
\item \code{file}: path to the file
|
||||
\item \code{sheet}: for Excel files, sheet to read
|
||||
\item \code{skip}: number of row to skip
|
||||
\item \code{dec}: decimal separator
|
||||
\item \code{encoding}: file encoding
|
||||
\item \code{na.strings}: character(s) to interpret as missing values.
|
||||
}
|
||||
}}
|
||||
}
|
||||
\description{
|
||||
Let user upload a file and import data
|
||||
|
|
|
|||
16
man/import-file_module.Rd
Normal file
16
man/import-file_module.Rd
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/import-file-ext.R
|
||||
\name{import_file_demo_app}
|
||||
\alias{import_file_demo_app}
|
||||
\title{Test app for the import_file module}
|
||||
\usage{
|
||||
import_file_demo_app()
|
||||
}
|
||||
\description{
|
||||
Test app for the import_file module
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
import_file_demo_app()
|
||||
}
|
||||
}
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/import-file-ext.R
|
||||
\name{import_delim}
|
||||
\alias{import_delim}
|
||||
\title{Wrapper of data.table::fread to import delim files with few presets}
|
||||
\usage{
|
||||
import_delim(file, skip, encoding, na.strings)
|
||||
}
|
||||
\arguments{
|
||||
\item{file}{file}
|
||||
|
||||
\item{encoding}{encoding}
|
||||
|
||||
\item{na.strings}{na.strings}
|
||||
}
|
||||
\value{
|
||||
data.frame
|
||||
}
|
||||
\description{
|
||||
Wrapper of data.table::fread to import delim files with few presets
|
||||
}
|
||||
|
|
@ -6,7 +6,7 @@
|
|||
\alias{update_variables_server}
|
||||
\title{Select, rename and convert variables}
|
||||
\usage{
|
||||
update_variables_ui(id, title = TRUE)
|
||||
update_variables_ui(id, title = "")
|
||||
|
||||
update_variables_server(
|
||||
id,
|
||||
|
|
|
|||
2
vignettes/.gitignore
vendored
Normal file
2
vignettes/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
*.html
|
||||
*.R
|
||||
74
vignettes/freesearcheR.Rmd
Normal file
74
vignettes/freesearcheR.Rmd
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
---
|
||||
title: "freesearcheR"
|
||||
output: rmarkdown::html_vignette
|
||||
vignette: >
|
||||
%\VignetteIndexEntry{freesearcheR}
|
||||
%\VignetteEngine{knitr::rmarkdown}
|
||||
%\VignetteEncoding{UTF-8}
|
||||
---
|
||||
|
||||
```{r setup, include=FALSE}
|
||||
knitr::opts_chunk$set(echo = TRUE,eval = FALSE)
|
||||
```
|
||||
|
||||
# Getting started with ***freesearcheR***
|
||||
|
||||
Below is a simple walk-trough and basic instructions for the functions on the freesearcheR app.
|
||||
|
||||
## Launching
|
||||
|
||||
The easiest way to get started is to launch [the hosted version of the app on shinyapps.io (click this link)](https://agdamsbo.shinyapps.io/freesearcheR/).
|
||||
|
||||
Additionally you have the option to run the app locally with access to any data in your current working environment.
|
||||
|
||||
To do this, open *R* (or RStudio or similar), and run the following code to install the latest version of ***freesearcheR*** and launch the app:
|
||||
|
||||
``` {r}
|
||||
require("pak")
|
||||
pak::pak("agdamsbo/freesearcheR")
|
||||
library(freesearcheR)
|
||||
freesearcheR::launch_freesearcheR()
|
||||
```
|
||||
|
||||
As a small note, a standalone Windows app version is on the drawing board as well, but no time frame is available.
|
||||
|
||||
## Importing data
|
||||
|
||||
Once in the app and in the "*Import*", you have three options available for importing data: file upload, REDCap server export and local or sample data.
|
||||
|
||||
After choosing a data source, you can set a threshold to filter data be completenes and further manually specify variables to include for analyses.
|
||||
|
||||
### File upload
|
||||
|
||||
Currently several data file formats are supported for easy import (csv, txt, xls(x), ods, rds, dta). If importing workbooks (xls(x) or ods), you are prompted to specify sheet(s) to import. If choosing multiple sheets, these are automatically merged by common variable(s), so please make sure that key variables are correctly named identically.
|
||||
|
||||
### REDCap server export
|
||||
|
||||
|
||||
### Local or sample data
|
||||
|
||||
|
||||
## Evaluate
|
||||
|
||||
### Baseline
|
||||
|
||||
### Correlation matrix
|
||||
|
||||
|
||||
## Visualise
|
||||
|
||||
- Would be nice to have a table of possible plots, their description and data options
|
||||
|
||||
|
||||
## Regression
|
||||
|
||||
|
||||
## Download
|
||||
|
||||
### Report
|
||||
|
||||
|
||||
### Data
|
||||
|
||||
|
||||
### Code
|
||||
Loading…
Add table
Reference in a new issue