update:更新了离群值分析功能

radiant.basics/NAMESPACE

@@ -9,6 +9,7 @@ S3method(plot,goodness)
 S3method(plot,homo_variance_test)
 S3method(plot,mda)
 S3method(plot,normality_test)
+S3method(plot,outlier)
 S3method(plot,prob_binom)
 S3method(plot,prob_chisq)
 S3method(plot,prob_disc)
@@ -30,6 +31,7 @@ S3method(summary,goodness)
 S3method(summary,homo_variance_test)
 S3method(summary,mda)
 S3method(summary,normality_test)
+S3method(summary,outlier)
 S3method(summary,prob_binom)
 S3method(summary,prob_chisq)
 S3method(summary,prob_disc)
@@ -53,6 +55,7 @@ export(goodness)
 export(homo_variance_test)
 export(mda)
 export(normality_test)
+export(outlier)
 export(prob_binom)
 export(prob_chisq)
 export(prob_disc)

radiant.basics/inst/app/init.R

@@ -31,6 +31,9 @@ options(
         tags$head(
           tags$script(src = "www_basics/js/run_return.js")
         ),
+        i18n$t("Data Quality"),
+        tabPanel(i18n$t("Missing Value Analysis"), uiOutput("missing")),
+        tabPanel(i18n$t("Outlier Analysis"), uiOutput("outlier")),
         i18n$t("Probability"),
         tabPanel(i18n$t("Probability calculator"), uiOutput("prob_calc")),
         tabPanel(i18n$t("Central Limit Theorem"), uiOutput("clt")),

radiant.basics/inst/app/tools/analysis/mda_ui.R

 ############################################
 ##  Multigroup Difference Analysis (ANOVA/KW) - UI
-##  对齐单独检验的UI设计：简洁+严格校验+统一风格
 ############################################
-## 1. 翻译标签（对齐单独检验的i18n逻辑，保持术语一致）
+## 1. 翻译标签
 mda_norm_type <- c("overall", "by_group")
 names(mda_norm_type) <- c(i18n$t("Overall (Whole variable)"),
                           i18n$t("By Group (Each level separately)"))

radiant.basics/inst/app/tools/analysis/outlier_ui.R

+############################################
+##  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()
+})

radiant.basics/inst/app/tools/help/missing.md

+xxxxxmiss
\ No newline at end of file

radiant.basics/inst/app/tools/help/outlier.md

+xxxxxout
\ No newline at end of file