Skip to content

R
Radiant
Commit f926635b authored by wuzekai's avatar wuzekai
Browse files
Options

update

parent 105b9543
Expand all Show whitespace changes
Inline Side-by-side
Showing with 1090 additions and 413 deletions
README.md deleted 100644 → 0
View file @ 105b9543
# radiant
科研统计分析工具
Statistical Analysis System
\ No newline at end of file
notice.txt 0 → 100644
View file @ f926635b
上传模块
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
View file @ f926635b
......@@ -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
View file @ f926635b
......@@ -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
View file @ f926635b
############################################
## 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
View file @ f926635b
......@@ -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
View file @ f926635b
......@@ -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
View file @ f926635b
......@@ -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
View file @ f926635b
......@@ -47,6 +47,7 @@ Imports:
png,
MASS,
base64enc,
shinyalert,
shiny.i18n
Suggests:
arrow (>= 12.0.1),
......
radiant.data/inst/app/global.R
View file @ f926635b
......@@ -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
View file @ f926635b
......@@ -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.model/R/cox.R
View file @ f926635b
#' 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
View file @ f926635b
## ========== 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
View file @ f926635b
# === 配置 ===
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
View file @ f926635b
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, {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment