mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
organising plotting functions - nicer plot wrapping - merge mulitple workbook sheets
This commit is contained in:
parent
efc3f8acc3
commit
49016a4aa8
20 changed files with 1615 additions and 910 deletions
|
|
@ -1,3 +1,8 @@
|
|||
# library(htmltools)
|
||||
# library(shiny)
|
||||
# library(shinyWidgets)
|
||||
# library(rlang)
|
||||
# library(readxl)
|
||||
|
||||
#' @title Import data from a file
|
||||
#'
|
||||
|
|
@ -11,26 +16,20 @@
|
|||
#'
|
||||
#' @name import-file
|
||||
#'
|
||||
#' @importFrom shiny NS fileInput actionButton icon
|
||||
#' @importFrom htmltools tags tagAppendAttributes css tagAppendChild
|
||||
#' @importFrom shinyWidgets pickerInput numericInputIcon textInputIcon dropMenu
|
||||
#' @importFrom phosphoricons ph
|
||||
#' @importFrom toastui datagridOutput2
|
||||
#'
|
||||
import_file_ui <- function(id,
|
||||
title = TRUE,
|
||||
title = "",
|
||||
preview_data = TRUE,
|
||||
file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav"),
|
||||
layout_params = c("dropdown", "inline")) {
|
||||
|
||||
ns <- NS(id)
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
if (!is.null(layout_params)) {
|
||||
layout_params <- match.arg(layout_params)
|
||||
}
|
||||
|
||||
if (isTRUE(title)) {
|
||||
title <- tags$h4(
|
||||
title <- shiny::tags$h4(
|
||||
datamods:::i18n("Import a file"),
|
||||
class = "datamods-title"
|
||||
)
|
||||
|
|
@ -58,7 +57,7 @@ import_file_ui <- function(id,
|
|||
size = "sm",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText(ph("info"), datamods:::i18n("if several use a comma (',') to separate them"))
|
||||
shiny::helpText(phosphoricons::ph("info"), datamods:::i18n("if several use a comma (',') to separate them"))
|
||||
)
|
||||
),
|
||||
shiny::column(
|
||||
|
|
@ -74,8 +73,10 @@ import_file_ui <- function(id,
|
|||
selectInputIcon(
|
||||
inputId = ns("encoding"),
|
||||
label = datamods:::i18n("Encoding:"),
|
||||
choices = c("UTF-8"="UTF-8",
|
||||
"Latin1"="latin1"),
|
||||
choices = c(
|
||||
"UTF-8" = "UTF-8",
|
||||
"Latin1" = "latin1"
|
||||
),
|
||||
icon = phosphoricons::ph("text-aa"),
|
||||
size = "sm",
|
||||
width = "100%"
|
||||
|
|
@ -113,7 +114,7 @@ import_file_ui <- function(id,
|
|||
shinyWidgets::dropMenu(
|
||||
shiny::actionButton(
|
||||
inputId = ns("dropdown_params"),
|
||||
label = ph("gear", title = "Parameters"),
|
||||
label = phosphoricons::ph("gear", title = "Parameters"),
|
||||
width = "50px",
|
||||
class = "px-1"
|
||||
),
|
||||
|
|
@ -122,23 +123,24 @@ import_file_ui <- function(id,
|
|||
)
|
||||
)
|
||||
}
|
||||
tags$div(
|
||||
shiny::tags$div(
|
||||
class = "datamods-import",
|
||||
datamods:::html_dependency_datamods(),
|
||||
title,
|
||||
file_ui,
|
||||
if (identical(layout_params, "inline")) params_ui,
|
||||
tags$div(
|
||||
shiny::tags$div(
|
||||
class = "hidden",
|
||||
id = ns("sheet-container"),
|
||||
shinyWidgets::pickerInput(
|
||||
inputId = ns("sheet"),
|
||||
label = datamods:::i18n("Select sheet to import:"),
|
||||
choices = NULL,
|
||||
width = "100%"
|
||||
width = "100%",
|
||||
multiple = TRUE
|
||||
)
|
||||
),
|
||||
tags$div(
|
||||
shiny::tags$div(
|
||||
id = ns("import-placeholder"),
|
||||
shinyWidgets::alert(
|
||||
id = ns("import-result"),
|
||||
|
|
@ -149,19 +151,20 @@ import_file_ui <- function(id,
|
|||
)
|
||||
),
|
||||
if (isTRUE(preview_data)) {
|
||||
toastui::datagridOutput2(outputId = ns("table"))
|
||||
},
|
||||
uiOutput(
|
||||
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)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
|
@ -180,16 +183,6 @@ import_file_ui <- function(id,
|
|||
#'
|
||||
#' @export
|
||||
#'
|
||||
#' @importFrom shiny moduleServer
|
||||
#' @importFrom htmltools tags tagList
|
||||
#' @importFrom shiny reactiveValues reactive observeEvent removeUI req
|
||||
#' @importFrom shinyWidgets updatePickerInput
|
||||
#' @importFrom readxl excel_sheets
|
||||
#' @importFrom rio import
|
||||
#' @importFrom rlang exec fn_fmls_names is_named is_function
|
||||
#' @importFrom tools file_ext
|
||||
#' @importFrom utils head
|
||||
#' @importFrom toastui renderDatagrid2 datagrid
|
||||
#'
|
||||
#' @rdname import-file
|
||||
import_file_server <- function(id,
|
||||
|
|
@ -199,48 +192,49 @@ import_file_server <- function(id,
|
|||
return_class = c("data.frame", "data.table", "tbl_df", "raw"),
|
||||
reset = reactive(NULL),
|
||||
read_fns = list()) {
|
||||
|
||||
if (length(read_fns) > 0) {
|
||||
if (!is_named(read_fns))
|
||||
if (!rlang::is_named(read_fns)) {
|
||||
stop("import_file_server: `read_fns` must be a named list.", call. = FALSE)
|
||||
if (!all(vapply(read_fns, is_function, logical(1))))
|
||||
}
|
||||
if (!all(vapply(read_fns, rlang::is_function, logical(1)))) {
|
||||
stop("import_file_server: `read_fns` must be list of function(s).", call. = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
trigger_return <- match.arg(trigger_return)
|
||||
return_class <- match.arg(return_class)
|
||||
|
||||
module <- function(input, output, session) {
|
||||
|
||||
ns <- session$ns
|
||||
imported_rv <- reactiveValues(data = NULL, name = NULL)
|
||||
temporary_rv <- reactiveValues(data = NULL, name = NULL, status = NULL)
|
||||
imported_rv <- shiny::reactiveValues(data = NULL, name = NULL)
|
||||
temporary_rv <- shiny::reactiveValues(data = NULL, name = NULL, status = NULL)
|
||||
|
||||
observeEvent(reset(), {
|
||||
shiny::observeEvent(reset(), {
|
||||
temporary_rv$data <- NULL
|
||||
temporary_rv$name <- NULL
|
||||
temporary_rv$status <- NULL
|
||||
})
|
||||
|
||||
output$container_confirm_btn <- renderUI({
|
||||
output$container_confirm_btn <- shiny::renderUI({
|
||||
if (identical(trigger_return, "button")) {
|
||||
datamods:::button_import()
|
||||
}
|
||||
})
|
||||
|
||||
observeEvent(input$file, {
|
||||
if (isTRUE(is_excel(input$file$datapath))) {
|
||||
shiny::observeEvent(input$file, {
|
||||
if (isTRUE(is_workbook(input$file$datapath))) {
|
||||
if (isTRUE(is_excel(input$file$datapath))) {
|
||||
choices <- readxl::excel_sheets(input$file$datapath)
|
||||
} else if (isTRUE(is_ods(input$file$datapath))) {
|
||||
choices <- readODS::ods_sheets(input$file$datapath)
|
||||
}
|
||||
selected <- choices[1]
|
||||
|
||||
shinyWidgets::updatePickerInput(
|
||||
session = session,
|
||||
inputId = "sheet",
|
||||
choices = readxl::excel_sheets(input$file$datapath)
|
||||
)
|
||||
datamods:::showUI(paste0("#", ns("sheet-container")))
|
||||
} else if (isTRUE(is_ods(input$file$datapath))) {
|
||||
shinyWidgets::updatePickerInput(
|
||||
session = session,
|
||||
inputId = "sheet",
|
||||
choices = readODS::ods_sheets(input$file$datapath)
|
||||
choices = choices,
|
||||
selected = selected
|
||||
)
|
||||
datamods:::showUI(paste0("#", ns("sheet-container")))
|
||||
} else {
|
||||
|
|
@ -248,18 +242,64 @@ import_file_server <- function(id,
|
|||
}
|
||||
})
|
||||
|
||||
observeEvent(list(
|
||||
input$file,
|
||||
input$sheet,
|
||||
input$skip_rows,
|
||||
input$dec,
|
||||
input$encoding,
|
||||
input$na_label
|
||||
), {
|
||||
req(input$file)
|
||||
# req(input$skip_rows)
|
||||
extension <- tools::file_ext(input$file$datapath)
|
||||
if (isTRUE(extension %in% names(read_fns))) {
|
||||
|
||||
|
||||
# output$sheet <- shiny::renderUI({
|
||||
# if (is_workbook(input$file$datapath)) {
|
||||
# if (isTRUE(is_excel(input$file$datapath))) {
|
||||
# choices <- readxl::excel_sheets(input$file$datapath)
|
||||
# } else if (isTRUE(is_ods(input$file$datapath))) {
|
||||
# choices <- readODS::ods_sheets(input$file$datapath)
|
||||
# }
|
||||
# selected <- choices[1]
|
||||
#
|
||||
# shiny::selectInput(
|
||||
# inputId = ns("sheet"),
|
||||
# label = datamods:::i18n("Select sheet(s) to import:"),
|
||||
# choices = choices,
|
||||
# selected = selected,
|
||||
# width = "100%",
|
||||
# multiple = TRUE
|
||||
# )
|
||||
# # shinyWidgets::pickerInput(
|
||||
# # inputId = ns("sheet"),
|
||||
# # label = datamods:::i18n("Select sheet(s) to import:"),
|
||||
# # choices = choices,
|
||||
# # selected = selected,
|
||||
# # width = "100%",
|
||||
# # multiple = TRUE
|
||||
# # )
|
||||
# }
|
||||
# })
|
||||
|
||||
# observeEvent(
|
||||
# input$sheet,
|
||||
# {
|
||||
# req(input$file)
|
||||
# if (is_workbook(input$file$datapath) && is.null(shiny::req(input$sheet))) {
|
||||
# temporary_rv$data <- NULL
|
||||
# }
|
||||
# }
|
||||
# )
|
||||
|
||||
observeEvent(
|
||||
list(
|
||||
input$file,
|
||||
input$sheet,
|
||||
input$skip_rows,
|
||||
input$dec,
|
||||
input$encoding,
|
||||
input$na_label
|
||||
),
|
||||
{
|
||||
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(
|
||||
file = input$file$datapath,
|
||||
sheet = input$sheet,
|
||||
|
|
@ -270,69 +310,41 @@ import_file_server <- function(id,
|
|||
)
|
||||
parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
|
||||
imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE)
|
||||
code <- call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)))
|
||||
} else {
|
||||
if (is_excel(input$file$datapath) || is_ods(input$file$datapath)) {
|
||||
req(input$sheet)
|
||||
parameters <- list(
|
||||
file = input$file$datapath,
|
||||
which = input$sheet,
|
||||
skip = input$skip_rows,
|
||||
na = datamods:::split_char(input$na_label)
|
||||
)
|
||||
} else if (is_sas(input$file$datapath)) {
|
||||
parameters <- list(
|
||||
file = input$file$datapath,
|
||||
skip = input$skip_rows,
|
||||
encoding = input$encoding
|
||||
)
|
||||
} else {
|
||||
parameters <- list(
|
||||
file = input$file$datapath,
|
||||
skip = input$skip_rows,
|
||||
dec = input$dec,
|
||||
encoding = input$encoding,
|
||||
na.strings = datamods:::split_char(input$na_label)
|
||||
)
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)))
|
||||
|
||||
if (inherits(imported, "try-error")) {
|
||||
imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
|
||||
code <- rlang::call2("import", !!!list(file = input$file$name), .ns = "rio")
|
||||
}
|
||||
imported <- try(rlang::exec(rio::import, !!!parameters), silent = TRUE)
|
||||
code <- rlang::call2("import", !!!utils::modifyList(parameters, list(file = input$file$name)), .ns = "rio")
|
||||
}
|
||||
|
||||
if (inherits(imported, "try-error")) {
|
||||
imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
|
||||
code <- rlang::call2("import", !!!list(file = input$file$name), .ns = "rio")
|
||||
}
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
datamods:::toggle_widget(inputId = "confirm", enable = FALSE)
|
||||
datamods:::insert_error(mssg = datamods:::i18n(attr(imported, "condition")$message))
|
||||
temporary_rv$status <- "error"
|
||||
temporary_rv$data <- NULL
|
||||
temporary_rv$name <- NULL
|
||||
temporary_rv$code <- NULL
|
||||
} else {
|
||||
datamods:::toggle_widget(inputId = "confirm", enable = TRUE)
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
|
||||
datamods:::toggle_widget(inputId = "confirm", enable = FALSE)
|
||||
datamods:::insert_error(mssg = datamods:::i18n(attr(imported, "condition")$message))
|
||||
temporary_rv$status <- "error"
|
||||
temporary_rv$data <- NULL
|
||||
temporary_rv$name <- NULL
|
||||
temporary_rv$code <- NULL
|
||||
|
||||
} else {
|
||||
|
||||
datamods:::toggle_widget(inputId = "confirm", enable = TRUE)
|
||||
|
||||
datamods:::insert_alert(
|
||||
selector = ns("import"),
|
||||
status = "success",
|
||||
datamods:::make_success_alert(
|
||||
imported,
|
||||
trigger_return = trigger_return,
|
||||
btn_show_data = btn_show_data,
|
||||
extra = if (isTRUE(input$preview_data)) datamods:::i18n("First five rows are shown below:")
|
||||
datamods:::insert_alert(
|
||||
selector = ns("import"),
|
||||
status = "success",
|
||||
datamods:::make_success_alert(
|
||||
imported,
|
||||
trigger_return = trigger_return,
|
||||
btn_show_data = btn_show_data,
|
||||
extra = if (isTRUE(input$preview_data)) datamods:::i18n("First five rows are shown below:")
|
||||
)
|
||||
)
|
||||
)
|
||||
temporary_rv$status <- "success"
|
||||
temporary_rv$data <- imported
|
||||
temporary_rv$name <- input$file$name
|
||||
temporary_rv$code <- code
|
||||
}
|
||||
}, ignoreInit = TRUE)
|
||||
temporary_rv$status <- "success"
|
||||
temporary_rv$data <- imported
|
||||
temporary_rv$name <- input$file$name
|
||||
temporary_rv$code <- code
|
||||
}
|
||||
},
|
||||
ignoreInit = TRUE
|
||||
)
|
||||
|
||||
observeEvent(input$see_data, {
|
||||
datamods:::show_data(temporary_rv$data, title = datamods:::i18n("Imported data"), type = show_data_in)
|
||||
|
|
@ -391,6 +403,10 @@ is_sas <- function(path) {
|
|||
isTRUE(tools::file_ext(path) %in% c("sas7bdat"))
|
||||
}
|
||||
|
||||
is_workbook <- function(path) {
|
||||
is_excel(path) || is_ods(path)
|
||||
}
|
||||
|
||||
#' Wrapper of data.table::fread to import delim files with few presets
|
||||
#'
|
||||
#' @param file file
|
||||
|
|
@ -405,7 +421,7 @@ import_delim <- function(file, skip, encoding, na.strings) {
|
|||
file = file,
|
||||
na.strings = na.strings,
|
||||
skip = skip,
|
||||
check.names = TRUE,
|
||||
check.names = TRUE,
|
||||
encoding = encoding,
|
||||
data.table = FALSE,
|
||||
logical01 = TRUE,
|
||||
|
|
@ -414,6 +430,44 @@ import_delim <- function(file, skip, encoding, na.strings) {
|
|||
)
|
||||
}
|
||||
|
||||
import_xls <- function(file, sheet, skip, na.strings) {
|
||||
tryCatch(
|
||||
{
|
||||
# browser()
|
||||
sheet |>
|
||||
purrr::map(\(.x){
|
||||
openxlsx2::read_xlsx(
|
||||
file = file,
|
||||
sheet = .x,
|
||||
skip_empty_rows = TRUE,
|
||||
start_row = skip - 1,
|
||||
na.strings = na.strings
|
||||
)
|
||||
}) |>
|
||||
purrr::reduce(dplyr::full_join)
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0(err), type = "err")
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
import_ods <- function(file, sheet, skip, na.strings) {
|
||||
readODS::read_ods(
|
||||
path = file,
|
||||
sheet = sheet,
|
||||
skip = skip,
|
||||
na = na.strings
|
||||
)
|
||||
}
|
||||
|
||||
# import_xls(openxlsx2::read_xlsx("~/freesearcheR/dev/Test data/trials_redcap_sheets.xlsx"),)
|
||||
# list()
|
||||
|
||||
|
||||
#' @title Create a select input control with icon(s)
|
||||
#'
|
||||
#' @description Extend form controls by adding text or icons before,
|
||||
|
|
@ -437,11 +491,11 @@ selectInputIcon <- function(inputId,
|
|||
width = NULL,
|
||||
icon = NULL) {
|
||||
selected <- shiny::restoreInput(id = inputId, default = selected)
|
||||
tags$div(
|
||||
shiny::tags$div(
|
||||
class = "form-group shiny-input-container",
|
||||
shinyWidgets:::label_input(inputId, label),
|
||||
style = htmltools:::css(width = htmltools:::validateCssUnit(width)),
|
||||
tags$div(
|
||||
shiny::tags$div(
|
||||
class = "input-group",
|
||||
class = shinyWidgets:::validate_size(size),
|
||||
shinyWidgets:::markup_input_group(icon, "left", theme_func = shiny::getCurrentTheme),
|
||||
|
|
@ -463,65 +517,83 @@ selectInputIcon <- function(inputId,
|
|||
# library(shiny)
|
||||
# library(datamods)
|
||||
|
||||
ui <- fluidPage(
|
||||
ui <- shiny::fluidPage(
|
||||
# theme = bslib::bs_theme(version = 5L),
|
||||
# theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
|
||||
tags$h3("Import data from a file"),
|
||||
fluidRow(
|
||||
column(
|
||||
shiny::tags$h3("Import data from a file"),
|
||||
shiny::fluidRow(
|
||||
shiny::column(
|
||||
width = 4,
|
||||
import_file_ui(
|
||||
id = "myid",
|
||||
file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".json"),
|
||||
layout_params = "dropdown" #"inline" # or "dropdown"
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta"),
|
||||
layout_params = "dropdown" # "inline" # or "dropdown"
|
||||
)
|
||||
),
|
||||
column(
|
||||
shiny::column(
|
||||
width = 8,
|
||||
tags$b("Import status:"),
|
||||
verbatimTextOutput(outputId = "status"),
|
||||
tags$b("Name:"),
|
||||
verbatimTextOutput(outputId = "name"),
|
||||
tags$b("Code:"),
|
||||
verbatimTextOutput(outputId = "code"),
|
||||
tags$b("Data:"),
|
||||
verbatimTextOutput(outputId = "data")
|
||||
shiny::tags$b("Import status:"),
|
||||
shiny::verbatimTextOutput(outputId = "status"),
|
||||
shiny::tags$b("Name:"),
|
||||
shiny::verbatimTextOutput(outputId = "name"),
|
||||
shiny::tags$b("Code:"),
|
||||
shiny::verbatimTextOutput(outputId = "code"),
|
||||
shiny::tags$b("Data:"),
|
||||
shiny::verbatimTextOutput(outputId = "data")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
server <- function(input, output, session) {
|
||||
|
||||
imported <- import_file_server(
|
||||
id = "myid",
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
# Custom functions to read data
|
||||
read_fns = list(
|
||||
xls = function(file, sheet, skip, encoding) {
|
||||
readxl::read_xls(path = file, sheet = sheet, skip = skip)
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
json = function(file) {
|
||||
jsonlite::read_json(file, simplifyVector = TRUE)
|
||||
# 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"
|
||||
)
|
||||
}
|
||||
),
|
||||
show_data_in = "modal"
|
||||
)
|
||||
)
|
||||
|
||||
output$status <- renderPrint({
|
||||
output$status <- shiny::renderPrint({
|
||||
imported$status()
|
||||
})
|
||||
output$name <- renderPrint({
|
||||
output$name <- shiny::renderPrint({
|
||||
imported$name()
|
||||
})
|
||||
output$code <- renderPrint({
|
||||
output$code <- shiny::renderPrint({
|
||||
imported$code()
|
||||
})
|
||||
output$data <- renderPrint({
|
||||
output$data <- shiny::renderPrint({
|
||||
imported$data()
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
if (interactive())
|
||||
shinyApp(ui, server)
|
||||
|
||||
|
||||
if (FALSE) {
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue