Commit 4688178c authored by wuzekai's avatar wuzekai

update

parent be466d32
......@@ -26,7 +26,8 @@ Imports:
shiny.i18n,
rlang (>= 1.0.6),
ggpp,
nortest
nortest,
naniar
Suggests:
testthat (>= 2.0.0),
pkgdown (>= 1.1.0),
......
......@@ -8,6 +8,7 @@ S3method(plot,cross_tabs)
S3method(plot,goodness)
S3method(plot,homo_variance_test)
S3method(plot,mda)
S3method(plot,missing)
S3method(plot,normality_test)
S3method(plot,outlier)
S3method(plot,prob_binom)
......@@ -30,6 +31,7 @@ S3method(summary,cross_tabs)
S3method(summary,goodness)
S3method(summary,homo_variance_test)
S3method(summary,mda)
S3method(summary,missing)
S3method(summary,normality_test)
S3method(summary,outlier)
S3method(summary,prob_binom)
......@@ -54,6 +56,7 @@ export(get_single_norm)
export(goodness)
export(homo_variance_test)
export(mda)
export(missing)
export(normality_test)
export(outlier)
export(prob_binom)
......
This diff is collapsed.
############################################
## Missing Value Analysis - UI
############################################
## 1. 标签
missing_plots <- c("heatmap", "barplot")
names(missing_plots) <- c(
i18n$t("Missing Heatmap"),
i18n$t("Missing Barplot")
)
## 2. 函数形参
missing_args <- as.list(formals(missing))
missing_args <- missing_args[names(missing_args) %in% c("dataset", "vars", "data_filter")]
## 3. 输入收集
missing_inputs <- reactive({
req(input$dataset)
inputs <- list(
dataset = input$dataset,
vars = input$missing_vars, # 用户选择的变量
data_filter = if (input$show_filter) input$data_filter else "",
envir = r_data
)
# 校验参数完整性
for (arg in names(missing_args)) {
if (is.null(inputs[[arg]]) || length(inputs[[arg]]) == 0) {
inputs[[arg]] <- missing_args[[arg]]
}
}
inputs
})
## 4. 变量选择UI
output$ui_missing_vars <- renderUI({
req(input$dataset)
current_data <- get_data(input$dataset, envir = r_data)
all_vars <- colnames(current_data)
if (length(all_vars) == 0) {
return(div(class = "alert alert-warning", i18n$t("No variables in dataset. Please select another dataset.")))
}
# 显示变量类型(数值型/分类型)
var_types <- sapply(current_data[, all_vars, drop = FALSE], function(col) class(col)[1])
choices <- setNames(nm = paste0(all_vars, " {", var_types, "}"), object = all_vars)
selectizeInput(
inputId = "missing_vars",
label = i18n$t("Select variables to analyze:"),
choices = choices,
selected = state_multiple("missing_vars", character(0)),
multiple = TRUE,
options = list(placeholder = i18n$t("Select one or more variables"), plugins = list("remove_button", "drag_drop"))
)
})
## 5. 主UI(Summary + Plot标签页)
output$ui_missing <- renderUI({
req(input$dataset)
tagList(
wellPanel(
# Summary标签页:变量选择 + 统计结果
conditionalPanel(
condition = "input.tabs_missing == 'Summary'",
uiOutput("ui_missing_vars")
),
# Plot标签页:可视化类型选择
conditionalPanel(
condition = "input.tabs_missing == 'Plot'",
selectizeInput(
inputId = "missing_plots",
label = i18n$t("Select plots:"),
choices = missing_plots,
selected = state_multiple("missing_plots", missing_plots, "barplot"), # 默认选中条形图
multiple = TRUE,
options = list(placeholder = i18n$t("Select plot types"), plugins = list("remove_button", "drag_drop"))
)
)
),
# 帮助与报告(和离群值分析保持一致)
help_and_report(
modal_title = i18n$t("Missing Value Analysis"),
fun_name = "missing",
help_file = inclMD(file.path(getOption("radiant.path.basics"), "app/tools/help/missing.md"))
)
)
})
## 6. 图表尺寸计算
missing_plot_dims <- reactive({
req(.missing())
plot_count <- length(input$missing_plots)
var_count <- length(.missing()$vars)
# 基础高度
base_height_px <- if ("heatmap" %in% input$missing_plots) {
min(500 + (nrow(.missing()$raw_data) * 0.5), 1200) # 样本越多,热图越高
} else {
400
}
total_height_px <- base_height_px * plot_count
# 限制最大/最小高度
total_height_px <- min(total_height_px, 2000)
total_height_px <- max(total_height_px, 500)
list(
width = 800,
height = total_height_px
)
})
missing_plot_width <- function() missing_plot_dims()$width
missing_plot_height <- function() missing_plot_dims()$height
## 7. 输出面板
output$missing <- renderUI({
# 注册输出组件
register_print_output("summary_missing", ".summary_missing")
register_plot_output("plot_missing", ".plot_missing",
height_fun = "missing_plot_height")
# 标签页布局(Summary + Plot)
missing_panels <- tabsetPanel(
id = "tabs_missing",
tabPanel(
title = i18n$t("Summary"),
value = "Summary",
verbatimTextOutput("summary_missing", placeholder = TRUE)
),
tabPanel(
title = i18n$t("Plot"),
value = "Plot",
download_link("dlp_missing"), # 下载按钮
plotOutput("plot_missing", height = "100%"),
style = "margin-top: 10px;"
)
)
# 集成到Data Quality菜单下
stat_tab_panel(
menu = i18n$t("Basics > Data Quality"),
tool = i18n$t("Missing Value Analysis"),
tool_ui = "ui_missing",
output_panels = missing_panels
)
})
## 8. 可用性检验
missing_available <- reactive({
req(input$dataset)
current_data <- get_data(input$dataset, envir = r_data)
# 校验是否选择变量:未选则返回提示,阻止后续计算
if (not_available(input$missing_vars)) {
return(i18n$t("Please select at least one variable to analyze."))
}
# 校验变量是否存在
invalid_vars <- input$missing_vars[!input$missing_vars %in% colnames(current_data)]
if (length(invalid_vars) > 0) {
return(i18n$t(paste("Invalid variables: ", paste(invalid_vars, collapse = ", "), ". Please reselect.", sep = "")))
}
"available"
})
## 9. 计算核心
.missing <- reactive({
req(missing_available() == "available")
do.call(missing, missing_inputs())
})
## 10. Summary输出
.summary_missing <- reactive({
req(missing_available() == "available")
summary(.missing())
})
## 11. Plot输出
.plot_missing <- reactive({
req(missing_available() == "available")
validate(need(input$missing_plots, i18n$t("Please select at least one plot type first.")))
withProgress(message = i18n$t("Generating missing value plots..."), value = 0.5, {
p <- plot(.missing(), plots = input$missing_plots, shiny = TRUE)
setProgress(value = 1)
})
p
})
## 12. 下载功能
download_handler(
id = "dlp_missing",
fun = function(file) {
plot_obj <- .plot_missing()
width_in <- missing_plot_width() / 96
height_in <- missing_plot_height() / 96
ggsave(
filename = file,
plot = plot_obj,
width = width_in,
height = height_in,
device = "png",
dpi = 300,
limitsize = FALSE,
bg = "white"
)
},
fn = function() paste0(input$dataset, "_missing_value_analysis"),
type = "png",
caption = i18n$t("Save missing value plots")
)
## 13. 报告生成
missing_report <- function() {
req(missing_available() == "available")
figs <- length(input$missing_plots) > 0
update_report(
inp_main = clean_args(missing_inputs(), missing_args),
fun_name = "missing",
inp_out = if (figs) list("", list(plots = input$missing_plots)) else list(""),
outputs = if (figs) c("summary", "plot") else "summary",
figs = figs,
fig.width = missing_plot_width(),
fig.height = missing_plot_height()
)
}
## 14. 截图功能
observeEvent(input$missing_report, {
r_info[["latest_screenshot"]] <- NULL
missing_report()
})
observeEvent(input$missing_screenshot, {
r_info[["latest_screenshot"]] <- NULL
radiant_screenshot_modal("modal_missing_screenshot")
})
observeEvent(input$modal_missing_screenshot, {
missing_report()
removeModal()
})
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