####################################### # Combine datasets ####################################### ## list of function arguments cmb_args <- as.list(formals(combine_data)) ## list of function inputs selected by user cmb_inputs <- reactive({ cmb_args$data_filter <- ifelse(input$show_filter, input$data_filter, "") cmb_args$arr <- ifelse(input$show_filter, input$data_arrange, "") cmb_args$rows <- ifelse(input$show_filter, input$data_rows, "") cmb_args$x <- as.name(input$dataset) cmb_args$y <- as.name(input$cmb_y) ## loop needed because reactive values don't allow single bracket indexing for (i in r_drop(names(cmb_args), drop = c("x", "y", "data_filter", "arr", "rows"))) { cmb_args[[i]] <- input[[paste0("cmb_", i)]] } ## only need cmb_by when using a join method if (!grepl("_join", cmb_args$type)) cmb_args$by <- "" cmb_args }) output$ui_cmb_y <- renderUI({ datasetlist <- r_info[["datasetlist"]] req(length(datasetlist) > 1) cmb_datasets <- datasetlist[-which(input$dataset == datasetlist)] selectInput( inputId = "cmb_y", label = i18n$t("Combine with:"), choices = cmb_datasets, selected = state_init("cmb_y"), multiple = FALSE ) }) output$ui_cmb_by <- renderUI({ req(input$cmb_y) x <- varnames() y <- colnames(r_data[[input$cmb_y]]) vars <- intersect(x, y) if (length(vars) == 0) { return() } vars <- x[x %in% vars] ## need variable labels from varnames() selectInput( "cmb_by", i18n$t("Join by:"), choices = vars, selected = state_multiple("cmb_by", vars, vars), multiple = TRUE, size = min(5, length(vars)), selectize = FALSE ) }) output$ui_cmb_add <- renderUI({ req(input$cmb_y) vars <- colnames(r_data[[input$cmb_y]]) selectInput( "cmb_add", i18n$t("Variables to add:"), choices = vars, selected = state_multiple("cmb_add", vars, vars), multiple = TRUE, size = min(5, length(vars)), selectize = FALSE ) }) cmb_type <- setNames( c( "inner_join", "left_join", "right_join", "full_join", "semi_join", "anti_join", "bind_rows", "bind_cols", "intersect", "union", "setdiff" ), i18n$t(c( "Inner join", "Left join", "Right join", "Full join", "Semi join", "Anti join", "Bind rows", "Bind columns", "Intersect", "Union", "Set difference" )) ) output$ui_cmb_store <- renderUI({ ## updates when dataset changes req(input$dataset) actionButton("cmb_store", i18n$t("Combine"), icon = icon("plus", verify_fa = FALSE), class = "btn-success") }) output$ui_Combine <- renderUI({ tagList( wellPanel( uiOutput("ui_cmb_y"), conditionalPanel( condition = "output.ui_cmb_y == null", HTML(i18n$t("")) ), uiOutput("ui_cmb_by"), uiOutput("ui_cmb_add"), selectInput( "cmb_type", i18n$t("Combine type:"), choices = cmb_type, selected = state_single("cmb_type", cmb_type, "inner_join"), multiple = FALSE ), tags$table( tags$td(textInput("cmb_name", i18n$t("Combined dataset:"), paste0(input$dataset, "_cmb"))), tags$td(uiOutput("ui_cmb_store"), class = "top") ) ), help_and_report( modal_title = i18n$t("Combine"), fun_name = "combine", help_file = inclMD(file.path(getOption("radiant.path.data"), "app/tools/help/combine.md")), lic = "by-sa" ) ) }) observeEvent(input$cmb_store, { ## combining datasets req(length(r_info[["datasetlist"]]) > 1) result <- try(do.call(combine_data, cmb_inputs(), envir = r_data), silent = TRUE) if (inherits(result, "try-error")) { r_info[["cmb_error"]] <- attr(result, "condition")$message } else { r_info[["cmb_error"]] <- "" dataset <- fix_names(input$cmb_name) if (input$cmb_name != dataset) { updateTextInput(session, inputId = "cmb_name", value = dataset) } r_data[[dataset]] <- result register(dataset, descr = attr(result, "description")) updateSelectInput(session = session, inputId = "dataset", selected = input$dataset) updateSelectInput(session = session, inputId = "cmb_y", selected = input$cmd_y) } }) combine_report <- function() { req(input$cmb_y) inp <- clean_args(cmb_inputs(), cmb_args) if (identical(inp$add, colnames(r_data[[input$cmb_y]]))) { inp$add <- NULL } dataset <- fix_names(input$cmb_name) if (input$cmb_name != dataset) { updateTextInput(session, inputId = "cmb_name", value = dataset) } xcmd <- paste0("register(\"", dataset, "\")") update_report( inp_main = inp, fun_name = "combine_data", outputs = character(0), pre_cmd = paste0(dataset, " <- "), xcmd = xcmd, figs = FALSE ) } output$cmb_data1 <- renderText({ req(input$dataset) filt <- if (input$show_filter) input$data_filter else "" arr <- if (input$show_filter) input$data_arrange else "" rows <- if (input$show_filter) input$data_rows else "" show_data_snippet(title = paste(i18n$t("