Compare commits

..

3 commits

Author SHA1 Message Date
0994cb42ec
qa
Some checks are pending
pkgdown.yaml / pkgdown (push) Waiting to run
2025-03-17 21:13:49 +01:00
a8ab648eda
deployed latest 2025-03-17 20:26:30 +01:00
9e8ff6b4a9
improved code output 2025-03-17 15:00:13 +01:00
22 changed files with 782 additions and 816 deletions

1
.gitignore vendored
View file

@ -9,3 +9,4 @@ app/rsconnect
inst/shiny-examples/casting/functions.R
functions.R
docs
inst/doc

View file

@ -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

View file

@ -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)

View file

@ -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
View file

@ -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.

View file

@ -1 +1 @@
app_version <- function()'250313_1502'
app_version <- function()'250317_2113'

View file

@ -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)
#' )
#' )
#' }
#'
#'
#' 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)
#' @rdname data-import
#'
#' @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)
}

View file

@ -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"
)
@ -146,8 +148,7 @@ import_file_ui <- function(id,
),
if (isTRUE(preview_data)) {
toastui::datagridOutput2(outputId = ns("table"))
}
,
},
shiny::uiOutput(
outputId = ns("container_confirm_btn"),
style = "margin-top: 20px;"
@ -163,17 +164,6 @@ import_file_ui <- function(id,
)
}
#' @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({

View file

@ -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)
}

View file

@ -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

View file

@ -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)
#' )
#' )
#' }
#'
#'
#' 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)
#' @rdname data-import
#'
#' @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"
)
@ -2829,8 +2752,7 @@ import_file_ui <- function(id,
),
if (isTRUE(preview_data)) {
toastui::datagridOutput2(outputId = ns("table"))
}
,
},
shiny::uiOutput(
outputId = ns("container_confirm_btn"),
style = "margin-top: 20px;"
@ -2846,17 +2768,6 @@ import_file_ui <- function(id,
)
}
#' @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({

View file

@ -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

View file

@ -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({

View file

@ -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
View 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
View 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
}

View file

@ -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
View 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()
}
}

View file

@ -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
}

View file

@ -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
View file

@ -0,0 +1,2 @@
*.html
*.R

View 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