update

README.md

-# radiant
-
-科研统计分析工具
-Statistical Analysis System
\ No newline at end of file

notice.txt

+上传模块
+devtools::install_local("/home/wuzekai/radiant/radiant.data", force = TRUE)
+devtools::install_local("/home/wuzekai/radiant/radiant.basics", force = TRUE)
+devtools::install_local("/home/wuzekai/radiant/radiant.design", force = TRUE)
+devtools::install_local("/home/wuzekai/radiant/radiant.model", force = TRUE)
+devtools::install_local("/home/wuzekai/radiant/radiant.multivariate", force = TRUE)
+devtools::install_local("/home/wuzekai/radiant/radiant.quickgen", force = TRUE)
+devtools::install_local("/home/wuzekai/radiant/radiant-master", force = TRUE)
+
+清理原文件
+rm -rf /root/miniconda3/envs/radiant/lib/R/library/radiant.data
+rm -rf /root/miniconda3/envs/radiant/lib/R/library/radiant.basics
+rm -rf /root/miniconda3/envs/radiant/lib/R/library/radiant.design
+rm -rf /root/miniconda3/envs/radiant/lib/R/library/radiant.model
+rm -rf /root/miniconda3/envs/radiant/lib/R/library/radiant.multivariate
+rm -rf /root/miniconda3/envs/radiant/lib/R/library/radiant.quickgen
+rm -rf /root/miniconda3/envs/radiant/lib/R/library/radiant-master
+
+启动软件
+sudo -i
+conda activate radiant
+cd /home/wuzekai/radiant
+R
+options(browser = 'false'); radiant::radiant(host='0.0.0.0', port=8105)
+
+杀掉端口
+lsof -i :8105
+kill -9 <PID>
\ No newline at end of file

radiant-master/inst/translations/translation_zh.csv

@@ -1159,9 +1159,9 @@ Edit the generated R code here...,在此处编辑生成的R代码...,quickgen_ai
 Normality test,正态性检验,init.R
 Homogeneity of variance test,方差齐性检验,init.R
 Basics > Normality,基础统计 > 正态性,normality_test_ui.R
-Shapiro-Wilk,SW 检验,normality_test_ui.R
-Kolmogorov-Smirnov,K-S 检验,normality_test_ui.R
-Anderson-Darling,AD 检验,normality_test_ui.R
+Shapiro-Wilk,SW检验,normality_test_ui.R
+Kolmogorov-Smirnov,K-S检验,normality_test_ui.R
+Anderson-Darling,AD检验,normality_test_ui.R
 Basics > Homogeneity,基础统计 > 方差齐性,homo_variance_test_ui.R
 Grouping variable:,分组变量：,homo_variance_test_ui.R
 Test method:,检验方法：,homo_variance_test_ui.R
@@ -1186,3 +1186,4 @@ Time variable:,生存时间变量：,cox_ui.R
 Status variable:,事件状态变量：,cox_ui.R
 AI running...,大模型运行中...,quickgen_ai_ui.R
 Warning:Please enter a request related to descriptive statistics or visualization.,警告：请输入与描述性统计或可视化相关的请求。,quickgen_ai_ui.R
+Boxplot,箱型图,homo_variance_test_ui.R

radiant.basics/DESCRIPTION

@@ -24,7 +24,9 @@ Imports:
     polycor (>= 0.7.10),
     patchwork (>= 1.0.0),
     shiny.i18n,
-    rlang (>= 1.0.6)
+    rlang (>= 1.0.6),
+    ggpp,
+    nortest
 Suggests:
     testthat (>= 2.0.0),
     pkgdown (>= 1.1.0),

radiant.basics/R/homo_variance_test.R

 ############################################
-##  Homogeneity of variance test - 空壳版（照抄 single_mean）
+##  Homogeneity of variance test
 ############################################
 
-# Homogeneity of variance tests for radiant.basics
 #' @export
-homo_variance_test <- function(dataset, var, group, method = "levene",
-                               conf_lev = .95, data_filter = "",
+homo_variance_test <- function(dataset, var, group,
+                               method = c("levene", "bartlett", "fligner"),
+                               data_filter = "",
                                envir = parent.frame()) {
+  
+  # 获取数据
   df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset))
-  dataset <- get_data(dataset, var, group, filt = data_filter, na.rm = TRUE, envir = envir)
+  dataset <- get_data(
+    dataset, 
+    vars = c(var, group),
+    filt = data_filter, 
+    na.rm = FALSE, 
+    envir = envir
+  )
+  
+  # 校验变量存在性
+  if (!var %in% colnames(dataset)) {
+    stop(paste("变量", var, "未在数据集中找到！"), call. = FALSE)
+  }
+  if (!group %in% colnames(dataset)) {
+    stop(paste("分组变量", group, "未在数据集中找到！"), call. = FALSE)
+  }
+  
+  # 提取变量
   x <- dataset[[var]]
