update

radiant.basics/NAMESPACE

@@ -7,6 +7,7 @@ S3method(plot,correlation)
 S3method(plot,cross_tabs)
 S3method(plot,goodness)
 S3method(plot,homo_variance_test)
+S3method(plot,mda)
 S3method(plot,normality_test)
 S3method(plot,prob_binom)
 S3method(plot,prob_chisq)
@@ -27,6 +28,7 @@ S3method(summary,correlation)
 S3method(summary,cross_tabs)
 S3method(summary,goodness)
 S3method(summary,homo_variance_test)
+S3method(summary,mda)
 S3method(summary,normality_test)
 S3method(summary,prob_binom)
 S3method(summary,prob_chisq)
@@ -48,6 +50,7 @@ export(correlation)
 export(cross_tabs)
 export(goodness)
 export(homo_variance_test)
+export(mda)
 export(normality_test)
 export(prob_binom)
 export(prob_chisq)

radiant.basics/inst/app/init.R

@@ -4,6 +4,8 @@ r_url_list[["Single mean"]] <-
   list("tabs_single_mean" = list("Summary" = "basics/single-mean/", "Plot" = "basics/single-mean/plot/"))
 r_url_list[["Compare means(t-test/Wilcoxon rank-sum test)"]] <-
   list("tabs_compare_means" = list("Summary" = "basics/compare-means/", "Plot" = "basics/compare-means/plot/"))
+r_url_list[["Multigroup Difference Analysis(ANOVA/Kruskal-Wallis)"]] <-
+  list("tabs_mda" = list("Summary" = "basics/mda/", "Plot" = "basics/mda/plot/"))
 r_url_list[["Single proportion"]] <-
   list("tabs_single_prop" = list("Summary" = "basics/single-prop/", "Plot" = "basics/single-prop/plot/"))
 r_url_list[["Compare proportions"]] <-
@@ -35,8 +37,9 @@ options(
         "----", i18n$t("Means"),
         tabPanel(i18n$t("Single mean"), uiOutput("single_mean")),
         tabPanel(i18n$t("Compare means(t-test/Wilcoxon rank-sum test)"), uiOutput("compare_means")),
-        tabPanel(i18n$t("Normality test"),uiOutput("normality_test")),
-        tabPanel(i18n$t("Homogeneity of variance test"),uiOutput("homo_variance_test")),
+        #tabPanel(i18n$t("Normality test"),uiOutput("normality_test")),
+        #tabPanel(i18n$t("Homogeneity of variance test"),uiOutput("homo_variance_test")),
+        tabPanel(i18n$t("Multigroup Difference Analysis(ANOVA/Kruskal-Wallis)"),uiOutput("mda")),
         "----", i18n$t("Proportions"),
         tabPanel(i18n$t("Single proportion"), uiOutput("single_prop")),
         tabPanel(i18n$t("Compare proportions"), uiOutput("compare_props")),

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

+############################################
+##  Multigroup Difference Analysis (ANOVA/KW) - UI
+##  对齐单独检验的UI设计：简洁+严格校验+统一风格
+############################################
+## 1. 翻译标签（对齐单独检验的i18n逻辑，保持术语一致）
+mda_norm_type <- c("overall", "by_group")
+names(mda_norm_type) <- c(i18n$t("Overall (Whole variable)"),
+                          i18n$t("By Group (Each level separately)"))
+
+mda_plots <- c("norm_qq", "norm_hist", "homo_box")
+names(mda_plots) <- c(i18n$t("Normality: Q-Q Plot"),
+                      i18n$t("Normality: Histogram"),
+                      i18n$t("Homogeneity: Boxplot by Group"))
+
+## 2. 函数形参
+mda_args <- as.list(formals(mda))
+mda_args <- mda_args[names(mda_args) %in% c("dataset", "var", "group", "normality_type", "data_filter")]
+
+## 3. 输入收集
+mda_inputs <- reactive({
+  req(input$dataset)
+  # 基础参数
+  inputs <- list(
+    dataset = input$dataset,
+    var = input$mda_var,
+    group = input$mda_group,
+    normality_type = input$mda_normality_type,
+    data_filter = if (input$show_filter) input$data_filter else "None",
+    envir = r_data
+  )
+  # 校验参数完整性
+  for (arg in names(mda_args)) {
+    if (is.null(inputs[[arg]])) inputs[[arg]] <- mda_args[[arg]]
+  }
+  inputs
+})
+
+## 4. 因变量选择
+output$ui_mda_var <- 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)
+  
+  selectInput(
+    inputId = "mda_var",
+    label = i18n$t("Dependent variable:"),
+    choices = c("None" = "", choices),
+    selected = state_single("mda_var", num_vars),
+    multiple = FALSE
+  )
+})
+
+## 5. 分组变量选择
+output$ui_mda_group <- renderUI({
+  req(input$dataset)
+  current_data <- get_data(input$dataset, envir = r_data)
+  is_group <- sapply(current_data, function(col) is.factor(col) || is.character(col))
+  group_candidates <- names(is_group)[is_group]
+  
+  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).")))
+  }
+  
+  #提取变量类型并组合标签
+  group_types <- sapply(current_data[, valid_groups, drop = FALSE], function(col) class(col)[1])
+  choices <- setNames(nm = paste0(valid_groups, " {", group_types, "}"), object = valid_groups)
+  
+  selectInput(
+    inputId = "mda_group",
+    label = i18n$t("Grouping variable:"),
+    choices = choices,  
+    selected = state_single("mda_group", valid_groups),
+    multiple = FALSE
+  )
+})
+
+
+## 6. 正态性检验类型选择
+output$ui_mda_normality_type <- renderUI({
+  selectInput(
+    inputId = "mda_normality_type",
+    label = i18n$t("Normality test:"),
+    choices = mda_norm_type,
+    selected = state_single("mda_normality_type", mda_norm_type, "overall"),
+    multiple = FALSE
+  )
+})
+
+## 7. 主UI
+output$ui_mda <- renderUI({
+  req(input$dataset)
+  tagList(
+    wellPanel(
+      # Summary标签页
+      conditionalPanel(
+        condition = "input.tabs_mda == 'Summary'",
+        uiOutput("ui_mda_var"),
+        uiOutput("ui_mda_group"),
+        uiOutput("ui_mda_normality_type")
+      ),
+      # Plot标签页
+      conditionalPanel(
+        condition = "input.tabs_mda == 'Plot'",
+        selectizeInput(
+          inputId = "mda_plots",
+          label = i18n$t("Select plots:"),
+          choices = mda_plots,
+          selected = state_multiple("mda_plots", mda_plots, "norm_qq"),  # 默认选QQ图
+          multiple = TRUE,
+          options = list(
+            placeholder = i18n$t("Select plot types"),
+            plugins = list("remove_button", "drag_drop")  
+          )
+        )
+      )
+    ),
+    # 帮助与报告
+    help_and_report(
+      modal_title = i18n$t("Multigroup Difference Analysis (ANOVA/KW)"),
+      fun_name = "mda",
+      help_file = inclMD(file.path(getOption("radiant.path.basics"),
+                                   "app/tools/help/mda.md"))
+    )
+  )
+})
+
+## 8. 图表尺寸
+mda_plot_dims <- reactive({
+  req(.mda())
+  plot_count <- length(input$mda_plots)
+  group_count <- if (.mda()$normality_type == "by_group") {
+    length(levels(.mda()$plot_obj$homo$data[[.mda()$group]]))
+  } else {
+    1
+  }
+  base_subplot_height_px <- 350
+  total_height_px <- base_subplot_height_px * plot_count * group_count
+  total_height_px <- min(total_height_px, 2000)
+  total_height_px <- max(total_height_px, 400)
+  
+  list(
+    width = 700,
+    height = total_height_px
+  )
+})
+
+mda_plot_width <- function() mda_plot_dims()$width
+mda_plot_height <- function() mda_plot_dims()$height
+
+## 9. 输出面板
+output$mda <- renderUI({
+  # 注册输出
+  register_print_output("summary_mda", ".summary_mda")
+  register_plot_output("plot_mda", ".plot_mda",
+                       height_fun = "mda_plot_height")
+  
+  # 标签页
+  mda_panels <- tabsetPanel(
+    id = "tabs_mda",
+    tabPanel(
+      title = i18n$t("Summary"),
+      value = "Summary",
+      verbatimTextOutput("summary_mda", placeholder = TRUE) 
+    ),
+    tabPanel(
+      title = i18n$t("Plot"),
+      value = "Plot",
+      download_link("dlp_mda"),  # 下载按钮
+      plotOutput("plot_mda", height = "100%"),
+      style = "margin-top: 10px;"
+    )
+  )
+  
+  # 整合到Radiant标准面板
+  stat_tab_panel(
+    menu = i18n$t("Basics > Means"),
+    tool = i18n$t("Multigroup Difference Analysis(ANOVA/Kruskal-Wallis)"),
+    tool_ui = "ui_mda",
+    output_panels = mda_panels
+  )
+})
+
+## 10. 可用性检验
+mda_available <- reactive({
+  req(input$dataset)
+  current_data <- get_data(input$dataset, envir = r_data)
+  
+  # 1. 校验因变量
+  if (not_available(input$mda_var) || !input$mda_var %in% colnames(current_data)) {
+    return(i18n$t("Please select a valid numeric dependent variable."))
+  }
+  
+  # 2. 校验分组变量
+  if (not_available(input$mda_group) || !input$mda_group %in% colnames(current_data)) {
+    return(i18n$t("Please select a valid grouping variable."))
+  }
+  
+  # 3. 校验分组变量水平
+  group_vals <- current_data[[input$mda_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."))
+  }
+  
+  # 4. 校验有效样本
+  valid_n <- sum(!is.na(current_data[[input$mda_var]]) & !is.na(current_data[[input$mda_group]]))
+  if (valid_n < 5) {  # 最小样本量校验
+    return(i18n$t(paste("Valid samples are too few (n=", valid_n, "). Need at least 5.", sep = "")))
+  }
+  
+  "available"  # 所有校验通过
+})
+
+## 11. 计算核心
+.mda <- reactive({
+  req(mda_available() == "available")
+  do.call(mda, mda_inputs())
+})
+
+.summary_mda <- reactive({
+  req(mda_available() == "available")
+  summary(.mda())
+})
+
+.plot_mda <- reactive({
+  req(mda_available() == "available")
+  validate(need(input$mda_plots, i18n$t("Please select at least one plot type first.")))
+  # 进度提示
+  withProgress(message = i18n$t("Generating plots..."), value = 0.5, {
+    p <- plot(.mda(), plots = input$mda_plots, shiny = TRUE)
+    setProgress(value = 1)
+  })
+  p
+})
+
+## 12. 下载与截图
+# 图表下载
+download_handler(
+  id = "dlp_mda",
+  fun = function(file) {
+    # 1. 校验图表对象
+    plot_obj <- .plot_mda()
+    width_in <- mda_plot_width() / 96  
+    height_in <- mda_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, "_mda_plots"),
+  type = "png",
+  caption = i18n$t("Save plots")
+)
+
+# 报告生成
+mda_report <- function() {
+  req(mda_available() == "available")
+  figs <- length(input$mda_plots) > 0
+  # 报告结构
+  update_report(
+    inp_main = clean_args(mda_inputs(), mda_args),
+    fun_name = "mda",
+    inp_out = if (figs) list("", list(plots = input$mda_plots)) else list(""),
+    outputs = if (figs) c("summary", "plot") else "summary",
+    figs = figs,
+    fig.width = mda_plot_width(),
+    fig.height = mda_plot_height()
+  )
+}
+
+# 截图功能
+observeEvent(input$mda_report, {
+  r_info[["latest_screenshot"]] <- NULL
+  mda_report()
+})
+
+observeEvent(input$mda_screenshot, {
+  r_info[["latest_screenshot"]] <- NULL
+  radiant_screenshot_modal("modal_mda_screenshot")
+})
+
+observeEvent(input$modal_mda_screenshot, {
+  mda_report()
+  removeModal()
+})