############################################ ## Outlier Analysis - UI ############################################ ## 1. 翻译标签 outlier_methods <- c("iqr", "zscore") names(outlier_methods) <- c(i18n$t("IQR Method (1.5×IQR)"), i18n$t("Z-score Method (±3σ)")) outlier_plots <- c("boxplot", "histogram", "scatter") names(outlier_plots) <- c(i18n$t("Boxplot (Mark Outliers)"), i18n$t("Histogram (With Thresholds)"), i18n$t("Scatter Plot (Variable Pairs)")) ## 2. 函数形参 outlier_args <- as.list(formals(outlier)) outlier_args <- outlier_args[names(outlier_args) %in% c("dataset", "vars", "method", "iqr_multiplier", "z_threshold", "data_filter")] ## 3. 输入收集 outlier_inputs <- reactive({ req(input$dataset) inputs <- list( dataset = input$dataset, vars = input$outlier_vars, method = input$outlier_method, iqr_multiplier = input$outlier_iqr_multiplier, z_threshold = input$outlier_z_threshold, data_filter = if (input$show_filter) input$data_filter else "", envir = r_data ) # 校验参数完整性 for (arg in names(outlier_args)) { if (is.null(inputs[[arg]]) || length(inputs[[arg]]) == 0) { inputs[[arg]] <- outlier_args[[arg]] } } inputs }) ## 4. 变量选择UI output$ui_outlier_vars <- renderUI({ req(input$dataset) current_data <- get_data(input$dataset, envir = r_data) is_num <- sapply(current_data, function(col) is.numeric(col) || is.ts(col)) num_vars <- names(is_num)[is_num] if (length(num_vars) == 0) { return(div(class = "alert alert-warning", i18n$t("No numeric variables in dataset. Please select another dataset."))) } # 提取变量类型并显示 var_types <- sapply(current_data[, num_vars, drop = FALSE], function(col) class(col)[1]) choices <- setNames(nm = paste0(num_vars, " {", var_types, "}"), object = num_vars) selectizeInput( inputId = "outlier_vars", label = i18n$t("Select numeric variable:"), choices = choices, selected = state_multiple("outlier_vars", num_vars), multiple = TRUE, options = list(placeholder = i18n$t("Select one or more variables"), plugins = list("remove_button", "drag_drop")) ) }) ## 5. 方法参数调整UI output$ui_outlier_params <- renderUI({ req(input$outlier_method) tagList( # IQR方法:调整倍数(默认1.5) conditionalPanel( condition = "input.outlier_method == 'iqr'", numericInput( inputId = "outlier_iqr_multiplier", label = i18n$t("IQR Multiplier:"), value = state_init("outlier_iqr_multiplier", 1.5), min = 0.5, max = 5, step = 0.5 ) ), # Z-score方法:调整阈值(默认3) conditionalPanel( condition = "input.outlier_method == 'zscore'", numericInput( inputId = "outlier_z_threshold", label = i18n$t("Z-score Threshold:"), value = state_init("outlier_z_threshold", 3), min = 1.5, max = 5, step = 0.5 ) ) ) }) ## 6. 主UI output$ui_outlier <- renderUI({ req(input$dataset) tagList( wellPanel( # Summary标签页:变量选择+方法选择+参数调整 conditionalPanel( condition = "input.tabs_outlier == 'Summary'", uiOutput("ui_outlier_vars"), radioButtons( inputId = "outlier_method", label = i18n$t("Select outlier detection method:"), choices = outlier_methods, selected = state_single("outlier_method", outlier_methods, "iqr"), inline = FALSE ), uiOutput("ui_outlier_params") # 动态参数面板 ), # Plot标签页:图表选择 conditionalPanel( condition = "input.tabs_outlier == 'Plot'", selectizeInput( inputId = "outlier_plots", label = i18n$t("Select plots:"), choices = outlier_plots, selected = state_multiple("outlier_plots", outlier_plots, "boxplot"), multiple = TRUE, options = list(placeholder = i18n$t("Select plot types"), plugins = list("remove_button", "drag_drop")) ) ) ), # 帮助与报告 help_and_report( modal_title = i18n$t("Outlier Analysis"), fun_name = "outlier", help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/outlier.md")) ) ) }) ## 7. 图表尺寸 outlier_plot_dims <- reactive({ req(.outlier()) plot_count <- length(input$outlier_plots) var_count <- length(.outlier()$vars) # 选择的变量数 # 每个子图基础高度(像素) base_height_px <- 300 total_height_px <- base_height_px * plot_count * ceiling(var_count / 2) # 2列布局 # 限制最大/最小高度 total_height_px <- min(total_height_px, 2500) total_height_px <- max(total_height_px, 500) list( width = 800, # 宽屏适配多变量 height = total_height_px ) }) outlier_plot_width <- function() outlier_plot_dims()$width outlier_plot_height <- function() outlier_plot_dims()$height ## 8. 输出面板 output$outlier<- renderUI({ # 注册输出组件 register_print_output("summary_outlier", ".summary_outlier") register_plot_output("plot_outlier", ".plot_outlier", height_fun = "outlier_plot_height") # 标签页布局 outlier_panels <- tabsetPanel( id = "tabs_outlier", tabPanel( title = i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_outlier", placeholder = TRUE) ), tabPanel( title = i18n$t("Plot"), value = "Plot", download_link("dlp_outlier"), # 下载按钮 plotOutput("plot_outlier", height = "100%"), style = "margin-top: 10px;" ) ) stat_tab_panel( menu = i18n$t("Basics > Data Quality"), tool = i18n$t("Outlier Analysis"), tool_ui = "ui_outlier", output_panels = outlier_panels ) }) ## 9. 可用性检验 outlier_available <- reactive({ req(input$dataset) current_data <- get_data(input$dataset, envir = r_data) # 校验是否选择变量 if (not_available(input$outlier_vars)) { return(i18n$t("Please select at least one numeric variable.")) } # 校验变量是否存在且为数值型 invalid_vars <- input$outlier_vars[!input$outlier_vars %in% colnames(current_data)] if (length(invalid_vars) > 0) { return(i18n$t(paste("Invalid variables: ", paste(invalid_vars, collapse = ", "), ". Please reselect.", sep = ""))) } # 校验变量是否为数值型 non_num_vars <- input$outlier_vars[!sapply(current_data[, input$outlier_vars, drop = FALSE], is.numeric)] if (length(non_num_vars) > 0) { return(i18n$t(paste("Non-numeric variables: ", paste(non_num_vars, collapse = ", "), ". Please select numeric variables.", sep = ""))) } "available" }) ## 10. 计算核心 .outlier <- reactive({ req(outlier_available() == "available") do.call(outlier, outlier_inputs()) }) ## 11. Summary输出 .summary_outlier <- reactive({ req(outlier_available() == "available") summary(.outlier()) }) ## 12. Plot输出 .plot_outlier <- reactive({ req(outlier_available() == "available") validate(need(input$outlier_plots, i18n$t("Please select at least one plot type first."))) withProgress(message = i18n$t("Generating outlier plots..."), value = 0.5, { p <- plot(.outlier(), plots = input$outlier_plots, shiny = TRUE) setProgress(value = 1) }) p }) ## 13. 下载与截图 download_handler( id = "dlp_outlier", fun = function(file) { plot_obj <- .plot_outlier() width_in <- outlier_plot_width() / 96 height_in <- outlier_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, "_outlier_analysis"), type = "png", caption = i18n$t("Save outlier plots") ) ## 14. 报告生成 outlier_report <- function() { req(outlier_available() == "available") figs <- length(input$outlier_plots) > 0 update_report( inp_main = clean_args(outlier_inputs(), outlier_args), fun_name = "outlier", inp_out = if (figs) list("", list(plots = input$outlier_plots)) else list(""), outputs = if (figs) c("summary", "plot") else "summary", figs = figs, fig.width = outlier_plot_width(), fig.height = outlier_plot_height() ) } ## 15. 截图功能 observeEvent(input$outlier_report, { r_info[["latest_screenshot"]] <- NULL outlier_report() }) observeEvent(input$outlier_screenshot, { r_info[["latest_screenshot"]] <- NULL radiant_screenshot_modal("modal_outlier_screenshot") }) observeEvent(input$modal_outlier_screenshot, { outlier_report() removeModal() })