############################################ ## Normality test - ui ############################################ ## 1. 翻译标签 nt_method <- c("shapiro", "ks", "ad") # 先给 3 个常用方法 names(nt_method) <- c(i18n$t("Shapiro-Wilk"), i18n$t("Kolmogorov-Smirnov"), i18n$t("Anderson-Darling")) nt_plots <- c("qq", "hist", "pp", "density") names(nt_plots) <- c(i18n$t("Q-Q plot"), i18n$t("Histogram"), i18n$t("P-P plot"), i18n$t("Density")) ## 2. 函数形参 nt_args <- as.list(formals(normality_test)) ## 3. 收集输入 nt_inputs <- reactive({ nt_args$data_filter <- if (input$show_filter) input$data_filter else "" nt_args$dataset <- input$dataset for (i in r_drop(names(nt_args))) { nt_args[[i]] <- input[[paste0("nt_", i)]] } nt_args }) ## 4. 变量选择(仅 numeric) output$ui_nt_var <- renderUI({ isNum <- .get_class() %in% c("integer", "numeric", "ts") vars <- c("None" = "", varnames()[isNum]) selectInput( inputId = "nt_var", label = i18n$t("Variable (select one):"), choices = vars, selected = state_single("nt_var", vars), multiple = FALSE ) }) ## 5. 主 UI output$ui_normality_test <- renderUI({ req(input$dataset) tagList( wellPanel( conditionalPanel( condition = "input.tabs_normality_test == 'Summary'", uiOutput("ui_nt_var"), selectInput( inputId = "nt_method", label = i18n$t("Test method:"), choices = nt_method, selected = state_single("nt_method", nt_method, "shapiro"), multiple = FALSE ), sliderInput( "nt_conf_lev", i18n$t("Confidence level:"), min = 0.85, max = 0.99, value = state_init("nt_conf_lev", 0.95), step = 0.01 ) ), conditionalPanel( condition = "input.tabs_normality_test == 'Plot'", selectizeInput( inputId = "nt_plots", label = i18n$t("Select plots:"), choices = nt_plots, selected = state_multiple("nt_plots", nt_plots, "qq"), multiple = TRUE, options = list(placeholder = i18n$t("Select plots"), plugins = list("remove_button", "drag_drop")) ) ) ), help_and_report( modal_title = i18n$t("Normality test"), fun_name = "normality_test", help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/normality_test.md")) ) ) }) ## 6. 画图尺寸(直接抄) nt_plot <- reactive({ list(plot_width = 650, plot_height = 400 * max(length(input$nt_plots), 1)) }) nt_plot_width <- function() nt_plot()$plot_width nt_plot_height <- function() nt_plot()$plot_height ## 7. 输出面板 output$normality_test <- renderUI({ register_print_output("summary_normality_test", ".summary_normality_test") register_plot_output("plot_normality_test", ".plot_normality_test", height_fun = "nt_plot_height") nt_output_panels <- tabsetPanel( id = "tabs_normality_test", tabPanel(title = i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_normality_test")), tabPanel(title = i18n$t("Plot"), value = "Plot", download_link("dlp_normality_test"), plotOutput("plot_normality_test", height = "100%")) ) stat_tab_panel( menu = i18n$t("Basics > Normality"), tool = i18n$t("Normality test"), tool_ui = "ui_normality_test", output_panels = nt_output_panels ) }) ## 8. 可用性检查 nt_available <- reactive({ if (not_available(input$nt_var)) return(i18n$t("This analysis requires a numeric variable. If none are\navailable please select another dataset.") %>% suggest_data("demand_uk")) "available" }) ## 9. 计算核心 .normality_test <- reactive({ nti <- nt_inputs() nti$envir <- r_data do.call(normality_test, nti) }) .summary_normality_test <- reactive({ if (nt_available() != "available") return(nt_available()) summary(.normality_test()) }) .plot_normality_test <- reactive({ if (nt_available() != "available") return(nt_available()) validate(need(input$nt_plots, i18n$t("Nothing to plot. Please select a plot type"))) withProgress(message = i18n$t("Generating plots"), value = 1, plot(.normality_test(), plots = input$nt_plots, shiny = TRUE)) }) ## 10. Report normality_test_report <- function() { if (is.empty(input$nt_var)) return(invisible()) figs <- length(input$nt_plots) > 0 outputs <- if (figs) c("summary", "plot") else "summary" inp_out <- if (figs) list("", list(plots = input$nt_plots, custom = FALSE)) else list("", "") update_report(inp_main = clean_args(nt_inputs(), nt_args), fun_name = "normality_test", inp_out = inp_out, outputs = outputs, figs = figs, fig.width = nt_plot_width(), fig.height = nt_plot_height()) } ## 11. 下载 & 截图 download_handler( id = "dlp_normality_test", fun = download_handler_plot, fn = function() paste0(input$dataset, "_normality_test"), type = "png", caption = i18n$t("Save normality test plot"), plot = .plot_normality_test, width = nt_plot_width, height = nt_plot_height ) observeEvent(input$normality_test_report, { r_info[["latest_screenshot"]] <- NULL normality_test_report() }) observeEvent(input$normality_test_screenshot, { r_info[["latest_screenshot"]] <- NULL radiant_screenshot_modal("modal_normality_test_screenshot") }) observeEvent(input$modal_normality_test_screenshot, { normality_test_report() removeModal() })