############################################ ## Missing Value Analysis - UI ############################################ ## 1. 标签 missing_plots <- c("heatmap", "barplot") names(missing_plots) <- c( i18n$t("Missing Heatmap"), i18n$t("Missing Barplot") ) ## 2. 函数形参 missing_args <- as.list(formals(missing)) missing_args <- missing_args[names(missing_args) %in% c("dataset", "vars", "data_filter")] ## 3. 输入收集 missing_inputs <- reactive({ req(input$dataset) inputs <- list( dataset = input$dataset, vars = input$missing_vars, # 用户选择的变量 data_filter = if (input$show_filter) input$data_filter else "", envir = r_data ) # 校验参数完整性 for (arg in names(missing_args)) { if (is.null(inputs[[arg]]) || length(inputs[[arg]]) == 0) { inputs[[arg]] <- missing_args[[arg]] } } inputs }) ## 4. 变量选择UI output$ui_missing_vars <- renderUI({ req(input$dataset) current_data <- get_data(input$dataset, envir = r_data) all_vars <- colnames(current_data) if (length(all_vars) == 0) { return(div(class = "alert alert-warning", i18n$t("No variables in dataset. Please select another dataset."))) } # 显示变量类型(数值型/分类型) var_types <- sapply(current_data[, all_vars, drop = FALSE], function(col) class(col)[1]) choices <- setNames(nm = paste0(all_vars, " {", var_types, "}"), object = all_vars) selectizeInput( inputId = "missing_vars", label = i18n$t("Select variables to analyze:"), choices = choices, selected = state_multiple("missing_vars", character(0)), multiple = TRUE, options = list(placeholder = i18n$t("Select one or more variables"), plugins = list("remove_button", "drag_drop")) ) }) ## 5. 主UI(Summary + Plot标签页) output$ui_missing <- renderUI({ req(input$dataset) tagList( wellPanel( # Summary标签页:变量选择 + 统计结果 conditionalPanel( condition = "input.tabs_missing == 'Summary'", uiOutput("ui_missing_vars") ), # Plot标签页:可视化类型选择 conditionalPanel( condition = "input.tabs_missing == 'Plot'", selectizeInput( inputId = "missing_plots", label = i18n$t("Select plots:"), choices = missing_plots, selected = state_multiple("missing_plots", missing_plots, "barplot"), # 默认选中条形图 multiple = TRUE, options = list(placeholder = i18n$t("Select plot types"), plugins = list("remove_button", "drag_drop")) ) ) ), # 帮助与报告(和离群值分析保持一致) help_and_report( modal_title = i18n$t("Missing Value Analysis"), fun_name = "missing", help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/missing.md")) ) ) }) ## 6. 图表尺寸计算 missing_plot_dims <- reactive({ req(.missing()) plot_count <- length(input$missing_plots) var_count <- length(.missing()$vars) # 基础高度 base_height_px <- if ("heatmap" %in% input$missing_plots) { min(500 + (nrow(.missing()$raw_data) * 0.5), 1200) # 样本越多,热图越高 } else { 400 } total_height_px <- base_height_px * plot_count # 限制最大/最小高度 total_height_px <- min(total_height_px, 2000) total_height_px <- max(total_height_px, 500) list( width = 800, height = total_height_px ) }) missing_plot_width <- function() missing_plot_dims()$width missing_plot_height <- function() missing_plot_dims()$height ## 7. 输出面板 output$missing <- renderUI({ # 注册输出组件 register_print_output("summary_missing", ".summary_missing") register_plot_output("plot_missing", ".plot_missing", height_fun = "missing_plot_height") # 标签页布局(Summary + Plot) missing_panels <- tabsetPanel( id = "tabs_missing", tabPanel( title = i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_missing", placeholder = TRUE) ), tabPanel( title = i18n$t("Plot"), value = "Plot", download_link("dlp_missing"), # 下载按钮 plotOutput("plot_missing", height = "100%"), style = "margin-top: 10px;" ) ) # 集成到Data Quality菜单下 stat_tab_panel( menu = i18n$t("Basics > Data Quality"), tool = i18n$t("Missing Value Analysis"), tool_ui = "ui_missing", output_panels = missing_panels ) }) ## 8. 可用性检验 missing_available <- reactive({ req(input$dataset) current_data <- get_data(input$dataset, envir = r_data) # 校验是否选择变量:未选则返回提示,阻止后续计算 if (not_available(input$missing_vars)) { return(i18n$t("Please select at least one variable to analyze.")) } # 校验变量是否存在 invalid_vars <- input$missing_vars[!input$missing_vars %in% colnames(current_data)] if (length(invalid_vars) > 0) { return(i18n$t(paste("Invalid variables: ", paste(invalid_vars, collapse = ", "), ". Please reselect.", sep = ""))) } "available" }) ## 9. 计算核心 .missing <- reactive({ req(missing_available() == "available") do.call(missing, missing_inputs()) }) ## 10. Summary输出 .summary_missing <- reactive({ req(missing_available() == "available") summary(.missing()) }) ## 11. Plot输出 .plot_missing <- reactive({ req(missing_available() == "available") validate(need(input$missing_plots, i18n$t("Please select at least one plot type first."))) withProgress(message = i18n$t("Generating missing value plots..."), value = 0.5, { p <- plot(.missing(), plots = input$missing_plots, shiny = TRUE) setProgress(value = 1) }) p }) ## 12. 下载功能 download_handler( id = "dlp_missing", fun = function(file) { plot_obj <- .plot_missing() width_in <- missing_plot_width() / 96 height_in <- missing_plot_height() / 96 ggsave( filename = file, plot = plot_obj, width = width_in, height = height_in, device = "png", dpi = 300, limitsize = FALSE, bg = "white" ) }, fn = function() paste0(input$dataset, "_missing_value_analysis"), type = "png", caption = i18n$t("Save missing value plots") ) ## 13. 报告生成 missing_report <- function() { req(missing_available() == "available") figs <- length(input$missing_plots) > 0 update_report( inp_main = clean_args(missing_inputs(), missing_args), fun_name = "missing", inp_out = if (figs) list("", list(plots = input$missing_plots)) else list(""), outputs = if (figs) c("summary", "plot") else "summary", figs = figs, fig.width = missing_plot_width(), fig.height = missing_plot_height() ) } ## 14. 截图功能 observeEvent(input$missing_report, { r_info[["latest_screenshot"]] <- NULL missing_report() }) observeEvent(input$missing_screenshot, { r_info[["latest_screenshot"]] <- NULL radiant_screenshot_modal("modal_missing_screenshot") }) observeEvent(input$modal_missing_screenshot, { missing_report() removeModal() })