############################################ ## Homogeneity of variance test - ui ############################################ ## 1. 翻译标签 hv_method <- c("levene", "bartlett", "fligner") names(hv_method) <- c(i18n$t("Levene"), i18n$t("Bartlett"), i18n$t("Fligner")) hv_plots <- c("hist", "density", "boxplot") names(hv_plots) <- c(i18n$t("Histogram"), i18n$t("Density"), i18n$t("Boxplot")) ## 2. 函数形参 hv_args <- as.list(formals(homo_variance_test)) ## 3. 收集输入 hv_inputs <- reactive({ hv_args$data_filter <- if (input$show_filter) input$data_filter else "" hv_args$dataset <- input$dataset hv_args$method <- input$hv_method # 确保正确收集分组变量和数值变量 for (i in r_drop(names(hv_args))) { hv_args[[i]] <- input[[paste0("hv_", i)]] } hv_args }) ## 4. 数值变量选择 output$ui_hv_var <- renderUI({ req(input$dataset) current_data <- get_data(input$dataset, envir = r_data) isNum <- sapply(current_data, function(col) is.numeric(col) || is.ts(col)) num_vars <- names(isNum)[isNum] if (length(num_vars) == 0) { return(div(class = "alert alert-warning", i18n$t("No numeric variables in dataset."))) } vars <- c("None" = "", num_vars) selectInput( inputId = "hv_var", label = i18n$t("Variable (select one):"), choices = vars, selected = state_single("hv_var", vars), multiple = FALSE ) }) ## 5. 分组变量选择 output$ui_hv_group <- renderUI({ req(input$dataset) current_data <- get_data(input$dataset, envir = r_data) # 仅保留因子/字符型变量 group_candidates <- names(which(sapply(current_data, function(col) is.factor(col) || is.character(col) ))) # 筛选有效水平≥2的分组变量 valid_groups <- character(0) for (grp in group_candidates) { grp_vals <- current_data[[grp]] valid_levels <- length(unique(grp_vals[!is.na(grp_vals)])) if (valid_levels >= 2) { valid_groups <- c(valid_groups, grp) } } if (length(valid_groups) == 0) { return(div(class = "alert alert-warning", i18n$t("No valid grouping variables (need ≥2 levels)."))) } selectInput( inputId = "hv_group", label = i18n$t("Grouping variable:"), choices = valid_groups, selected = state_single("hv_group", valid_groups), multiple = FALSE ) }) ## 6. 主UI output$ui_homo_variance_test <- renderUI({ req(input$dataset) tagList( wellPanel( conditionalPanel( condition = "input.tabs_homo_variance_test == 'Summary'", uiOutput("ui_hv_var"), uiOutput("ui_hv_group"), selectizeInput( inputId = "hv_method", label = i18n$t("Test method:"), choices = hv_method, selected = state_multiple("hv_method", hv_method, "levene"), multiple = TRUE, options = list(placeholder = i18n$t("Select methods"), plugins = list("remove_button", "drag_drop")) ) ), conditionalPanel( condition = "input.tabs_homo_variance_test == 'Plot'", selectizeInput( inputId = "hv_plots", label = i18n$t("Select plots:"), choices = hv_plots, selected = state_multiple("hv_plots", hv_plots, "boxplot"), multiple = TRUE, options = list(placeholder = i18n$t("Select plots"), plugins = list("remove_button", "drag_drop")) ) ) ), help_and_report( modal_title = i18n$t("Homogeneity of variance test"), fun_name = "homo_variance_test", help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/homo_variance_test.md")) ) ) }) ## 7. 画图尺寸 hv_plot <- reactive({ list(plot_width = 650, plot_height = 400 * max(length(input$hv_plots), 1)) }) hv_plot_width <- function() hv_plot()$plot_width hv_plot_height <- function() hv_plot()$plot_height ## 8. 输出面板 output$homo_variance_test <- renderUI({ register_print_output("summary_homo_variance_test", ".summary_homo_variance_test") register_plot_output("plot_homo_variance_test", ".plot_homo_variance_test", height_fun = "hv_plot_height") hv_output_panels <- tabsetPanel( id = "tabs_homo_variance_test", tabPanel(title = i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_homo_variance_test")), tabPanel(title = i18n$t("Plot"), value = "Plot", download_link("dlp_homo_variance_test"), plotOutput("plot_homo_variance_test", height = "100%")) ) stat_tab_panel( menu = i18n$t("Basics > Homogeneity"), tool = i18n$t("Homogeneity of variance test"), tool_ui = "ui_homo_variance_test", output_panels = hv_output_panels ) }) ## 9. 可用性检查(强化变量存在性校验) hv_available <- reactive({ req(input$dataset) current_data <- get_data(input$dataset, envir = r_data) # 校验数值变量 if (not_available(input$hv_var) || !input$hv_var %in% colnames(current_data)) { return(i18n$t("Please select a valid numeric variable.")) } # 校验分组变量 if (not_available(input$hv_group) || !input$hv_group %in% colnames(current_data)) { return(i18n$t("Please select a valid grouping variable.")) } # 校验分组变量水平 group_vals <- current_data[[input$hv_group]] valid_levels <- length(unique(group_vals[!is.na(group_vals)])) if (valid_levels < 2) { return(i18n$t("Grouping variable has <2 valid levels. Choose another.")) } "available" }) ## 10. 计算核心 .homo_variance_test <- reactive({ req(hv_available() == "available") # 确保通过可用性检查 hvi <- hv_inputs() hvi$envir <- r_data do.call(homo_variance_test, hvi) }) .summary_homo_variance_test <- reactive({ if (hv_available() != "available") return(hv_available()) summary(.homo_variance_test()) }) .plot_homo_variance_test <- reactive({ if (hv_available() != "available") return(hv_available()) validate(need(input$hv_plots, i18n$t("Select plot types first"))) withProgress(message = i18n$t("Generating plots"), value = 1, plot(.homo_variance_test(), plots = input$hv_plots, shiny = TRUE)) }) ## 11. 下载 & 截图 download_handler( id = "dlp_homo_variance_test", fun = download_handler_plot, fn = function() paste0(input$dataset, "_homo_variance_test"), type = "png", caption = i18n$t("Save plot"), plot = .plot_homo_variance_test, width = hv_plot_width, height = hv_plot_height ) observeEvent(input$homo_variance_test_report, { r_info[["latest_screenshot"]] <- NULL homo_variance_test_report() }) observeEvent(input$homo_variance_test_screenshot, { r_info[["latest_screenshot"]] <- NULL radiant_screenshot_modal("modal_homo_variance_test_screenshot") }) observeEvent(input$modal_homo_variance_test_screenshot, { homo_variance_test_report() removeModal() })