-  g <- dataset[[group]]
-  if (!is.numeric(x)) stop(i18n$t("Variable must be numeric"))
-  if (length(unique(g)) < 2) stop(i18n$t("Grouping variable must have at least 2 levels"))
-  
-  ## ---- 空壳结果 ----
-  res <- tibble::tribble(
-    ~Test, ~Statistic, ~p.value,
-    "Levene",       0.42, 0.52,
-    "Bartlett",     0.38, 0.54,
-    "Fligner",      0.45, 0.50
+  g_raw <- dataset[[group]]
+  
+  # 校验数值变量类型
+  if (!is.numeric(x)) {
+    stop(paste("变量", var, "必须是数值型！"), call. = FALSE)
+  }
+  
+  # 计算有效样本
+  valid_indices <- !is.na(g_raw) & !is.na(x)
+  valid_data <- dataset[valid_indices, ]  # 保留有效样本的完整数据（用于绘图）
+  valid_g <- g_raw[valid_indices]
+  valid_levels <- length(unique(valid_g))
+  
+  # 数据不足判断
+  if (valid_levels < 2) {
+    return(structure(
+      list(
+        df_name = df_name,
+        var = var,
+        group = group,
+        valid_data = valid_data,  # 传递有效数据用于绘图提示
+        res = tibble(
+          Test = "无法执行检验",
+          Statistic = NA_real_,
+          p.value = NA_character_
         )
+      ),
+      class = "homo_variance_test"
+    ))
+  }
+  
+  # 转换分组为因子
+  g <- factor(valid_g)
   
-  dat_summary <- dataset %>%
-    group_by(!!sym(group)) %>%
-    summarise(
-      n = n(),
-      mean = mean(!!sym(var), na.rm = TRUE),
-      sd = sd(!!sym(var), na.rm = TRUE),
-      .groups = "drop"
+  # 检验计算
+  res <- tibble::tibble(
+    Test = character(),
+    Statistic = numeric(),
+    p.value = numeric()
   )
   
-  ## 绘图数据
-  plot_obj <- list(hist = list(type = "hist", data = dataset, var = var, group = group),
-                   density = list(type = "density", data = dataset, var = var, group = group),
-                   boxplot = list(type = "boxplot", data = dataset, var = var, group = group))
+  # Levene检验
+  if ("levene" %in% method && requireNamespace("car", quietly = TRUE)) {
+    tmp <- tryCatch(car::leveneTest(x[valid_indices] ~ g), error = function(e) NULL)
+    if (!is.null(tmp) && nrow(tmp) > 0) {
+      res <- tibble::add_row(res,
+                             Test = "Levene",
+                             Statistic = as.numeric(tmp[["F value"]][1]),
+                             p.value = as.numeric(tmp[["Pr(>F)"]][1]))
+    }
+  }
   
-  as.list(environment()) %>% add_class("homo_variance_test")
+  # Bartlett检验
+  if ("bartlett" %in% method) {
+    tmp <- tryCatch(stats::bartlett.test(x[valid_indices], g), error = function(e) NULL)
+    if (!is.null(tmp)) {
+      res <- tibble::add_row(res,
+                             Test = "Bartlett",
+                             Statistic = as.numeric(tmp$statistic),
+                             p.value = as.numeric(tmp$p.value))
+    }
+  }
+  
+  # Fligner检验
+  if ("fligner" %in% method) {
+    tmp <- tryCatch(stats::fligner.test(x[valid_indices], g), error = function(e) NULL)
+    if (!is.null(tmp)) {
+      res <- tibble::add_row(res,
+                             Test = "Fligner",
+                             Statistic = as.numeric(tmp$statistic),
+                             p.value = as.numeric(tmp$p.value))
+    }
+  }
+  
+  # 返回结果（包含有效数据用于绘图）
+  structure(
+    list(
+      df_name = df_name,
+      var = var,
+      group = group,
+      valid_data = valid_data,  # 新增：保存有效样本数据
+      res = res
+    ),
+    class = "homo_variance_test"
+  )
 }
 
-# Summary method
 #' @export
 summary.homo_variance_test <- function(object, dec = 3, ...) {
+  # 标准化说明文字（与正态性检验格式一致）
   cat("Homogeneity of variance tests\n")
   cat("Data     :", object$df_name, "\n")
-  if (!is.empty(object$data_filter)) {
-    cat("Filter   :", gsub("\\n", "", object$data_filter), "\n")
-  }
   cat("Variable :", object$var, "\n")
   cat("Group    :", object$group, "\n\n")
   
-  ## 打印统计量表
-  object$res %>%
-    as.data.frame(stringsAsFactors = FALSE) %>%
-    format_df(dec = dec) %>%
-    print(row.names = FALSE)
-  cat("\n")
+  # 格式化结果表格
+  result_table <- object$res %>%
+    dplyr::mutate(
+      Statistic = round(Statistic, dec),
+      p.value = dplyr::case_when(
+        p.value < 0.001 ~ "<0.001",
+        is.na(p.value) ~ "",
+        TRUE ~ as.character(round(p.value, dec))
+      )
+    )
+  
+  # 打印结果表格
+  print(as.data.frame(result_table), row.names = FALSE)
+  invisible(object)
 }
 
-# Plot method
 #' @export
-plot.homo_variance_test <- function(x, plots = c("boxplot", "density"),
+plot.homo_variance_test <- function(x, plots = c("boxplot", "density", "hist"),
                                     shiny = FALSE, custom = FALSE, ...) {
+  # 1. 提取有效数据（用于绘图）
+  valid_data <- x$valid_data
+  if (nrow(valid_data) == 0) {
+    return(ggplot2::ggplot() +
+             ggplot2::annotate("text", x = 1, y = 1, label = i18n$t("No valid data for plotting")) +
+             ggplot2::theme_void())
+  }
+  
+  # 2. 定义变量名（用于图表标签）
+  var_name <- x$var
+  group_name <- x$group
+  
+  # 3. 初始化图形列表
   plot_list <- list()
+  
+  # 4. 生成箱线图（按分组展示数值变量分布）
   if ("boxplot" %in% plots) {
-    plot_list[[which("boxplot" == plots)]] <-
-      ggplot(x$dat_summary, aes(x = .data[[x$group]], y = .data[[x$var]])) +
-      geom_boxplot(fill = "lightblue", alpha = 0.7)
+    p <- ggplot2::ggplot(valid_data,
+                         ggplot2::aes(x = .data[[group_name]], 
+                                      y = .data[[var_name]],
+                                      fill = .data[[group_name]])) +
+      ggplot2::geom_boxplot(alpha = 0.7, show.legend = FALSE) +
+      ggplot2::labs(x = group_name, 
+                    y = var_name, 
+                    title = i18n$t("Boxplot by Group")) +
+      ggplot2::theme_minimal() +
+      ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
+    plot_list[["boxplot"]] <- p
   }
+  
+  # 5. 生成密度图（按分组展示数值变量分布）
   if ("density" %in% plots) {
-    plot_list[[which("density" == plots)]] <-
-      ggplot(x$dat_summary, aes(x = .data[[x$var]], fill = .data[[x$group]])) +
-      geom_density(alpha = 0.5)
+    p <- ggplot2::ggplot(valid_data,
+                         ggplot2::aes(x = .data[[var_name]],
+                                      fill = .data[[group_name]],
+                                      color = .data[[group_name]])) +
+      ggplot2::geom_density(alpha = 0.3) +
+      ggplot2::labs(x = var_name,
+                    y = i18n$t("Density"),
+                    title = i18n$t("Density by Group"),
+                    fill = group_name,
+                    color = group_name) +
+      ggplot2::theme_minimal() +
+      ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
+    plot_list[["density"]] <- p
   }
+  
+  # 6. 生成直方图（按分组展示数值变量分布）
   if ("hist" %in% plots) {
-    plot_list[[which("hist" == plots)]] <-
-      ggplot(x$dat_summary, aes(x = .data[[x$var]], fill = .data[[x$group]])) +
-      geom_histogram(alpha = 0.5, position = "identity", bins = 30)
+    p <- ggplot2::ggplot(valid_data,
+                         ggplot2::aes(x = .data[[var_name]],
+                                      fill = .data[[group_name]])) +
+      ggplot2::geom_histogram(position = "identity", alpha = 0.5, bins = 30) +
+      ggplot2::labs(x = var_name,
+                    y = i18n$t("Count"),
+                    title = i18n$t("Histogram by Group"),
+                    fill = group_name) +
+      ggplot2::theme_minimal() +
+      ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
+    plot_list[["hist"]] <- p
   }
   
-  if (length(plot_list) == 0) return(invisible())
-  patchwork::wrap_plots(plot_list, ncol = 1) %>%
-    { if (shiny) print(.) else print(.) }
+  # 7. 处理未选择图表类型的情况
+  if (length(plot_list) == 0) {
+    return(ggplot2::ggplot() +
+             ggplot2::annotate("text", x = 1, y = 1, label = i18n$t("No plots selected")) +
+             ggplot2::theme_void())
+  }
+  
+  # 8. 组合图表（按选择顺序排列）
+  combined_plot <- patchwork::wrap_plots(plot_list[plots], ncol = 1)
+  
+  # 9. 在Shiny中显示或返回图表
+  if (shiny) {
+    print(combined_plot)
     invisible(x)
+  } else {
+    combined_plot
+  }
 }

radiant.basics/R/normality_test.R

@@ -3,36 +3,97 @@
 ############################################
 
 # Batch normality tests for radiant.basics
-#
 #' @export
-normality_test <- function(dataset, var, method = "shapiro",
-                           conf_lev = .95, data_filter = "",
+normality_test <- function(dataset,
+                           var,
+                           method = c("shapiro", "ks", "ad"),
+                           data_filter = "",
                            envir = parent.frame()) {
+  ## 1. 定义支持的检验方法
+  supported_methods <- c("shapiro", "ks", "ad")
+  
+  ## 2. 处理多选方法：过滤无效值+设置默认
+  method <- intersect(method, supported_methods)
+  if (length(method) == 0) method <- "shapiro"
+  method <- match.arg(method, choices = supported_methods, several.ok = TRUE)
+  
+  ## 3. 取数据
   df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset))
   dataset <- get_data(dataset, var, filt = data_filter, na.rm = TRUE, envir = envir)
   x       <- dataset[[var]]
   if (!is.numeric(x)) stop(i18n$t("Variable must be numeric"))
+  x       <- x[!is.na(x)]  # 剔除缺失
   
-  ## ---- 空壳结果 ----
-  res <- tibble::tribble(
-    ~Test, ~Statistic, ~p.value,
-    "Shapiro-Wilk",       0.99, 0.12,
-    "Kolmogorov-Smirnov", 0.05, 0.30,
-    "Anderson-Darling",   0.80, 0.25
+  ## 4. 初始化结果表格
+  res     <- tibble::tibble(
+    Test   = character(),
+    Statistic = numeric(),
+    p.value   = numeric()
   )
   
-  dat_summary <- tibble::tribble(
-    ~mean, ~n, ~n_missing, ~sd, ~se,
-    mean(x, na.rm = TRUE), length(x), sum(is.na(x)), sd(x, na.rm = TRUE), sd(x, na.rm = TRUE)/sqrt(length(x))
+  ## 5. 逐方法计算
+  if ("shapiro" %in% method) {
+    tmp <- tryCatch(stats::shapiro.test(x),
+                    error = function(e) {
+                      stop("Shapiro-Wilk 需要 3 ≤ n ≤ 5000，当前 n = ", length(x),
+                           "\n请换 KS 或 AD 方法。")
+                    })
+    res <- tibble::add_row(res,
+                           Test      = "Shapiro-Wilk",
+                           Statistic = tmp$statistic,
+                           p.value   = tmp$p.value)
+  }
+  
+  if ("ks" %in% method) {
+    if (requireNamespace("nortest", quietly = TRUE)) {
+      tmp <- nortest::lillie.test(x)
+      res <- tibble::add_row(res,
+                             Test      = "Lilliefors-KS",
+                             Statistic = tmp$statistic,
+                             p.value   = tmp$p.value)
+    }
+  }
+  
+  if ("ad" %in% method) {
+    if (requireNamespace("nortest", quietly = TRUE)) {
+      tmp <- nortest::ad.test(x)
+      res <- tibble::add_row(res,
+                             Test      = "Anderson-Darling",
+                             Statistic = tmp$statistic,
+                             p.value   = tmp$p.value)
+    }
+  }
+  
+  ## 6. 样本描述
+  dat_summary <- tibble::tibble(
+    mean      = mean(x),
+    n         = length(x),
+    n_missing = sum(is.na(dataset[[var]])),
+    sd        = sd(x),
+    se        = sd(x) / sqrt(length(x))
   )
   
-  ## 绘图数据
-  plot_obj <- list(qq = list(type = "qq", data = x),
+  ## 7. 绘图对象
+  plot_obj <- list(
+    qq      = list(type = "qq",      data = x),
     hist    = list(type = "hist",    data = x),
     pp      = list(type = "pp",      data = x),
-                   density = list(type = "density", data = x))
+    density = list(type = "density", data = x)
+  )
   
-  as.list(environment()) %>% add_class("normality_test")
+  ## 8. 打包返回
+  out <- list(
+    df_name     = df_name,
+    var         = var,
+    method      = method,
+    data_filter = data_filter,
+    res         = res,
+    dat_summary = dat_summary,
+    x           = x,
+    plot_obj    = plot_obj
+  )
+  class(out) <- "normality_test"
+  out
 }
 
 # Summary method
@@ -47,6 +108,7 @@ summary.normality_test <- function(object, dec = 3, ...) {
   
   ## 打印统计量表
   object$res %>%
+    mutate(p.value = format.pval(p.value, digits = 3, eps = 1e-4)) %>%
     as.data.frame(stringsAsFactors = FALSE) %>%
     format_df(dec = dec) %>%
     print(row.names = FALSE)
@@ -69,9 +131,18 @@ plot.normality_test <- function(x, plots = c("qq", "hist"),
       geom_histogram(fill = "blue", bins = 30)
   }
   if ("pp" %in% plots) {
+    n  <- length(x$x)
+    i  <- 1:n
+    p  <- (i - 0.5) / n
+    theoretical <- qnorm(p)
+    empirical   <- sort(scale(x$x))
     plot_list[[which("pp" == plots)]] <-
-      ggplot(data.frame(y = x$x), aes(sample = y)) +
-      stat_pp_band() + stat_pp_line() + stat_pp_point()
+      ggplot(data.frame(theoretical = theoretical, empirical = empirical), aes(theoretical, empirical)) +
+      geom_point(colour = "blue") +
+      geom_abline(intercept = 0, slope = 1, linetype = "dashed", colour = "red") +
+      labs(x = "Theoretical quantiles", y = "Empirical quantiles",
+           title = "P-P plot") +
+      theme_minimal()
   }
   if ("density" %in% plots) {
     plot_list[[which("density" == plots)]] <-

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

@@ -20,31 +20,63 @@ hv_args <- as.list(formals(homo_variance_test))
 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. 变量选择（numeric + grouping）
+## 4. 数值变量选择
 output$ui_hv_var <- renderUI({
-  isNum <- .get_class() %in% c("integer", "numeric", "ts")
-  vars <- c("None" = "", varnames()[isNum])
+  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
+    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({
-  vars <- groupable_vars()
+  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 = vars, selected = state_single("hv_group", vars), multiple = FALSE
+    inputId = "hv_group", 
+    label = i18n$t("Grouping variable:"),
+    choices = valid_groups, 
+    selected = state_single("hv_group", valid_groups), 
+    multiple = FALSE
   )
 })
 
-## 5. 主 UI
+## 6. 主UI
 output$ui_homo_variance_test <- renderUI({
   req(input$dataset)
   tagList(
@@ -53,22 +85,21 @@ output$ui_homo_variance_test <- renderUI({
         condition = "input.tabs_homo_variance_test == 'Summary'",
         uiOutput("ui_hv_var"),
         uiOutput("ui_hv_group"),
-        selectInput(
-          inputId = "hv_method", label = i18n$t("Test method:"),
+        selectizeInput(
+          inputId = "hv_method", 
+          label = i18n$t("Test method:"),
           choices = hv_method,
-          selected = state_single("hv_method", hv_method, "levene"),
-          multiple = FALSE
-        ),
-        sliderInput(
-          "hv_conf_lev", i18n$t("Confidence level:"),
-          min = 0.85, max = 0.99,
-          value = state_init("hv_conf_lev", 0.95), step = 0.01
+          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:"),
+          inputId = "hv_plots", 
+          label = i18n$t("Select plots:"),
           choices = hv_plots,
           selected = state_multiple("hv_plots", hv_plots, "boxplot"),
           multiple = TRUE,
@@ -86,7 +117,7 @@ output$ui_homo_variance_test <- renderUI({
   )
 })
 
-## 6. 画图尺寸
+## 7. 画图尺寸
 hv_plot <- reactive({
   list(plot_width = 650,
        plot_height = 400 * max(length(input$hv_plots), 1))
@@ -94,7 +125,7 @@ hv_plot <- reactive({
 hv_plot_width  <- function() hv_plot()$plot_width
 hv_plot_height <- function() hv_plot()$plot_height
 
-## 7. 输出面板
+## 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",
@@ -102,12 +133,8 @@ output$homo_variance_test <- renderUI({
   
   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"),
+    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%"))
   )
   
@@ -119,17 +146,34 @@ output$homo_variance_test <- renderUI({
   )
 })
 
-## 8. 可用性检查
+## 9. 可用性检查（强化变量存在性校验）
 hv_available <- reactive({
-  if (not_available(input$hv_var))
-    return(i18n$t("This analysis requires a numeric variable. If none are\navailable please select another dataset.") %>% suggest_data("demand_uk"))
-  if (not_available(input$hv_group))
-    return(i18n$t("Please select a grouping variable."))
+  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"
 })
 
-## 9. 计算核心
+## 10. 计算核心
 .homo_variance_test <- reactive({
+  req(hv_available() == "available")  # 确保通过可用性检查
   hvi <- hv_inputs()
   hvi$envir <- r_data
   do.call(homo_variance_test, hvi)
@@ -142,33 +186,18 @@ hv_available <- reactive({
 
 .plot_homo_variance_test <- reactive({
   if (hv_available() != "available") return(hv_available())
-  validate(need(input$hv_plots, i18n$t("Nothing to plot. Please select a plot type")))
+  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))
 })
 
-## 10. Report
-homo_variance_test_report <- function() {
-  if (is.empty(input$hv_var)) return(invisible())
-  figs <- length(input$hv_plots) > 0
-  outputs <- if (figs) c("summary", "plot") else "summary"
-  inp_out <- if (figs) list("", list(plots = input$hv_plots, custom = FALSE)) else list("", "")
-  update_report(inp_main = clean_args(hv_inputs(), hv_args),
-                fun_name = "homo_variance_test",
-                inp_out  = inp_out,
-                outputs  = outputs,
-                figs     = figs,
-                fig.width = hv_plot_width(),
-                fig.height = hv_plot_height())
-}
-
 ## 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 homogeneity of variance plot"),
+  caption = i18n$t("Save plot"),
   plot = .plot_homo_variance_test,
   width = hv_plot_width,
   height = hv_plot_height

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

@@ -3,7 +3,7 @@
 ############################################
 
 ## 1. 翻译标签
-nt_method <- c("shapiro", "ks", "ad")   # 先给 3 个常用方法
+nt_method <- c("shapiro", "ks", "ad")  
 names(nt_method) <- c(i18n$t("Shapiro-Wilk"),
                       i18n$t("Kolmogorov-Smirnov"),
                       i18n$t("Anderson-Darling"))
@@ -21,13 +21,19 @@ nt_args <- as.list(formals(normality_test))
 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)]]
+    input_key <- paste0("nt_", i)
+    if (!is.null(input[[input_key]])) { 
+      nt_args[[i]] <- input[[input_key]]
+    }
   }
+  nt_args$method <- input$nt_method
+  
   nt_args
 })
 
-## 4. 变量选择（仅 numeric）
+## 4. 变量选择
 output$ui_nt_var <- renderUI({
   isNum <- .get_class() %in% c("integer", "numeric", "ts")
   vars <- c("None" = "", varnames()[isNum])
@@ -45,16 +51,13 @@ output$ui_normality_test <- renderUI({
       conditionalPanel(
         condition = "input.tabs_normality_test == 'Summary'",
         uiOutput("ui_nt_var"),
-        selectInput(
+        selectizeInput(
           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
+          selected = state_multiple("nt_method", nt_method, "shapiro"),
+          multiple = TRUE,
+          options = list(placeholder = i18n$t("Select methods"),
+                         plugins = list("remove_button", "drag_drop"))
         )
       ),
       conditionalPanel(
@@ -122,11 +125,13 @@ nt_available <- reactive({
 ## 9. 计算核心
 .normality_test <- reactive({
   nti <- nt_inputs()
+  req(nti$method, nti$var)
   nti$envir <- r_data
   do.call(normality_test, nti)
 })
 
 .summary_normality_test <- reactive({
+  input$nt_method
   if (nt_available() != "available") return(nt_available())
   summary(.normality_test())
 })

radiant.data/DESCRIPTION

@@ -47,6 +47,7 @@ Imports:
     png,
     MASS,
     base64enc,
+    shinyalert,
     shiny.i18n
 Suggests:
     arrow (>= 12.0.1),

radiant.data/inst/app/global.R

@@ -603,8 +603,7 @@ options(
         tabPanel(
           actionLink(
             "stop_radiant", i18n$t("Stop"),
-            icon = icon("stop", verify_fa = FALSE),
-            onclick = "setTimeout(function(){window.close();}, 100);"
+            icon = icon("stop", verify_fa = FALSE)
           )
         ),
         tabPanel(tags$a(

radiant.data/inst/app/tools/app/stop.R

@@ -2,6 +2,19 @@
 # Stop menu
 #######################################
 observeEvent(input$stop_radiant, {
+  shinyalert::shinyalert(
+    title = "确认停止",
+    text  = "停止按钮会将所有容器都关闭！确定停止吗？",
+    type  = "warning",
+    showCancelButton = TRUE,
+    confirmButtonCol = "#d33",
+    confirmButtonText = "确定",
+    cancelButtonText  = "取消",
+    callbackJS = "function(x){if(x){Shiny.setInputValue('really_stop',Math.random());}}"
+  )
+})
+
+observeEvent(input$really_stop, {
   if (isTRUE(getOption("radiant.local"))) stop_radiant()
 })
 

radiant.data/inst/app/tools/data/visualize_ui.R

-#############################################
-# 安全封装：避免 is.empty() 报错
-#############################################
-safe_is_empty <- function(x) {
-  if (is.null(x) || !is.character(x)) return(TRUE)
-  is.empty(x)
+is.empty <- function(x, empty = "\\s*") {
+  if (is.null(x)) return(TRUE)
+  if (is.atomic(x) && length(x) == 0) return(TRUE)
+  if (!is.character(x)) return(FALSE)
+  is_not(x) ||
+    (length(x) == 1 && any(grepl(paste0("^", empty, "$"), x)))
 }
 
-#############################################
-# 其余代码保持不变，仅替换 is.empty() 调用
-#############################################
-
 viz_type <- c(
   "分布图（dist）" = "dist", "密度图（density）" = "density", "散点图（scatter）" = "scatter",
   "曲面图（surface）" = "surface", "折线图（line）" = "line", "条形图（bar）" = "bar", "箱线图（box）" = "box"
@@ -46,14 +42,17 @@ viz_add_labs <- function() {
   lab_list <- list()
   for (l in viz_labs) {
     inp <- input[[paste0("viz_labs_", l)]]
-    if (!safe_is_empty(inp)) lab_list[[l]] <- inp
+    if (!is.empty(inp)) lab_list[[l]] <- inp
   }
   lab_list
 }
 
+## list of function arguments
 viz_args <- as.list(formals(visualize))
 
+## list of function inputs selected by user
 viz_inputs <- reactive({
+  ## loop needed because reactive values don't allow single bracket indexing
   viz_args$data_filter <- if (isTRUE(input$show_filter)) input$data_filter else ""
   viz_args$arr <- if (isTRUE(input$show_filter)) input$data_arrange else ""
   viz_args$rows <- if (isTRUE(input$show_filter)) input$data_rows else ""
@@ -63,9 +62,16 @@ viz_inputs <- reactive({
   for (i in r_drop(names(viz_args), drop = c(i18n$t("dataset"), i18n$t("data_filter"), i18n$t("arr"), i18n$t("rows"), i18n$t("labs")))) {
     viz_args[[i]] <- input[[paste0("viz_", i)]]
   }
+  # isolate({
+  #   # cat(paste0(names(viz_args), " ", viz_args, collapse = ", "), file = stderr(), "\n")
+  #   cat(paste0(names(viz_args), " = ", viz_args, collapse = ", "), "\n")
+  # })
   viz_args
 })
 
+#######################################
+# Visualize data
+#######################################
 output$ui_viz_type <- renderUI({
   selectInput(
     inputId = "viz_type", label = i18n$t("Plot-type:"), choices = viz_type,
@@ -86,6 +92,7 @@ output$ui_viz_nrobs <- renderUI({
   )
 })
 
+## Y - variable
 output$ui_viz_yvar <- renderUI({
   req(input$viz_type)
   vars <- varying_vars()
@@ -95,8 +102,10 @@ output$ui_viz_yvar <- renderUI({
     vars <- vars["character" != .get_class()[vars]]
   }
   if (input$viz_type %in% c("box", "scatter")) {
+    ## allow factors in yvars for bar plots
     vars <- vars["factor" != .get_class()[vars]]
   }
+  
   selectInput(
     inputId = "viz_yvar", label = i18n$t("Y-variable:"),
     choices = vars,
@@ -105,6 +114,8 @@ output$ui_viz_yvar <- renderUI({
   )
 })
 
+
+## X - variable
 output$ui_viz_xvar <- renderUI({
   req(input$viz_type)
   vars <- varying_vars()
@@ -112,6 +123,7 @@ output$ui_viz_xvar <- renderUI({
   if (input$viz_type == "dist") vars <- vars["date" != .get_class()[vars]]
   if (input$viz_type == "density") vars <- vars["factor" != .get_class()[vars]]
   if (input$viz_type %in% c("box", "bar")) vars <- groupable_vars_nonum()
+  
   selectInput(
     inputId = "viz_xvar", label = i18n$t("X-variable:"), choices = vars,
     selected = state_multiple("viz_xvar", vars, isolate(input$viz_xvar)),
@@ -180,6 +192,7 @@ output$ui_viz_color <- renderUI({
   } else {
     vars <- c("None" = "none", varnames())
   }
+  
   if (isTRUE(input$viz_comby) && length(input$viz_yvar) > 1) vars <- c("None" = "none")
   selectizeInput(
     "viz_color", i18n$t("Color:"), vars,
@@ -223,6 +236,7 @@ output$ui_viz_axes <- renderUI({
     ind <- c(1, 3)
   }
   if (input$viz_facet_row != "." || input$viz_facet_col != ".") ind <- c(ind, 4)
+  # if (input$viz_type == "bar" && input$viz_facet_row == "." && input$viz_facet_col == ".") ind <- c(ind, 6)
   if (input$viz_type == "bar") ind <- c(ind, 6)
   
   checkboxGroupInput(
@@ -243,6 +257,7 @@ output$ui_viz_check <- renderUI({
   } else {
     ind <- c()
   }
+  
   if (!input$viz_type %in% c("scatter", "box")) {
     r_state$viz_check <<- gsub("jitter", "", r_state$viz_check)
   }
@@ -250,6 +265,7 @@ output$ui_viz_check <- renderUI({
     r_state$viz_check <<- gsub("line", "", r_state$viz_check)
     r_state$viz_check <<- gsub("loess", "", r_state$viz_check)
   }
+  
   checkboxGroupInput(
     "viz_check", NULL, viz_check[ind],
     selected = state_group("viz_check", ""),
@@ -258,11 +274,15 @@ output$ui_viz_check <- renderUI({
 })
 
 output$ui_viz_run <- renderUI({
+  ## updates when dataset changes
   req(input$dataset)
   actionButton("viz_run", i18n$t("Create plot"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success")
+  ## this didn't seem to work quite like the observe below
+  ## https://stackoverflow.com/questions/43641103/change-color-actionbutton-shiny-r
 })
 
 output$ui_viz_labs <- renderUI({
+  ## updates when dataset changes
   req(input$dataset)
   wellPanel(
     textAreaInput("viz_labs_title", NULL, "", placeholder = i18n$t("Title"), rows = 1),
@@ -276,7 +296,10 @@ output$ui_viz_labs <- renderUI({
 output$ui_viz_colors <- renderUI({
   tagList(
     conditionalPanel(
-      condition = "input.viz_type == 'bar' || input.viz_type == 'dist' || input.viz_type == 'box' || input.viz_type == 'density'",
+      condition = "input.viz_type == 'bar' ||
+                   input.viz_type == 'dist' ||
+                   input.viz_type == 'box' ||
+                   input.viz_type == 'density'",
       selectInput(
         "viz_fillcol", i18n$t("Fill color:"),
         choices = colors(),
@@ -284,7 +307,11 @@ output$ui_viz_colors <- renderUI({
       )
     ),
     conditionalPanel(
-      condition = "input.viz_type == 'dist' || input.viz_type == 'density' || input.viz_type == 'box' || input.viz_type == 'scatter' || input.viz_type == 'line'",
+      condition = "input.viz_type == 'dist' ||
+                   input.viz_type == 'density' ||
+                   input.viz_type == 'box' ||
+                   input.viz_type == 'scatter' ||
+                   input.viz_type == 'line'",
       selectInput(
         "viz_linecol", i18n$t("Line color:"),
         choices = colors(),
@@ -292,7 +319,9 @@ output$ui_viz_colors <- renderUI({
       )
     ),
     conditionalPanel(
-      condition = "input.viz_type == 'scatter' || input.viz_type == 'line' || input.viz_type == 'box'",
+      condition = "input.viz_type == 'scatter' ||
+                   input.viz_type == 'line' ||
+                   input.viz_type == 'box'",
       selectInput(
         "viz_pointcol", i18n$t("Point color:"),
         choices = colors(),
@@ -302,6 +331,7 @@ output$ui_viz_colors <- renderUI({
   )
 })
 
+## add a spinning refresh icon if the graph needs to be (re)recreated
 run_refresh(
   viz_args, "viz",
   init = c("xvar", "yvar"), label = i18n$t("Create plot"), relabel = i18n$t("Update plot"),
@@ -341,11 +371,16 @@ output$ui_Visualize <- renderUI({
         uiOutput("ui_viz_facet_row"),
         uiOutput("ui_viz_facet_col"),
         conditionalPanel(
-          condition = "input.viz_type == 'bar' || input.viz_type == 'dist' || input.viz_type == 'density' || input.viz_type == 'surface'",
+          condition = "input.viz_type == 'bar' ||
+                       input.viz_type == 'dist' ||
+                       input.viz_type == 'density' ||
+                       input.viz_type == 'surface'",
           uiOutput("ui_viz_fill")
         ),
         conditionalPanel(
-          condition = "input.viz_type == 'scatter' || input.viz_type == 'line' || input.viz_type == 'box'",
+          condition = "input.viz_type == 'scatter' ||
+                       input.viz_type == 'line' ||
+                       input.viz_type == 'box'",
           uiOutput("ui_viz_color")
         ),
         conditionalPanel(
@@ -353,7 +388,9 @@ output$ui_Visualize <- renderUI({
           uiOutput("ui_viz_size")
         ),
         conditionalPanel(
-          condition = "input.viz_type == 'bar' || input.viz_type == 'scatter' || input.viz_type == 'line'",
+          condition = "input.viz_type == 'bar' ||
+                       input.viz_type == 'scatter' ||
+                       input.viz_type == 'line'",
           selectInput(
             "viz_fun", i18n$t("Function:"),
             choices = getOption("radiant.functions"),
@@ -361,7 +398,10 @@ output$ui_Visualize <- renderUI({
           )
         ),
         conditionalPanel(
-          condition = "input.viz_type == 'scatter' || input.viz_type == 'line' || input.viz_type == 'surface' || input.viz_type == 'box'",
+          condition = "input.viz_type == 'scatter' ||
+                       input.viz_type == 'line' ||
+                       input.viz_type == 'surface' ||
+                       input.viz_type == 'box'",
           uiOutput("ui_viz_check")
         ),
         uiOutput("ui_viz_axes"),
@@ -375,7 +415,9 @@ output$ui_Visualize <- renderUI({
           )
         ),
         conditionalPanel(
-          "input.viz_type == 'density' || input.viz_type == 'dist' && (input.viz_axes && input.viz_axes.indexOf('density')) >= 0 || (input.viz_type == 'scatter' && (input.viz_check && input.viz_check.indexOf('loess') >= 0))",
+          "input.viz_type == 'density' ||
+           input.viz_type == 'dist' && (input.viz_axes && input.viz_axes.indexOf('density')) >= 0 ||
+           (input.viz_type == 'scatter' && (input.viz_check && input.viz_check.indexOf('loess') >= 0))",
           sliderInput(
             "viz_smooth",
             label = i18n$t("Smooth:"),
@@ -448,9 +490,10 @@ output$ui_Visualize <- renderUI({
 })
 
 viz_plot_width <- reactive({
-  if (safe_is_empty(input$viz_plot_width)) r_info[["plot_width"]] else input$viz_plot_width
+  if (is.empty(input$viz_plot_width)) r_info[["plot_width"]] else input$viz_plot_width
 })
 
+## based on https://stackoverflow.com/a/40182833/1974918
 viz_plot_height <- eventReactive(
   {
     input$viz_run
@@ -458,11 +501,12 @@ viz_plot_height <- eventReactive(
     input$viz_plot_width
   },
   {
-    if (safe_is_empty(input$viz_plot_height)) {
+    if (is.empty(input$viz_plot_height)) {
       r_info[["plot_height"]]
     } else {
       lx <- ifelse(not_available(input$viz_xvar) || isTRUE(input$viz_combx), 1, length(input$viz_xvar))
-      ly <- ifelse(not_available(input$viz_yvar) || input$viz_type %in% c("dist", "density") || isTRUE(input$viz_comby), 1, length(input$viz_yvar))
+      ly <- ifelse(not_available(input$viz_yvar) || input$viz_type %in% c("dist", "density") ||
+                     isTRUE(input$viz_comby), 1, length(input$viz_yvar))
       nr <- lx * ly
       if (nr > 1) {
         (input$viz_plot_height / 2) * ceiling(nr / 2)
@@ -473,38 +517,78 @@ viz_plot_height <- eventReactive(
   }
 )
 
-output$visualize <- renderPlot({
+output$visualize <- renderPlot(
+  {
     req(input$viz_type)
-  p <- .visualize()
-  if (is.null(p)) return(NULL)
-  print(p)
-}, width = viz_plot_width, height = viz_plot_height, res = 96)
+    if (not_available(input$viz_xvar)) {
+      if (!input$viz_type %in% c("box", "line")) {
+        return(
+          plot(
+            x = 1, type = "n",
+            main = i18n$t("Please select variables from the dropdown menus to create a plot"),
+            axes = FALSE, xlab = "", ylab = "", cex.main = .9
+          )
+        )
+      }
+    }
+    .visualize() %>%
+      (function(x) {
+        if (is.empty(x) || is.character(x)) {
+          plot(x = 1, type = "n", main = paste0("\n", x), axes = FALSE, xlab = "", ylab = "", cex.main = .9)
+        } else if (length(x) > 0) {
+          print(x)
+        }
+      })
+  },
+  width = viz_plot_width,
+  height = viz_plot_height,
+  res = 96
+)
 
 .visualize <- eventReactive(input$viz_run, {
   req(input$viz_type)
   if (input$viz_type == "scatter") req(input$viz_nrobs)
+  
+  ## need dependency on ..
   req(input$viz_plot_height && input$viz_plot_width)
   
   if (not_available(input$viz_xvar) && !input$viz_type %in% c("box", "line")) {
-    return(NULL)  
+    return()
+  } else if (input$viz_type %in% c("scatter", "line", "box", "bar", "surface") && not_available(input$viz_yvar)) {
+    return(i18n$t("No Y-variable provided for a plot that requires one"))
+  } else if (input$viz_type == "box" && !all(input$viz_xvar %in% groupable_vars())) {
+    return()
+  }
+  
+  ## waiting for comby and/or combx to be updated
+  if (input$viz_type %in% c("dist", "density")) {
+    if (isTRUE(input$viz_comby)) {
+      return()
+    }
+    if (length(input$viz_xvar) > 1 && is.null(input$viz_combx)) {
+      return()
+    }
+  } else {
+    if (isTRUE(input$viz_combx)) {
+      return()
+    }
+    if (length(input$viz_yvar) > 1 && is.null(input$viz_comby)) {
+      return()
     }
-  if (input$viz_type %in% c("scatter", "line", "box", "bar", "surface") && not_available(input$viz_yvar)) {
-    return(NULL)  
   }
   
+  req(!is.null(input$viz_color) || !is.null(input$viz_fill))
   vizi <- viz_inputs()
   vizi$dataset <- input$dataset 
   vizi$shiny <- TRUE
   vizi$envir <- r_data
-  
   withProgress(message = i18n$t("Making plot"), value = 1, {
-    p <- do.call(visualize, vizi)
-    if (is.character(p)) return(NULL) 
-    p
+    do.call(visualize, vizi)
   })
 })
 
 visualize_report <- function() {
+  ## resetting hidden elements to default values
   vi <- viz_inputs()
   if (input$viz_type != "dist") {
     vi$bins <- viz_args$bins
@@ -531,6 +615,7 @@ visualize_report <- function() {
   if (!input$viz_type %in% c("bar", "dist", "density", "surface")) {
     vi$fill <- NULL
   }
+  
   if (!input$viz_type %in% c("bar", "dist", "box", "density")) {
     vi$fillcol <- "blue"
   }
@@ -540,13 +625,16 @@ visualize_report <- function() {
   if (!input$viz_type %in% c("box", "scatter", "line")) {
     vi$pointcol <- "black"
   }
+  
   if (!input$viz_type %in% c("bar", "line", "scatter")) {
     vi$fun <- "mean"
   }
-  if (safe_is_empty(input$data_rows)) {
+  if (is.empty(input$data_rows)) {
     vi$rows <- NULL
   }
+  
   inp_main <- c(clean_args(vi, viz_args), custom = FALSE)
+  
   update_report(
     inp_main = inp_main,
     fun_name = "visualize",

radiant.model/R/cox.R

-#' Cox Proportional Hazards Regression (minimal)
+#' Cox Proportional Hazards Regression
 #'
 #' @export
 coxp <- function(dataset,
@@ -13,6 +13,11 @@ coxp <- function(dataset,
                  rows = NULL,
                  envir = parent.frame()) {
   
+  if (!requireNamespace("survival", quietly = TRUE))
+    stop("survival package is required but not installed.")
+  attachNamespace("survival") 
+  on.exit(detach("package:survival"), add = TRUE)
+  
   ## ---- 公式入口 ----------------------------------------------------------
   if (!missing(form)) {
     form  <- as.formula(format(form))
@@ -32,6 +37,26 @@ coxp <- function(dataset,
   df_name <- if (is_string(dataset)) dataset else deparse(substitute(dataset))
   dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir)
   
+  ## 状态变量检查与转换
+  surv_status <- dataset[[status]]
+  if (!is.numeric(surv_status)) {
+    ## 允许 0/1、FALSE/TRUE、factor(未事件/事件) 等常见编码
+    if (is.factor(surv_status) || is.character(surv_status)) {
+      lv <- unique(surv_status)
+      if (length(lv) != 2) {
+        return("Status variable must be binary (0/1 or two levels)." %>% add_class("coxp"))
+      }
+      ## 统一成 0/1：按字母顺序或因子水平，第二个水平当作“事件=1”
+      dataset[[status]] <- as.numeric(factor(surv_status, levels = lv)) - 1L
+    } else {
+      return("Status variable must be numeric 0/1 or binary factor." %>% add_class("coxp"))
+    }
+  } else {
+    if (!all(unique(surv_status) %in% c(0, 1))) {
+      return("Status variable must contain only 0 and 1." %>% add_class("coxp"))
+    }
+  }
+  
   ## ---- 构造公式 ----------------------------------------------------------
   if (missing(form)) {
     rhs <- if (length(evar) == 0) "1" else paste(evar, collapse = " + ")
@@ -46,35 +71,79 @@ coxp <- function(dataset,
     model <- survival::coxph(form, data = dataset)
   }
   
-  ## ---- 打包返回 ----------------------------------------------------------
+  ## 失败模型保护
+  if (inherits(model, "try-error")) {
+    return("Model estimation failed. Check data separation or collinearity." %>% add_class("coxp"))
+  }
+  
+  ## 基础摘要信息
+  coef_df <- broom::tidy(model, conf.int = TRUE)  # 系数、HR、CI、p
+  n  <- nrow(dataset)          # 样本量
+  n_event <- sum(dataset[[status]])  # 事件数
+  conc  <- survival::survConcordance.fit(y = Surv(dataset[[time]], dataset[[status]]),
+                                         x = predict(model, type = "lp"))$concordance
+  
+  cat("coef:", length(coef(model)), "  n=", nrow(dataset),
+      "  events=", sum(dataset[[status]]), "\n")
+  
+  ## 打包返回
   out <- as.list(environment())
   out$model   <- model
   out$df_name <- df_name
   out$type    <- "survival"
   out$check   <- check
+  ## 附加对象
+  out$coef_df <- coef_df
+  out$n       <- n
+  out$n_event <- n_event
+  out$concordance <- conc
   add_class(out, c("coxp", "model"))
 }
 
-#' Summary 占位
 #' @export
 summary.coxp <- function(object, ...) {
   if (is.character(object)) return(object)
+  # 检查模型对象有效性
+  if (!inherits(object$model, "coxph")) {
+    cat("** Invalid Cox model object. **\n")
+    return(invisible(object))
+  }
+  # 输出基础信息
+  cat("Cox Proportional Hazards\n")
+  cat("Data:", object$df_name, "  N=", object$n, "  Events=", object$n_event, "\n")
+  cat("Concordance=", round(object$concordance, 3), "\n\n")
+  # 输出模型summary
   summary(object$model)
+  invisible(object)
 }
 
-#' Predict 占位
+
 #' @export
 predict.coxp <- function(object, pred_data = NULL, pred_cmd = "",
                          dec = 3, envir = parent.frame(), ...) {
   if (is.character(object)) return(object)
-  ## 如需生存预测，可返回 linear.predictors 或 survival 曲线
-  pfun <- function(m, newdata) predict(m, newdata = newdata, type = "lp")
-  predict_model(object, pfun, "coxp.predict",
-                pred_data, pred_cmd, dec = dec, envir = envir)
+  
+  ## 构造预测数据框
+  if (is.null(pred_data)) {
+    newdata <- envir$.model_frame  # 若无新数据，默认用训练集
+  } else {
+    newdata <- get_data(pred_data, envir = envir)
+  }
+  if (!is.empty(pred_cmd)) {
+    newdata <- modify_data(newdata, pred_cmd, envir = envir)
+  }
+  
+  ## 线性预测值 + HR
+  lp  <- predict(object$model, newdata = newdata, type = "lp")
+  hr  <- exp(lp)
+  res <- data.frame(lp = round(lp, dec), hr = round(hr, dec))
+  attr(res, "pred_type") <- "linear predictor & hazard ratio"
+  res
 }
 
-#' Print 预测占位
 #' @export
 print.coxp.predict <- function(x, ..., n = 10) {
-  print_predict_model(x, ..., n = n, header = "Cox Proportional Hazards")
+  cat("Cox PH predictions (linear predictor & hazard ratio):\n")
+  print(head(x, n))
+  invisible(x)
 }
\ No newline at end of file

radiant.model/inst/app/tools/analysis/cox_ui.R

-## ========== coxp_ui.R  去错版 ==========
+## ========== coxp_ui.R ==========
 
 ## 1. 常量 -----------------------------------------------------------------
 coxp_show_interactions <- setNames(c("", 2, 3),
@@ -24,7 +24,6 @@ coxp_plots <- setNames(
 )
 
 ## 2. 参数收集 -------------------------------------------------------------
-##  不再取 formals，全部用空列表占位
 coxp_args       <- list()
 coxp_sum_args   <- list()
 coxp_plot_args  <- list()
@@ -259,7 +258,7 @@ output$ui_coxp <- renderUI({
         selectInput("coxp_plots", i18n$t("Plots:"), choices = coxp_plots,
                     selected = state_single("coxp_plots", coxp_plots)),
         conditionalPanel(
-          condition = "input.coxp_plots == 'coef' | input.coxp_plots == 'pdp' | input$coxp_plots == 'pred_plot'",
+          condition = "input.coxp_plots == 'coef' || input.coxp_plots == 'pdp' || input.coxp_plots == 'pred_plot'",
           uiOutput("ui_coxp_incl"),
           conditionalPanel(
             condition = "input.coxp_plots == 'coef'",
@@ -271,7 +270,7 @@ output$ui_coxp <- renderUI({
           )
         ),
         conditionalPanel(
-          condition = "input.coxp_plots %in% c('correlations','scatter','dashboard','resid_pred')",
+          condition = "['correlations', 'scatter', 'dashboard', 'resid_pred'].indexOf(input.coxp_plots) !== -1",
           uiOutput("ui_coxp_nrobs"),
           conditionalPanel(
             condition = "input.coxp_plots != 'correlations'",
@@ -281,9 +280,9 @@ output$ui_coxp <- renderUI({
         )
       ),
       conditionalPanel(
-        condition = "(input.tabs_coxp == 'Summary' && input$coxp_sum_check != undefined && input$coxp_sum_check.indexOf('confint') >= 0) ||
-                     (input.tabs_coxp == 'Predict' && input$coxp_predict != 'none') ||
-                     (input.tabs_coxp == 'Plot' && input$coxp_plots == 'coef')",
+        condition = "(input.tabs_coxp == 'Summary' && input.coxp_sum_check != undefined && input.coxp_sum_check.indexOf('confint') >= 0) ||
+               (input.tabs_coxp == 'Predict' && input.coxp_predict != 'none') ||
+               (input.tabs_coxp == 'Plot' && input.coxp_plots == 'coef')",
         sliderInput("coxp_conf_lev", i18n$t("Confidence level:"),
                     min = 0.80, max = 0.99, value = state_init("coxp_conf_lev", .95), step = 0.01)
       ),
@@ -372,33 +371,117 @@ output$coxp <- renderUI({
 })
 
 ## 10. 可用性检查 ----------------------------------------------------------
-coxp_available <- eventReactive(input$coxp_run, {
-  if (not_available(input$coxp_time)) {
-    i18n$t("This analysis requires a time variable of type integer/numeric.") %>% suggest_data("lung")
-  } else if (not_available(input$coxp_status)) {
-    i18n$t("Please select a status (event) variable.") %>% suggest_data("lung")
-  } else if (not_available(input$coxp_evar)) {
-    i18n$t("Please select one or more explanatory variables.") %>% suggest_data("lung")
-  } else {
-    "available"
+coxp_available <- reactive({
+  if (!input$dataset %in% names(r_data)) {
+    return(i18n$t("数据集不存在：请先加载有效数据集"))
+  }
+  # 检查时间变量
+  if (is.null(input$coxp_time) || input$coxp_time == "" || !input$coxp_time %in% colnames(r_data[[input$dataset]])) {
+    return(i18n$t("时间变量无效：请选择数据集中存在的数值型变量"))
+  }
+  # 检查状态变量
+  if (is.null(input$coxp_status) || input$coxp_status == "" || !input$coxp_status %in% colnames(r_data[[input$dataset]])) {
+    return(i18n$t("状态变量无效：请选择数据集中存在的变量"))
   }
+  # 检查解释变量
+  if (is.null(input$coxp_evar) || length(input$coxp_evar) == 0 || length(setdiff(input$coxp_evar, colnames(r_data[[input$dataset]]))) > 0) {
+    return(i18n$t("解释变量无效：请选择至少一个数据集中存在的变量"))
+  }
+  return("available")
 })
 
-## 11. 模型估计 ------------------------------------------------------------
+
+## 11. 模型估计
 .coxp <- eventReactive(input$coxp_run, {
-  ci <- coxp_inputs()
-  ci$envir <- r_data
-  withProgress(message = i18n$t("Estimating Cox model"), value = 1,
-               do.call(coxph, ci))
+  cat("---->coxp reactive entered")
+  # 严格校验变量
+  ds <- tryCatch({
+    get_data(input$dataset, vars = c(), envir = r_data)  # 先获取完整数据集
+  }, error = function(e) return(paste("数据集获取失败：", e$message)))
+  
+  if (is.character(ds)) return(ds)  # 数据集不存在，返回错误
+  
+  # 校验时间变量
+  if (!input$coxp_time %in% colnames(ds)) {
+    return(paste("时间变量不存在：数据集中无「", input$coxp_time, "」列", sep = ""))
+  }
+  if (!is.numeric(ds[[input$coxp_time]])) {
+    return(paste("时间变量类型错误：「", input$coxp_time, "」需为数值型（整数/小数）", sep = ""))
+  }
+  
+  # 校验状态变量
+  if (!input$coxp_status %in% colnames(ds)) {
+    return(paste("状态变量不存在：数据集中无「", input$coxp_status, "」列", sep = ""))
+  }
+  sv <- ds[[input$coxp_status]]
+  sv <- if (is.factor(sv)) as.numeric(sv) - 1 else sv  # 因子转0/1
+  sv <- ifelse(sv %in% c(0, 1), sv, 0)  # 非0/1强制为0
+  n_event <- sum(sv)
+  if (n_event < 1) {
+    return(paste("事件数不足：状态变量转换后仅", n_event, "个事件（需至少1个），请检查状态变量编码"))
+  }
+  ds[[input$coxp_status]] <- sv
+  
+  # 校验解释变量（存在且非空）
+  evar_missing <- setdiff(input$coxp_evar, colnames(ds))
+  if (length(evar_missing) > 0) {
+    return(paste("解释变量不存在：数据集中无「", paste(evar_missing, collapse = "、"), "」列", sep = ""))
+  }
+  
+  # 构建模型并运行
+  form <- as.formula(paste0("Surv(", input$coxp_time, ", ", input$coxp_status, ") ~ ", paste(input$coxp_evar, collapse = " + ")))
+  model <- tryCatch({
+    survival::coxph(form, data = ds)
+  }, error = function(e) return(paste("coxph模型失败：", gsub("\n", " ", e$message)))) 
+  
+  return(model)
 })
 
 ## 12. summary / predict / plot --------------------------------------------
 .summary_coxp <- reactive({
-  if (not_pressed(input$coxp_run)) return(i18n$t("** Press the Estimate button to estimate the model **"))
-  if (coxp_available() != "available") return(coxp_available())
-  summary(.coxp()$model)   # 直接调 survival 的 summary
+  if (not_pressed(input$coxp_run)) {
+    return(i18n$t("** 请点击「估计模型」按钮运行分析 **")) 
+  }
+  
+  # 先检查可用性（提前拦截无效操作）
+  avail_msg <- coxp_available()
+  if (avail_msg != "available") {
+    return(paste0("** 前置检查失败：", avail_msg, " **"))
+  }
+  
+  # 获取模型结果（可能是coxph对象或错误文本）
+  model_result <- .coxp()
+  
+  # 处理错误文本
+  if (is.character(model_result)) {
+    return(paste0("** 模型运行失败：", model_result, " **"))
+  }
+  
+  # 处理有效模型
+  if (inherits(model_result, "coxph")) {
+    # 检查是否有系数（避免无系数的空模型）
+    if (length(coef(model_result)) == 0) {
+      return(i18n$t("** 未估计出系数：可能存在完全共线性、事件数不足或变量无效 **"))
+    }
+    # 输出标准summary
+    return(summary(model_result))
+  }
+  
+  # 其他未知错误
+  return(i18n$t("** 未知错误：请检查数据集和变量设置 **"))
+})
+
+## 确保UI输出绑定正确
+output$summary_coxp <- renderPrint({
+  res <- .summary_coxp()
+  if (is.character(res)) {
+    cat(res, "\n")  
+  } else {
+    print(res)      
+  }
 })
 
+
 .predict_coxp <- reactive({
   if (not_pressed(input$coxp_run)) return(i18n$t("** Press the Estimate button to estimate the model **"))
   if (coxp_available() != "available") return(coxp_available())

radiant.quickgen/R/quickgen_ai.R

 # === 配置 ===
 MODELSCOPE_OPENAI_URL <- "https://api-inference.modelscope.cn/v1"
-MODELSCOPE_API_KEY    <- Sys.getenv("MODELSCOPE_API_KEY", "ms-b2746d72-f897-4faf-8089-89e5e511ed5a")
+MODELSCOPE_API_KEY    <- Sys.getenv("MODELSCOPE_API_KEY", "ms-6638b00e-57e4-4623-996d-214e375d220f")
 MODEL_ID              <- "deepseek-ai/DeepSeek-V3.1"
 
 # === 低层封装：单次对话 ===

radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R

-safe_is_empty <- function(x) {
-  if (is.null(x) || !is.character(x)) return(TRUE)
-  is.empty(x)
-}
-
 make_desc_text <- function(df) {
   if (is.null(df) || nrow(df) == 0) return(i18n$t("No data available"))
   num_cols <- sapply(df, is.numeric)
@@ -73,7 +68,7 @@ qib_add_labs <- function() {
   lab_list <- list()
   for (l in qib_labs) {
     inp <- input[[paste0("qib_labs_", l)]]
-    if (!safe_is_empty(inp)) lab_list[[l]] <- inp
+    if (!is.empty(inp)) lab_list[[l]] <- inp
   }
   lab_list
 }
@@ -407,7 +402,7 @@ output$ui_qib_axes <- renderUI({
   } else if (input$qib_type %in% c("bar", "box")) {
     ind <- c(1, 3)
   }
-  if (!safe_is_empty(input$qib_facet_row, ".") || !safe_is_empty(input$qib_facet_col, ".")) ind <- c(ind, 4)
+  if (!is.empty(input$qib_facet_row, ".") || !is.empty(input$qib_facet_col, ".")) ind <- c(ind, 4)
   if (input$qib_type == "bar") ind <- c(ind, 6)
   
   checkboxGroupInput(
@@ -681,7 +676,7 @@ output$ui_quickgen_basic <- renderUI({
 })
 
 qib_plot_width <- reactive({
-  if (safe_is_empty(input$qib_plot_width)) r_info[["plot_width"]] else input$qib_plot_width
+  if (is.empty(input$qib_plot_width)) r_info[["plot_width"]] else input$qib_plot_width
 })
 
 qib_plot_height <- eventReactive(
@@ -691,7 +686,7 @@ qib_plot_height <- eventReactive(
     input$qib_plot_width
   },
   {
-    if (safe_is_empty(input$qib_plot_height)) {
+    if (is.empty(input$qib_plot_height)) {
       r_info[["plot_height"]]
     } else {
       lx <- ifelse(not_available(input$qib_xvar) || isTRUE(input$qib_combx), 1, length(input$qib_xvar))
@@ -791,37 +786,67 @@ dl_qgb_tab <- function(path) {
 }
 
 
-output$qib_chart <- renderPlot({
+output$qib_chart <- renderPlot(
+  {
     req(input$qib_type)
-  p <- .qib_chart()
-  if (is.null(p)) return(NULL)
-  print(p)
-}, width = qib_plot_width, height = qib_plot_height, res = 96)
+    if (not_available(input$qib_xvar)) {
+      if (!input$qib_type %in% c("box", "line")) {
+        return(
+          plot(
+            x = 1, type = "n",
+            main = " ",
+            axes = FALSE, xlab = "", ylab = "", cex.main = .9
+          )
+        )
+      }
+    }
+    .qib_chart() %>%
+      (function(x) {
+        if (is.empty(x) || is.character(x)) {
+          plot(x = 1, type = "n", main = paste0("\n", x), axes = FALSE, xlab = "", ylab = "", cex.main = .9)
+        } else if (length(x) > 0) {
+          print(x)
+        }
+      })
+  },
+  width = qib_plot_width,
+  height = qib_plot_height,
+  res = 96
+)
 
 .qib_chart <- eventReactive(input$qib_run, {
   req(input$qib_type)
   if (input$qib_type == "scatter") req(input$qib_nrobs)
+  
+  ## need dependency on ..
   req(input$qib_plot_height && input$qib_plot_width)
   
   if (not_available(input$qib_xvar) && !input$qib_type %in% c("box", "line")) {
-    return(NULL)
-  }
-  if (input$qib_type %in% c("scatter", "line", "box", "bar", "surface") && not_available(input$qib_yvar)) {
-    return(NULL)
-  }
-  if (input$qib_type == "box" && !all(input$qib_xvar %in% groupable_vars())) {
-    return(NULL)
+    return()
+  } else if (input$qib_type %in% c("scatter", "line", "box", "bar", "surface") && not_available(input$qib_yvar)) {
+    return(i18n$t("No Y-variable provided for a plot that requires one"))
+  } else if (input$qib_type == "box" && !all(input$qib_xvar %in% groupable_vars())) {
+    return()
   }
   
-  ## 等待 combx / comby 更新
+  ## waiting for comby and/or combx to be updated
   if (input$qib_type %in% c("dist", "density")) {
-    if (isTRUE(input$qib_comby)) return(NULL)
-    if (length(input$qib_xvar) > 1 && is.null(input$qib_combx)) return(NULL)
+    if (isTRUE(input$qib_comby)) {
+      return()
+    }
+    if (length(input$qib_xvar) > 1 && is.null(input$qib_combx)) {
+      return()
+    }
   } else {
-    if (isTRUE(input$qib_combx)) return(NULL)
-    if (length(input$qib_yvar) > 1 && is.null(input$qib_comby)) return(NULL)
+    if (isTRUE(input$qib_combx)) {
+      return()
+    }
+    if (length(input$qib_yvar) > 1 && is.null(input$qib_comby)) {
+      return()
+    }
   }
   
+  #req(!is.null(input$qib_color) || !is.null(input$qib_fill))
   qibi <- qib_inputs()
   qibi$dataset <- input$dataset 
   qibi$shiny <- TRUE
@@ -830,10 +855,8 @@ output$qib_chart <- renderPlot({
   qibi$fill     <- "none"
   qibi$facet_row <- "."
   qibi$facet_col <- "."
-  
   withProgress(message = i18n$t("Making plot"), value = 1, {
-    p <- do.call(visualize, qibi)
-    if (is.character(p)) return(NULL) else p  
+    do.call(visualize, qibi)
   })
 })
 
@@ -866,6 +889,108 @@ observeEvent(input$qgb_store, {
   )
 })
 
+# qgb_report <- function() {
+#   ## get the state of the dt table
+#   ts <- dt_state("qgb_tab")
+#   xcmd <- "# summary(result)\ndtab(result"
+#   if (!is.empty(input$qgb_dec, 3)) {
+#     xcmd <- paste0(xcmd, ", dec = ", input$qgb_dec)
+#   }
+#   if (!is.empty(r_state$qgb_state$length, 10)) {
+#     xcmd <- paste0(xcmd, ", pageLength = ", r_state$qgb_state$length)
+#   }
+#   xcmd <- paste0(xcmd, ", caption = \"\") %>% render()")
+#   if (!is.empty(input$qgb_name)) {
+#     dataset <- fix_names(input$qgb_name)
+#     if (input$qgb_name != dataset) {
+#       updateTextInput(session, inputId = "qgb_name", value = dataset)
+#     }
+#     xcmd <- paste0(xcmd, "\n", dataset, " <- result$tab\nregister(\"", dataset, "\")")
+#   }
+#   
+#   inp_main <- clean_args(qgb_inputs(), qgb_args)
+#   if (ts$tabsort != "") inp_main <- c(inp_main, tabsort = ts$tabsort)
+#   if (ts$tabfilt != "") inp_main <- c(inp_main, tabfilt = ts$tabfilt)
+#   if (is.empty(inp_main$rows)) {
+#     inp_main$rows <- NULL
+#   }
+#   if (is.empty(input$qgb_tab_slice)) {
+#     inp_main <- c(inp_main, nr = Inf)
+#   } else {
+#     inp_main$tabslice <- input$qgb_tab_slice
+#   }
+#   
+#   inp_out <- list(clean_args(qgb_sum_inputs(), qgb_sum_args[-1]))
+#   
+#   update_report(
+#     inp_main = inp_main,
+#     fun_name = "qgb",
+#     inp_out = inp_out,
+#     outputs = c(),
+#     figs = FALSE,
+#     xcmd = xcmd
+#   )
+# }
+
+# qib_report <- function() {
+#   ## resetting hidden elements to default values
+#   vi <- qib_inputs()
+#   if (input$qib_type != "dist") {
+#     vi$bins <- qib_args$bins
+#   }
+#   if (input$qib_type %in% c("dist", "density")) {
+#     vi$yvar <- qib_args$yvar
+#   }
+#   if (!input$qib_type %in% c("density", "scatter", "dist") ||
+#       !("loess" %in% input$qib_check || "density" %in% input$qib_axes || input$qib_type == "density")) {
+#     vi$smooth <- qib_args$smooth
+#   }
+#   if (!input$qib_type %in% c("scatter", "box") && "jitter" %in% input$qib_check) {
+#     vi$check <- base::setdiff(vi$check, "jitter")
+#   }
+#   if (input$qib_type != "scatter") {
+#     vi$size <- "none"
+#     vi$nrobs <- NULL
+#   } else {
+#     vi$nrobs <- as_integer(vi$nrobs)
+#   }
+#   if (!input$qib_type %in% c("scatter", "line", "box")) {
+#     vi$color <- NULL
+#   }
+#   if (!input$qib_type %in% c("bar", "dist", "density", "surface")) {
+#     vi$fill <- NULL
+#   }
+#   
+#   if (!input$qib_type %in% c("bar", "dist", "box", "density")) {
+#     vi$fillcol <- "blue"
+#   }
+#   if (!input$qib_type %in% c("dist", "density", "box", "scatter", "line")) {
+#     vi$linecol <- "black"
+#   }
+#   if (!input$qib_type %in% c("box", "scatter", "line")) {
+#     vi$pointcol <- "black"
+#   }
+#   
+#   if (!input$qib_type %in% c("bar", "line", "scatter")) {
+#     vi$fun <- "mean"
+#   }
+#   if (is.empty(input$data_rows)) {
+#     vi$rows <- NULL
+#   }
+#   
+#   inp_main <- c(clean_args(vi, qib_args), custom = FALSE)
+#   
+#   update_report(
+#     inp_main = inp_main,
+#     fun_name = "qib_chart",
+#     outputs = character(0),
+#     pre_cmd = "",
+#     figs = TRUE,
+#     fig.width = qib_plot_width(),
+#     fig.height = qib_plot_height()
+#   )
+# }
+
 download_handler(
   id = "dl_qgb_tab",
   fun = dl_qgb_tab,
@@ -929,7 +1054,7 @@ quickgen_basic_report <- function() {
   if (!input$qib_type %in% c("dist", "density", "box", "scatter", "line"))  vi$linecol <- "black"
   if (!input$qib_type %in% c("box", "scatter", "line"))  vi$pointcol <- "black"
   if (!input$qib_type %in% c("bar", "line", "scatter"))  vi$fun <- "mean"
-  if (safe_is_empty(input$data_rows))  vi$rows <- NULL
+  if (is.empty(input$data_rows))  vi$rows <- NULL
   
   inp_main <- c(inp_main, clean_args(vi, qib_args), custom = FALSE)
   
@@ -957,6 +1082,35 @@ observeEvent(input$modal_quickgen_basic_screenshot, {
   quickgen_basic_report()
   removeModal()
 })
+# observeEvent(input$qgb_report, {
+#   r_info[["latest_screenshot"]] <- NULL
+#   qgb_report()
+# })
+# 
+# observeEvent(input$qgb_screenshot, {
+#   r_info[["latest_screenshot"]] <- NULL
+#   radiant_screenshot_modal("modal_qgb_screenshot")
+# })
+# 
+# observeEvent(input$modal_qgb_screenshot, {
+#   qgb_report()
+#   removeModal()
+# })
+# 
+# observeEvent(input$qib_report, {
+#   r_info[["latest_screenshot"]] <- NULL
+#   qib_report()
+# })
+# 
+# observeEvent(input$qib_screenshot, {
+#   r_info[["latest_screenshot"]] <- NULL
+#   radiant_screenshot_modal("modal_qib_screenshot")
+# })
+# 
+# observeEvent(input$modal_qib_screenshot, {
+#   qib_report()
+#   removeModal()
+# })
 
 # 全选功能
 observeEvent(input$qgb_select_all, {