Commit 6392feca authored by wuzekai's avatar wuzekai

fix(quickgen): 可视化函数 NULL 安全与 NA 处理改进

parent 4935b39a
......@@ -461,6 +461,34 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE,
labs = list(), xlim = NULL, ylim = NULL, data_filter = "",
arr = "", rows = NULL, shiny = FALSE, custom = FALSE,
envir = parent.frame()) {
## NULL 安全:Shiny 动态 UI 中未绑定的 input 可能传 NULL,统一回退到默认值
if (is.null(comby)) comby <- FALSE
if (is.null(combx)) combx <- FALSE
if (is.null(custom)) custom <- FALSE
if (is.null(shiny)) shiny <- FALSE
if (is.null(yvar)) yvar <- ""
if (is.null(check)) check <- ""
if (is.null(axes)) axes <- ""
if (is.null(color)) color <- "none"
if (is.null(fill)) fill <- "none"
if (is.null(size)) size <- "none"
if (is.null(facet_row)) facet_row <- "."
if (is.null(facet_col)) facet_col <- "."
if (is.null(nrobs)) nrobs <- -1
if (is.null(fun)) fun <- "mean"
if (is.null(data_filter)) data_filter <- ""
if (is.null(arr)) arr <- ""
if (is.null(alpha)) alpha <- 0.5
if (is.null(bins)) bins <- 10
if (is.null(smooth)) smooth <- 1
if (is.null(fillcol)) fillcol <- "blue"
if (is.null(linecol)) linecol <- "black"
if (is.null(pointcol)) pointcol <- "black"
if (is.null(theme)) theme <- "theme_gray"
if (is.null(base_size)) base_size <- 11
if (is.null(base_family)) base_family <- ""
if (is.null(labs)) labs <- list()
if (missing(xvar) && type %in% c("box", "line")) {
xvar <- yvar
if (type == "box") {
......@@ -537,7 +565,8 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE,
## so you can also pass-in a data.frame
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)
dataset <- get_data(dataset, vars, filt = data_filter, arr = arr, rows = rows, envir = envir,
na.rm = !type %in% c("dist", "density"))
if (type == "scatter" && !is.empty(nrobs)) {
nrobs <- as.integer(nrobs)
......@@ -715,10 +744,13 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE,
dc[i] <- "factor"
}
## 每个子图独立剔除自身字段的 NA 行(多字段时缺失行不重叠也不会互相影响)
ds_i <- dataset[!is.na(dataset[[i]]), , drop = FALSE]
hist_par <- list(alpha = alpha, position = "stack")
if (combx) hist_par[["position"]] <- "identity"
if (fill == "none") hist_par[["fill"]] <- fillcol
plot_list[[i]] <- ggplot(dataset, aes(x = .data[[i]]))
plot_list[[i]] <- ggplot(ds_i, aes(x = .data[[i]]))
if ("density" %in% axes && !"factor" %in% dc[i]) {
hist_par <- c(list(aes(y = after_stat(density))), hist_par)
plot_list[[i]] <- plot_list[[i]] + geom_density(adjust = smooth, color = linecol, linewidth = .5)
......@@ -728,8 +760,8 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE,
if ("log_x" %in% axes) axes <- sub("log_x", "", axes)
} else {
plot_fun <- get("geom_histogram")
hist_par[["binwidth"]] <- select_at(dataset, .vars = i) %>%
range() %>%
hist_par[["binwidth"]] <- select_at(ds_i, .vars = i) %>%
range(na.rm = TRUE) %>%
{
diff(.) / (bins - 1)
}
......@@ -740,7 +772,8 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE,
}
} else if (type == "density") {
for (i in xvar) {
plot_list[[i]] <- ggplot(dataset, aes(x = .data[[i]])) +
ds_i <- dataset[!is.na(dataset[[i]]), , drop = FALSE]
plot_list[[i]] <- ggplot(ds_i, aes(x = .data[[i]])) +
if (fill == "none") {
geom_density(adjust = smooth, color = linecol, fill = fillcol, alpha = alpha, linewidth = 1)
} else {
......
......@@ -90,13 +90,14 @@ qib_args <- as.list(formals(visualize))
## 收集用户输入的 reactive 列表
qgb_inputs <- reactive({
qgb_args$data_filter <- if (input$show_filter) input$data_filter else ""
qgb_args$arr <- if (input$show_filter) input$data_arrange else ""
qgb_args$rows <- if (input$show_filter) input$data_rows else ""
qgb_args$data_filter <- if (isTRUE(input$show_filter)) input$data_filter else ""
qgb_args$arr <- if (isTRUE(input$show_filter)) input$data_arrange else ""
qgb_args$rows <- if (isTRUE(input$show_filter)) input$data_rows else ""
qgb_args$dataset <- input$dataset
for (i in r_drop(names(qgb_args))) {
qgb_args[[i]] <- input[[paste0("qgb_", i)]]
val <- input[[paste0("qgb_", i)]]
qgb_args[[i]] <- if (is.null(val)) formals(explore)[[i]] else val
}
qgb_args
})
......@@ -112,10 +113,14 @@ qib_inputs <- reactive({
qib_args$arr <- if (isTRUE(input$show_filter)) input$data_arrange else ""
qib_args$rows <- if (isTRUE(input$show_filter)) input$data_rows else ""
qib_args$dataset <- input$dataset
qib_args$shiny <- input$shiny
qib_args$shiny <- isTRUE(input$shiny)
qib_args$labs <- qib_add_labs()
for (i in r_drop(names(qib_args), drop = c(i18n$t("dataset"), i18n$t("data_filter"), i18n$t("arr"), i18n$t("rows"), i18n$t("labs")))) {
qib_args[[i]] <- input[[paste0("qib_", i)]]
## 使用英文参数名做 drop(formals 名称始终是英文),避免 i18n 翻译后匹配失败导致参数被 NULL 覆盖
drop_params <- c("dataset", "data_filter", "arr", "rows", "shiny", "labs", "envir")
for (i in r_drop(names(qib_args), drop = drop_params)) {
val <- input[[paste0("qib_", i)]]
## 没有对应 UI 的 input 为 NULL,回退到 formals 默认值,防止传给 visualize 的参数为 NULL 导致错误
qib_args[[i]] <- if (is.null(val)) formals(visualize)[[i]] else val
}
qib_args
})
......@@ -812,14 +817,12 @@ output$qib_chart <- renderPlot(
)
}
}
.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)
p <- .qib_chart()
if (is.empty(p) || is.character(p)) {
plot(x = 1, type = "n", main = paste0("\n", p), axes = FALSE, xlab = "", ylab = "", cex.main = .9)
} else if (length(p) > 0) {
print(p)
}
})
},
width = qib_plot_width,
height = qib_plot_height,
......@@ -841,21 +844,15 @@ output$qib_chart <- renderPlot(
return()
}
## waiting for comby and/or combx to be updated
## 校验 comby/combx 状态(NULL 安全:checkbox 未绑定时视为 FALSE,不再中断绘图)
if (input$qib_type %in% c("dist", "density")) {
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()
}
if (length(input$qib_yvar) > 1 && is.null(input$qib_comby)) {
return()
}
}
#req(!is.null(input$qib_color) || !is.null(input$qib_fill))
......
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